vcs.maemo.org Git - maemian/blob - nokia-lintian/debian/patches/500-backport-1.23.22-frontend.dpatch

   1 #! /bin/sh /usr/share/dpatch/dpatch-run
   2 ## 500-backport-1.23.22-frontend.dpatch by Eero Häkkinen <eero.hakkinen@nokia.com>
   3 ##
   4 ## All lines beginning with `## DP:' are a description of the patch.
   5 ## DP: Backported frontends from lintian 1.23.22
   6
   7 @DPATCH@
   8 diff -urNad lintian-1.23.8/frontend/lintian lintian-1.23.22/frontend/lintian
   9 --- lintian-1.23.8/frontend/lintian     2005-01-02 00:29:42.000000000 +0000
  10 +++ lintian-1.23.22/frontend/lintian    2006-07-19 11:57:17.000000000 +0000
  11 @@ -17,8 +17,8 @@
  12  # You should have received a copy of the GNU General Public License
  13  # along with this program.  If not, you can find it on the World Wide
  14  # Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
  15 -# Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
  16 -# MA 02111-1307, USA.
  17 +# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
  18 +# MA 02110-1301, USA.
  19  # }}}
  20
  21  # {{{ libraries and such
  22 @@ -64,6 +64,8 @@
  23  my $LINTIAN_CFG = "";          #config file to use
  24  our $LINTIAN_ROOT;             #location of the lintian modules
  25
  26 +my $experimental_output_opts = undef;
  27 +
  28  my @packages;
  29
  30  my $action;
  31 @@ -72,7 +74,7 @@
  32  my $unpack_info;
  33  my $cwd;
  34  my $cleanup_filename;
  35 -my $exit_code;
  36 +my $exit_code = 0;
  37  my $LAB;
  38
  39  my %collection_info;
  40 @@ -258,6 +260,9 @@
  41                "unpack-info|U=s" => \&record_unpack_info,
  42                "md5sums|m" => \$check_md5sums,
  43                "allow-root" => \$allow_root,
  44 +              # Note: Ubuntu has (and other derivatives might gain) a
  45 +              # -D/--debian option to make lintian behave like in Debian, that
  46 +              # is, to revert distribution-specific changes
  47
  48                # ------------------ configuration options
  49                "cfg=s" => \$LINTIAN_CFG,
  50 @@ -274,6 +279,9 @@
  51                "source|s" => \&record_pkgmode,
  52                "udeb" => \&record_pkgmode,
  53                "packages-file|p=s" => \$packages_file,
  54 +
  55 +              # ------------------ experimental
  56 +              "exp-output:s" => \$experimental_output_opts,
  57               );
  58
  59  # init commandline parser
  60 @@ -385,7 +393,7 @@
  61  # LINTIAN_ARCH must have a value.
  62  unless (defined $LINTIAN_ARCH) {
  63      if ($LINTIAN_DIST) {
  64 -       chop($LINTIAN_ARCH=`dpkg --print-installation-architecture`);
  65 +       chop($LINTIAN_ARCH=`dpkg --print-architecture`);
  66      } else {
  67         $LINTIAN_ARCH = 'any';
  68      }
  69 @@ -475,7 +483,14 @@
  70  import Util;
  71  import Pipeline;
  72
  73 -# }}}
  74 +require Tags;
  75 +import Tags;
  76 +
  77 +my @l_secs = read_dpkg_control("$LINTIAN_ROOT/checks/lintian.desc");
  78 +shift(@l_secs);
  79 +map Tags::add_tag($_), @l_secs;
  80 +
  81 +# }}}
  82
  83  # {{{ No clue why this code is here...
  84
  85 @@ -607,6 +622,7 @@
  86                 next;
  87             }
  88
  89 +           Tags::set_pkg( $arg, $arg_name, "", "", 'binary' );
  90             # check distribution field
  91             if (! (($data->{'distribution'} eq 'stable')
  92                   or ($data->{'distribution'} eq 'testing')
  93 @@ -616,7 +632,8 @@
  94                   or ($data->{'distribution'} =~ /\w+-security/))
  95                 ) {
  96                 # bad distribution entry
  97 -               print "E: $arg_name: bad-distribution-in-changes-file $data->{'distribution'}\n";
  98 +               tag("bad-distribution-in-changes-file",
  99 +                   $data->{'distribution'});
 100             }
 101
 102             # process all listed `files:'
 103 @@ -636,7 +653,7 @@
 104                 if (-s $filename ne $size) {
 105                     print "N: size is $size, argname is $arg_name, filename is $filename\n";
 106
 107 -                   print "E: $arg_name: file-size-mismatch-in-changes-file $file\n";
 108 +                   tag( "file-size-mismatch-in-changes-file", $file );
 109                 }
 110
 111                 # check md5sums
 112 @@ -644,13 +661,13 @@
 113                     my $real_md5sum = get_file_md5($filename);
 114
 115                     if ($real_md5sum ne $md5sum) {
 116 -                       print "E: $arg_name: md5sum-mismatch-in-changes-file $file\n";
 117 +                       tag( "md5sum-mismatch-in-changes-file", $file );
 118                     }
 119                 }
 120
 121                 # check section
 122                 if (($section eq 'non-free') or ($section eq 'contrib')) {
 123 -                   print "E: $arg_name: bad-section-in-changes-file $file $section\n";
 124 +                   tag( "bad-section-in-changes-file", $file, $section );
 125                 }
 126
 127                 # process file?
 128 @@ -668,6 +685,14 @@
 129                                      $info->{'version'}, $filename);
 130                 }
 131             }
 132 +
 133 +           unless ($exit_code) {
 134 +               my $stats = Tags::get_stats( $arg );
 135 +               if ($stats->{severity}{4}) {
 136 +                   $exit_code = 1;
 137 +               }
 138 +           }
 139 +
 140         } else {
 141             fail("bad package file name $arg (neither .deb, .udeb or .dsc file)");
 142         }
 143 @@ -850,10 +875,22 @@
 144
 145  # {{{ Now we're ready to load info about checks & tags
 146
 147 -require Tags;
 148 -import Tags;
 149 +no warnings 'once';
 150 +if (defined $experimental_output_opts) {
 151 +    $Tags::output_formatter = \&Tags::print_tag_new;
 152 +    my %opts = map { split(/=/) } split( /,/, $experimental_output_opts );
 153 +    foreach (keys %opts) {
 154 +       if ($_ eq 'format') {
 155 +           if ($opts{$_} eq 'colons') {
 156 +               require Tags::ColonSeparated;
 157 +               $Tags::output_formatter = \&Tags::ColonSeparated::print_tag;
 158 +           }
 159 +       }
 160 +       no strict 'refs';
 161 +       ${"Tags::$_"} = $opts{$_};
 162 +    }
 163 +}
 164
 165 -no warnings;
 166  $Tags::show_info = $display_infotags;
 167  $Tags::show_overrides = $show_overrides;
 168  use warnings;
 169 @@ -920,10 +957,10 @@
 170             }
 171         }
 172
 173 +       shift(@secs);
 174 +       map Tags::add_tag($_), @secs;
 175      } # end: if ne lintian
 176
 177 -    shift(@secs);
 178 -    map Tags::add_tag($_), @secs;
 179  }
 180
 181  closedir(CHECKDIR);
 182 @@ -1056,8 +1093,6 @@
 183      printf "N: Selected checks: %s\n",join(',',keys %checks);
 184  }
 185
 186 -$exit_code = 0;
 187 -
 188  require Checker;
 189
 190  # for each package (the `reverse sort' is to make sure that source packages are
 191 @@ -1203,7 +1238,7 @@
 192      }
 193
 194      if ($action eq 'check') {  # read override file
 195 -       Tags::pkg_reset($long_type eq 'binary' ? $pkg : "$pkg $long_type");
 196 +       Tags::set_pkg( $file, $pkg, "", "", $long_type );
 197
 198
 199         unless ($no_override)
 200 @@ -1259,21 +1294,25 @@
 201                 print "N: Skipping $action of $long_type package $pkg\n";
 202                 next PACKAGE;
 203             }
 204 +
 205 +       }
 206 +       unless ($exit_code) {
 207 +           my $stats = Tags::get_stats( $file );
 208 +           if ($stats->{severity}{4}) {
 209 +               $exit_code = 1;
 210 +           }
 211         }
 212
 213         # report unused overrides
 214 -#      if (not $no_override and $verbose) {
 215 -#          my $ppkg = $type eq 'b' ? quotemeta($pkg) : quotemeta("$pkg $long_type");
 216 -#          for my $o (sort keys %overridden) {
 217 -#              next unless $o =~ /^$ppkg:/;
 218 -#              next if $overridden{$o};
 219 -#
 220 -#              print "I: $pkg: unused-override $o\n";
 221 -#
 222 -#              # mark override entry as used
 223 -#              $overridden{$o} = 99999;
 224 -#          }
 225 -#      }
 226 +       if (not $no_override and $verbose) {
 227 +           my $overrides = Tags::get_overrides( $file );
 228 +
 229 +           for my $o (sort keys %$overrides) {
 230 +               next if $overrides->{$o};
 231 +
 232 +               tag( "unused-override", $o );
 233 +           }
 234 +       }
 235      }
 236
 237      # chdir to lintian root directory (to unlock $base so it can be removed below)
 238 diff -urNad lintian-1.23.8/frontend/lintian-info lintian-1.23.22/frontend/lintian-info
 239 --- lintian-1.23.8/frontend/lintian-info        2004-11-24 22:44:09.000000000 +0000
 240 +++ lintian-1.23.22/frontend/lintian-info       2006-07-19 11:57:17.000000000 +0000
 241 @@ -17,8 +17,8 @@
 242  # You should have received a copy of the GNU General Public License
 243  # along with this program.  If not, you can find it on the World Wide
 244  # Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
 245 -# Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
 246 -# MA 02111-1307, USA.
 247 +# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
 248 +# MA 02110-1301, USA.
 249
 250  use strict;
 251
 252 @@ -48,6 +48,7 @@
 253      my ($type, $pkg, @pieces) = split(/:\s+/);
 254      if ($type =~ m/^[OEWIX]$/) {
 255         $tag = shift @pieces;
 256 +       next if not defined $tag;
 257         ($tag) = split(/\s+/, $tag, 2);
 258
 259         next if not exists $tag_info{$tag} or $already_displayed{$tag}++;
 260 diff -urNad lintian-1.23.8/lib/Tags/ColonSeparated.pm lintian-1.23.22/lib/Tags/ColonSeparated.pm
 261 --- lintian-1.23.8/lib/Tags/ColonSeparated.pm   1970-01-01 00:00:00.000000000 +0000
 262 +++ lintian-1.23.22/lib/Tags/ColonSeparated.pm  2006-07-19 11:58:28.000000000 +0000
 263 @@ -0,0 +1,55 @@
 264 +# Tags::ColonSeparated -- Perl tags functions for lintian
 265 +# $Id: Tags.pm 489 2005-09-17 00:06:30Z djpig $
 266 +
 267 +# Copyright (C) 2005 Frank Lichtenheld <frank@lichtenheld.de>
 268 +#
 269 +# This program is free software; you can redistribute it and/or modify
 270 +# it under the terms of the GNU General Public License as published by
 271 +# the Free Software Foundation; either version 2 of the License, or
 272 +# (at your option) any later version.
 273 +#
 274 +# This program is distributed in the hope that it will be useful,
 275 +# but WITHOUT ANY WARRANTY; without even the implied warranty of
 276 +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 277 +# GNU General Public License for more details.
 278 +#
 279 +# You should have received a copy of the GNU General Public License
 280 +# along with this program.  If not, you can find it on the World Wide
 281 +# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
 282 +# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
 283 +# MA 02110-1301, USA.
 284 +
 285 +package Tags::ColonSeparated;
 286 +use strict;
 287 +use warnings;
 288 +
 289 +sub quote_char {
 290 +    my ( $char, @items ) = @_;
 291 +
 292 +    foreach (@items) {
 293 +       s/\\/\\\\/go;
 294 +       s/\Q$char\E/\\$char/go;
 295 +    }
 296 +
 297 +    return @items;
 298 +}
 299 +
 300 +sub print_tag {
 301 +    my ( $pkg_info, $tag_info, $information ) = @_;
 302 +
 303 +    my $extra = "@$information";
 304 +
 305 +    print join(':', quote_char( ':',
 306 +                               $tag_info->{severity},
 307 +                               $tag_info->{significance},
 308 +                               @{$tag_info->{overridden}}{'override',
 309 +                                                          'severity',
 310 +                                                          'significance'},
 311 +                               @{$pkg_info}{'pkg','version','arch','type'},
 312 +                               $tag_info->{tag},
 313 +                               $extra,
 314 +                               ))."\n";
 315 +}
 316 +
 317 +1;
 318 +
 319 diff -urNad lintian-1.23.8/lib/Tags.pm lintian-1.23.22/lib/Tags.pm
 320 --- lintian-1.23.8/lib/Tags.pm  2006-07-18 13:39:52.000000000 +0000
 321 +++ lintian-1.23.22/lib/Tags.pm 2006-07-19 11:57:40.000000000 +0000
 322 @@ -1,7 +1,8 @@
 323  # Tags -- Perl tags functions for lintian
 324 -# $Id: Tags.pm 364 2004-11-13 21:07:48Z djpig $
 325 +# $Id: Tags.pm 510 2005-10-14 00:19:49Z djpig $
 326
 327  # Copyright (C) 1998-2004 Various authors
 328 +# Copyright (C) 2005 Frank Lichtenheld <frank@lichtenheld.de>
 329  #
 330  # This program is free software; you can redistribute it and/or modify
 331  # it under the terms of the GNU General Public License as published by
 332 @@ -16,30 +17,30 @@
 333  # You should have received a copy of the GNU General Public License
 334  # along with this program.  If not, you can find it on the World Wide
 335  # Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
 336 -# Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
 337 -# MA 02111-1307, USA.
 338 +# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
 339 +# MA 02110-1301, USA.
 340
 341  package Tags;
 342  use strict;
 343 -
 344 -use Util;
 345 +use warnings;
 346
 347  use Exporter;
 348  our @ISA = qw(Exporter);
 349  our @EXPORT = qw(tag);
 350
 351 -my $LINTIAN_ROOT = $::LINTIAN_ROOT;
 352 -
 353 -# Can also be more precise later on (only verbose with lab actions) but for
 354 -# now this will do --Jeroen
 355 -my $verbose = $::verbose;
 356 -my $debug = $::debug;
 357 -
 358 -# What to print between the "E:" and the tag, f.e. "package source"
 359 -our $prefix = undef;
 360 +# configuration variables and defaults
 361 +our $verbose = $::verbose;
 362 +our $debug = $::debug;
 363  our $show_info = 0;
 364 +our $show_overrides = 0;
 365 +our $output_formatter = \&print_tag;
 366 +our $min_severity = 1;
 367 +our $max_severity = 99;
 368 +our $min_significance = 1;
 369 +our $max_significance = 99;
 370
 371 -# The master hash with all tag info. Key is a hash too, with these stuff:
 372 +# The master hash with all tag info. Key is the tag name, value another hash
 373 +# with the following keys:
 374  # - tag: short name
 375  # - type: error/warning/info/experimental
 376  # - info: Description in HTML
 377 @@ -47,53 +48,265 @@
 378  # - experimental: experimental status (possibly undef)
 379  my %tags;
 380
 381 -our $show_overrides;
 382 -# in the form overrides->tag or full thing
 383 -my %overrides;
 384 +# Statistics per file. Key is the filename, value another hash with the
 385 +# following keys:
 386 +# - overrides
 387 +# - tags
 388 +# - severity
 389 +# - significance
 390 +my %stats;
 391
 392 -my $codes = { 'error' => 'E' , 'warning' => 'W' , 'info' => 'I' };
 393 +# Info about a specific file. Key is the the filename, value another hash
 394 +# with the following keys:
 395 +# - pkg: package name
 396 +# - version: package version
 397 +# - arch: package architecture
 398 +# - type: one of 'binary', 'udeb' or 'source'
 399 +# - overrides: hash with all overrides for this file as keys
 400 +my %info;
 401
 402 +# Currently selected file (not package!)
 403 +my $current;
 404
 405 -# TODO
 406 -# - override support back in --> just the unused reporting
 407 -# - be able to return whether any errors were there, better, full stats
 408 +# Compatibility stuff
 409 +my %codes = ( 'error' => 'E' , 'warning' => 'W' , 'info' => 'I' );
 410 +our %type_to_sev = ( error => 4, warning => 2, info => 0 );
 411 +our @sev_to_type = qw( info warning warning error error );
 412
 413 -# Call this function to add a certain tag, by supplying the info as a hash
 414 +my @sig_to_qualifier = ( '??', '?', '', '!' );
 415 +my @sev_to_code = qw( I W W E E );
 416 +
 417 +# Add a new tag, supplied as a hash reference
 418  sub add_tag {
 419         my $newtag = shift;
 420 -       fail("Duplicate tag: $newtag->{'tag'}")
 421 -               if exists $tags{$newtag->{'tag'}};
 422 -
 423 +       if (exists $tags{$newtag->{tag}}) {
 424 +           warn "Duplicate tag: $newtag->{tag}\n";
 425 +           return 0;
 426 +       }
 427 +
 428 +       # smooth transition
 429 +       $newtag->{type} = $sev_to_type[$newtag->{severity}]
 430 +           unless $newtag->{type};
 431 +       $newtag->{significance} = 2 unless exists $newtag->{significance};
 432 +       $newtag->{severity} = $type_to_sev{$newtag->{type}}
 433 +           unless exists $newtag->{severity};
 434         $tags{$newtag->{'tag'}} = $newtag;
 435 +       return 1;
 436  }
 437
 438 -# Used to reset the matched tags data
 439 -sub pkg_reset {
 440 -       $prefix = shift;
 441 -       %overrides = ();
 442 +# Add another file, will fail if there is already stored info about
 443 +# the file
 444 +sub set_pkg {
 445 +    my ( $file, $pkg, $version, $arch, $type ) = @_;
 446 +
 447 +    if (exists $info{$file}) {
 448 +       warn "File $file was already processed earlier\n";
 449 +       return 0;
 450 +    }
 451 +
 452 +    $current = $file;
 453 +    $info{$file} = {
 454 +       pkg => $pkg,
 455 +       version => $version,
 456 +       arch => $arch,
 457 +       type => $type,
 458 +       overrides => {},
 459 +    };
 460 +    $stats{$file} = {
 461 +       severity => {},
 462 +       significance => {},
 463 +       tags => {},
 464 +       overrides => {},
 465 +    };
 466 +
 467 +    return 1;
 468  }
 469
 470 -# Add an override, string tag, string rest
 471 +# select another file as 'current' without deleting or adding any information
 472 +# the file must have been added with add_pkg
 473 +sub select_pkg {
 474 +    my ( $file ) = @_;
 475 +
 476 +    unless (exists $info{$file}) {
 477 +       warn "Can't select package $file";
 478 +       return 0;
 479 +    }
 480 +
 481 +    $current = $file;
 482 +    return 1;
 483 +}
 484 +
 485 +# only delete the value of 'current' without deleting any stored information
 486 +sub reset_pkg {
 487 +    undef $current;
 488 +    return 1;
 489 +}
 490 +
 491 +# delete all the stored information (including tags)
 492 +sub reset {
 493 +    undef %stats;
 494 +    undef %info;
 495 +    undef %tags;
 496 +    undef $current;
 497 +    return 1;
 498 +}
 499 +
 500 +# Add an override. If you specifiy two arguments, the first will be taken
 501 +# as file to add the override to, otherwise 'current' will be assumed
 502  sub add_override {
 503 -       my $tag = shift;
 504 -       $overrides{$tag} = 0;
 505 +    my ($tag, $file) = ( "", "" );
 506 +    if (@_ > 1) {
 507 +       ($file, $tag) = @_;
 508 +    } else {
 509 +       ($file, $tag) = ($current, @_);
 510 +    }
 511 +
 512 +    unless ($file) {
 513 +       warn "Don't know which package to add override $tag to";
 514 +       return 0;
 515 +    }
 516 +
 517 +    $info{$file}{overrides}{$tag} = 0;
 518 +
 519 +    return 1;
 520 +}
 521 +
 522 +sub get_overrides {
 523 +    my ($file) = @_;
 524 +
 525 +    unless ($file) {
 526 +       warn "Don't know which package to get overrides from";
 527 +       return undef;
 528 +    }
 529 +
 530 +    return $info{$file}{overrides};
 531 +}
 532 +
 533 +# Get the info hash for a tag back as a reference. The hash will be
 534 +# copied first so that you can edit it safely
 535 +sub get_tag_info {
 536 +    my ( $tag ) = @_;
 537 +    return { %{$tags{$tag}} } if exists $tags{$tag};
 538 +    return undef;
 539 +}
 540 +
 541 +sub check_range {
 542 +    my ( $x, $min, $max ) = @_;
 543 +
 544 +    return -1 if $x < $min;
 545 +    return 1 if $x > $max;
 546 +    return 0;
 547 +}
 548 +
 549 +# check if a certain tag has a override for the 'current' package
 550 +sub check_overrides {
 551 +    my ( $tag_info, $information ) = @_;
 552 +
 553 +    my $extra = '';
 554 +    $extra = " @$information" if @$information;
 555 +    $extra = '' if $extra eq ' ';
 556 +    if( exists $info{$current}{overrides}{$tag_info->{tag}}) {
 557 +       $info{$current}{overrides}{$tag_info->{tag}}++;
 558 +       return $tag_info->{tag};
 559 +    } elsif( exists $info{$current}{overrides}{"$tag_info->{tag}$extra"} ) {
 560 +       $info{$current}{overrides}{"$tag_info->{tag}$extra"}++;
 561 +       return "$tag_info->{tag}$extra";
 562 +    }
 563 +
 564 +    return '';
 565 +}
 566 +
 567 +# sets all the overridden fields of a tag_info hash correctly
 568 +sub check_need_to_show {
 569 +    my ( $tag_info, $information ) = @_;
 570 +    $tag_info->{overridden}{override} = check_overrides( $tag_info,
 571 +                                                        $information );
 572 +    my $min_sev = $show_info ? 0 : $min_severity; # compat hack
 573 +    $tag_info->{overridden}{severity} = check_range( $tag_info->{severity},
 574 +                                                    $min_sev,
 575 +                                                    $max_severity );
 576 +    $tag_info->{overridden}{significance} = check_range( $tag_info->{significance},
 577 +                                                        $min_significance,
 578 +                                                        $max_significance );
 579  }
 580
 581 +# records the stats for a given tag_info hash
 582 +sub record_stats {
 583 +    my ( $tag_info ) = @_;
 584 +
 585 +    for my $k (qw( severity significance tag )) {
 586 +       $stats{$current}{$k}{$tag_info->{$k}}++
 587 +           unless $tag_info->{overridden}{$k};
 588 +    }
 589 +    for my $k (qw( severity significance override )) {
 590 +       $stats{$current}{overrides}{$k}{$tag_info->{overridden}{$k}}++
 591 +           if $tag_info->{overridden}{$k};
 592 +    }
 593 +}
 594 +
 595 +# get the statistics for a file (one argument) or for all files (no argument)
 596 +sub get_stats {
 597 +    my ( $file ) = @_;
 598 +
 599 +    return $stats{$file} if $file;
 600 +    return \%stats;
 601 +}
 602 +
 603 +sub print_tag {
 604 +    my ( $pkg_info, $tag_info, $information ) = @_;
 605 +
 606 +    my $extra = '';
 607 +    $extra = " @$information" if @$information;
 608 +    $extra = '' if $extra eq ' ';
 609 +    my $code = $codes{$tag_info->{type}};
 610 +    $code = 'O' if $tag_info->{overridden}{override};
 611 +    my $type = '';
 612 +    $type = " $pkg_info->{type}" if $pkg_info->{type} ne 'binary';
 613 +
 614 +    print "$code: $pkg_info->{pkg}$type: $tag_info->{tag}$extra\n";
 615 +}
 616 +
 617 +sub print_tag_new {
 618 +    my ( $pkg_info, $tag_info, $information ) = @_;
 619 +
 620 +    my $extra = '';
 621 +    $extra = " @$information" if @$information;
 622 +    $extra = '' if $extra eq ' ';
 623 +    my $code = $sev_to_code[$tag_info->{severity}];
 624 +    $code = 'O' if $tag_info->{overridden}{override};
 625 +    my $qualifier = $sig_to_qualifier[$tag_info->{significance}];
 626 +    $qualifier = '' if $code eq 'O';
 627 +    my $type = '';
 628 +    $type = " $pkg_info->{type}" if $pkg_info->{type} ne 'binary';
 629 +
 630 +    print "$code$qualifier: $pkg_info->{pkg}$type: $tag_info->{tag}$extra\n";
 631 +
 632 +}
 633
 634  sub tag {
 635 -       my $tag = shift;
 636 -       my $info = $tags{$tag};
 637 -       return if not $show_info and $info->{'type'} eq 'info';
 638 -       my $extra = '';
 639 -       $extra = ' '.join(' ', @_) if $#_ >=0;
 640 -       $extra = '' if $extra eq ' ';
 641 -       my $code = $codes->{$info->{'type'}};
 642 -       if (exists $overrides{$tag} or exists $overrides{"$tag$extra"}) {
 643 -               return unless $show_overrides or $verbose;
 644 -               $code = 'O';
 645 -       }
 646 +    my ( $tag, @information ) = @_;
 647 +    unless ($current) {
 648 +       warn "Tried to issue tag $tag without setting package\n";
 649 +       return 0;
 650 +    }
 651
 652 -       print "$code: $prefix: $tag$extra\n";
 653 +    my $tag_info = get_tag_info( $tag );
 654 +    unless ($tag_info) {
 655 +       warn "Tried to issue unknown tag $tag\n";
 656 +       return 0;
 657 +    }
 658 +    check_need_to_show( $tag_info, \@information );
 659 +
 660 +    record_stats( $tag_info );
 661 +
 662 +    return 1 if
 663 +       $tag_info->{overridden}{severity} != 0
 664 +       || $tag_info->{overridden}{significance} != 0
 665 +       || ( $tag_info->{overridden}{override} &&
 666 +            !$show_overrides);
 667 +
 668 +    &$output_formatter( $info{$current}, $tag_info, \@information );
 669 +    return 1;
 670  }
 671
 672  1;