This is an automated email from the git hooks/post-receive script.

intrigeri pushed a commit to tag debian_version_0_3a-1
in repository libparse-debianchangelog-perl.

commit 4100893b3a34ceed2e99bc1daeab85bb617511a0
Author: Frank Lichtenheld <fr...@lichtenheld.de>
Date:   Fri Jul 1 20:28:18 2005 +0000

    Initial revision
---
 Changes                      |  61 +++++
 MANIFEST                     |   7 +
 META.yml                     |  11 +
 Makefile.PL                  |  12 +
 README                       |  40 +++
 lib/Parse/DebianChangelog.pm | 623 +++++++++++++++++++++++++++++++++++++++++++
 t/Parse-DebianChangelog.t    |  16 ++
 7 files changed, 770 insertions(+)

diff --git a/Changes b/Changes
new file mode 100644
index 0000000..4b2c554
--- /dev/null
+++ b/Changes
@@ -0,0 +1,61 @@
+Parse-DebianChangelog (0.3a) unstable; urgency=low
+
+  * Fix issue with the Changes file:
+     - Use Parse-DebianChangelog instead of Parse::DebianChangelog
+       as "package" name since I the latter isn't valid for the format
+       and the former is the directory name anyway
+  * Add test that always parses the own changelog and
+    suceeds if there were no errors
+  * No code changes so version number of module not updated
+
+ -- Frank Lichtenheld <dj...@debian.org>  Fri,  1 Jul 2005 22:03:57 +0200
+
+Parse-DebianChangelog (0.3) unstable; urgency=low
+
+  * First version officially released as a module
+    (previous versions lived in the packages.debian.org
+     CVS)
+  * If get_parse_errors is called in scalar context, return
+    a usefull string representation
+  * Many more old formats added
+  * Skip more ugly stuff like:
+     - /* */ style comments
+     - Emacs local variables in lisp comments (;;)
+  * Eliminate many occourences of undefined variables
+  * Give unknown versions unique names (important e.g. for
+    producing anchors on html_out)
+
+ -- Frank Lichtenheld <dj...@debian.org>  Fri,  1 Jul 2005 21:12:47 +0200
+
+Parse-DebianChangelog (0.2) unstable; urgency=low
+
+  * Add dpkg_out function which produces the exact same output
+    as dpkg-parsechangelog (as far as tested). This isn't true
+    for error messages, though
+  * Modules only required for html_out are now loaded only if html_out
+    is called
+  * Make parse errors available to callers via get_parse_errors. With
+    the quiet option the normal output to stderr can be surpressed
+  * Let html_out deal with nearly everything it gets from parse without
+    spitting Perl warnings and still produce output which is meaningful
+    to the viewer and cleary indicates that an error has occoured
+  * Try to do some error_recovery in parse so that no entries are
+    actually and that no changes text appears under the wrong entry
+  * Let the parser deal with ugly stuff like:
+     - Emacs local variables
+     - vim at the start of the line
+     - #-style comments
+     - CVS keywords
+     - changelog entrys in old formats (I've not added support to
+       parse that, but the whole text from the first occourence will
+       be stored verbatim at a separate place. html_out makes a
+       separate section titled 'Old changelog format' for it and
+       doesn't format the text at all)
+  
+ -- Frank Lichtenheld <dj...@debian.org>  Fri,  17 Jun 2005 13:10:38 +0000
+
+Parse-DebianChangelog (0.1) unstable; urgency=low
+
+  * Initial Version 
+
+ -- Frank Lichtenheld <dj...@debian.org>  Mon,  13 Jun 2005 21:14:32 +0000
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..dfccc5d
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,7 @@
+Changes
+Makefile.PL
+MANIFEST
+README
+t/Parse-DebianChangelog.t
+lib/Parse/DebianChangelog.pm
+META.yml                                 Module meta-data (added by MakeMaker)
diff --git a/META.yml b/META.yml
new file mode 100644
index 0000000..43cc777
--- /dev/null
+++ b/META.yml
@@ -0,0 +1,11 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
+name:         Parse-DebianChangelog
+version:      0.3
+version_from: lib/Parse/DebianChangelog.pm
+installdirs:  site
+requires:
+    Date::Parse:                   0
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..58d4bbb
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,12 @@
+use 5.008004;
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+    NAME              => 'Parse::DebianChangelog',
+    VERSION_FROM      => 'lib/Parse/DebianChangelog.pm', # finds $VERSION
+    PREREQ_PM         => { Date::Parse => 0 }, # e.g., Module::Name => 1.1
+    ($] >= 5.005 ?     ## Add these new keywords supported since 5.005
+      (ABSTRACT_FROM  => 'lib/Parse/DebianChangelog.pm', # retrieve abstract 
from module
+       AUTHOR         => 'Frank Lichtenheld <fr...@lichtenheld.de>') : ()),
+);
diff --git a/README b/README
new file mode 100644
index 0000000..bd9184a
--- /dev/null
+++ b/README
@@ -0,0 +1,40 @@
+Parse-DebianChangelog version 0.1
+=================================
+
+The README is used to introduce the module and provide instructions on
+how to install the module, any machine dependencies it may have (for
+example C compilers and installed libraries) and any other information
+that should be provided before the module is installed.
+
+A README file is required for CPAN modules since CPAN extracts the
+README file from a module distribution so that people browsing the
+archive can use it get an idea of the modules uses. It is usually a
+good idea to provide version information here so that people can
+decide whether fixes for the module are worth downloading.
+
+INSTALLATION
+
+To install this module type the following:
+
+   perl Makefile.PL
+   make
+   make test
+   make install
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+  blah blah blah
+
+COPYRIGHT AND LICENCE
+
+Put the correct copyright and licence information here.
+
+Copyright (C) 2005 by Frank Lichtenheld
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.8.4 or,
+at your option, any later version of Perl 5 you may have available.
+
+
diff --git a/lib/Parse/DebianChangelog.pm b/lib/Parse/DebianChangelog.pm
new file mode 100644
index 0000000..e607c90
--- /dev/null
+++ b/lib/Parse/DebianChangelog.pm
@@ -0,0 +1,623 @@
+#
+# Parse::DebianChangelog
+#
+# Copyright 1996 Ian Jackson
+# Copyright 2005 Frank Lichtenheld <fr...@lichtenheld.de>
+#
+#    This program is free software; you can redistribute it and/or modify
+#    it under the terms of the GNU General Public License as published by
+#    the Free Software Foundation; either version 2 of the License, or
+#    (at your option) any later version.
+#
+#    This program is distributed in the hope that it will be useful,
+#    but WITHOUT ANY WARRANTY; without even the implied warranty of
+#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+#    GNU General Public License for more details.
+#
+#    You should have received a copy of the GNU General Public License
+#    along with this program; if not, write to the Free Software
+#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+#
+
+=head1 NAME
+
+Parse::DebianChangelog - parse Debian changelogs and output them in other 
formats
+
+=head1 SYNOPSIS
+
+    use Parse::DebianChangelog;
+
+    my $chglog = Parse::DebianChangelog->init( { infile => 'debian/changelog',
+                                                 HTML => { outfile => 
'changelog.html' } );
+    $chglog->html_out;
+
+    # the following is semantically equivalent
+    my $chglog = Parse::DebianChangelog->init();
+    $chglog->parse( { infile => 'debian/changelog' } );
+    $chglog->html_out( { outfile => 'changelog.html' } );
+    $chglog->dpkg_out( { since => '1.0-1' } );
+
+
+=head1 DESCRIPTION
+
+=cut
+
+package Parse::DebianChangelog;
+
+use strict;
+use warnings;
+
+use Fcntl qw( :flock );
+use English;
+use Date::Parse;
+
+require Exporter;
+
+our @ISA = qw(Exporter);
+
+our %EXPORT_TAGS = ( 'all' => [ qw(
+       
+) ] );
+
+our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
+
+our @EXPORT = qw(
+       
+);
+
+our $CLASSNAME = 'Parse::DebianChangelog';
+our $VERSION = 0.3;
+
+sub init {
+    my $classname = shift;
+    my $config = shift || {};
+    my $self = {};
+    $CLASSNAME = $classname;
+    bless( $self, $classname );
+
+    $config->{verbose} = 1 if $config->{debug};
+    $self->{config} = $config;
+
+    if ($self->{config}{infile}) {
+       $self->parse;
+    }
+
+    return $self;
+}
+
+sub reset_parse_errors {
+    my ($self) = @_;
+
+    $self->{errors}{parser} = [];
+}
+
+sub do_parse_error {
+    my ($self, $file, $line_nr, $error, $line) = @_;
+    shift;
+
+    push @{$self->{errors}{parser}}, [ @_ ];
+
+    $file = substr $file, 0, 20;
+    unless ($self->{config}{quiet}) {
+       if ($line) {
+           warn "WARN: $file(l$NR): $error\nLINE: $line\n";
+       } else {
+           warn "WARN: $file(l$NR): $error\n";
+       }
+    }
+}
+
+sub get_parse_errors {
+    my ($self) = @_;
+
+    if (wantarray) {
+       return [ $self->{errors}{parser} ];
+    } else {
+       my $res = "";
+       foreach my $e (@{$self->{errors}{parser}}) {
+           if ($e->[3]) {
+               $res .= "WARN: $e->[0](l$e->[1]): $e->[2]\nLINE: $e->[3]\n";
+           } else {
+               $res .= "WARN: $e->[0](l$e->[1]): $e->[2]\n";
+           }
+       }
+       return $res;
+    }
+}
+
+sub parse {
+    my ($self, $config) = @_;
+
+    foreach my $c (keys %$config) {
+       $self->{config}{$c} = $config->{$c};
+    }
+    my $file = $self->{config}{infile} or return undef;
+
+    $self->reset_parse_errors;
+
+    open my $fh, '<', $file or return undef;
+    flock $fh, LOCK_SH or return undef;
+
+    $self->{data} = [];
+
+# based on /usr/lib/dpkg/parsechangelog/debian
+    my $expect='first heading';
+    my %entry = ();
+    my $blanklines = 0;
+    my $unknowncounter = 1; # to make version unique, e.g. for using as id
+
+    while (<$fh>) {
+       s/\s*\n$//;
+#      printf(STDERR "%-39.39s %-39.39s\n",$expect,$_);
+       if (m/^(\w[-+0-9a-z.]*) \(([^\(\) \t]+)\)((\s+[-0-9a-z]+)+)\;/i) {
+           unless ($expect eq 'first heading'
+                   || $expect eq 'next heading or eof') {
+               $entry{ERROR} = [ $file, $NR,
+                                 "found start of entry where expected 
$expect", "$_" ];
+               $self->do_parse_error(@{$entry{ERROR}});
+           }
+           if (%entry) {
+               my @closes;
+               while ($entry{'Changes'} && ($entry{'Changes'} =~ 
/closes:\s*(?:bug)?\#?\s?\d+(?:,\s*(?:bug)?\#?\s?\d+)*/ig)) {
+                   push(@closes, $& =~ /\#?\s?(\d+)/g);
+               }
+               $entry{'Closes'} = [ sort { $a <=> $b } @closes ];
+               
+#                  print STDERR, Dumper(%entry);
+               push @{$self->{data}}, { %entry };
+               %entry = ();
+           }
+           {
+               $entry{'Source'} = $1;
+               $entry{'Version'} = $2;
+               $entry{'Header'} = $_;
+               ($entry{'Distribution'} = $3) =~ s/^\s+//;
+               $entry{'Changes'} = $entry{'Urgency_Comment'} = '';
+               $entry{'Urgency'} = $entry{'Urgency_LC'} = 'unknown';
+           }
+           (my $rhs = $POSTMATCH) =~ s/^\s+//;
+           my %kvdone;
+#          print STDERR "RHS: $rhs\n";
+           for my $kv (split(/\s*,\s*/,$rhs)) {
+               $kv =~ m/^([-0-9a-z]+)\=\s*(.*\S)$/i ||
+                   $self->do_parse_error($file, $NR, "bad key-value after 
\`;': \`$kv'");
+               my $k = ucfirst $1;
+               my $v = $2;
+               $kvdone{$k}++ && $self->do_parse_error($file, $NR,
+                                                      "repeated key-value $k");
+               if ($k eq 'Urgency') {
+                   $v =~ m/^([-0-9a-z]+)((\s+.*)?)$/i ||
+                       $self->do_parse_error($file, $NR,
+                                             "badly formatted urgency value",
+                                             $v);
+                   $entry{'Urgency'} = $1;
+                   $entry{'Urgency_LC'} = lc($1);
+                   $entry{'Urgency_Comment'} = $2 || '';
+               } elsif ($k =~ m/^X[BCS]+-/i) {
+                   # Extensions - XB for putting in Binary,
+                   # XC for putting in Control, XS for putting in Source
+                   $entry{$k}= $v;
+               } else {
+                   $self->do_parse_error($file, $NR,
+                                         "unknown key-value key $k - copying 
to XS-$k");
+                   $entry{"XS-$k"} = $v;
+               }
+           }
+           $expect= 'start of change data';
+           $blanklines = 0;
+       } elsif (m/^(;;\s*)?Local variables:/io) {
+           last; # skip Emacs variables at end of file
+       } elsif (m/^vim:/io) {
+           last; # skip vim variables at end of file
+       } elsif (m/^\$\w+:.*\$/o) {
+           next; # skip stuff that look like a CVS keyword
+       } elsif (m/^\# /o) {
+           next; # skip comments, even that's not supported
+       } elsif (m,^/\*.*\*/,o) {
+           next; # more comments
+       } elsif (m/^(\w+\s+\w+\s+\d{1,2} 
\d{1,2}:\d{1,2}:\d{1,2}\s+[\w\s]*\d{4})\s+(.*)\s+(<|\()(.*)(\)|>)/o
+                || 
m/^(\w+\s+\w+\s+\d{1,2},?\s*\d{4})\s+(.*)\s+(<|\()(.*)(\)|>)/o
+                || m/^(\w[-+0-9a-z.]*) \(([^\(\) \t]+)\)\;?/io
+                || m/^([\w.+-]+)(-| )(\S+) Debian (\S+)/io
+                || m/^Changes from version (.*) to (.*):/io
+                || m/^Changes for [\w.+-]+-[\w.+-]+:?$/io
+                || m/^Old Changelog:$/io
+                || m/^(?:\d+:)?[\w.+~-]+:?$/o) {
+           # save entries on old changelog format verbatim
+           # we assume the rest of the file will be in old format once we
+           # hit it for the first time
+           $self->{oldformat} = "$_\n";
+           $self->{oldformat} .= join "", <$fh>;
+       } elsif (m/^\S/) {
+           $self->do_parse_error($file, $NR,
+                                 "badly formatted heading line", "$_");
+       } elsif (m/^ \-\- (.*) <(.*)>(  
?)((\w+\,\s*)?\d{1,2}\s+\w+\s+\d{4}\s+\d{1,2}:\d\d:\d\d\s+[-+]\d{4}(\s+\([^\\\(\)]\))?)$/o)
 {
+           $expect eq 'more change data or trailer' ||
+               $self->do_parse_error($file, $NR,
+                       "found trailer where expected $expect", "$_");
+           if ($3 ne '  ') {
+               $self->do_parse_error($file, $NR,
+                                     "badly formatted trailer line", "$_");
+           }
+           $entry{'Trailer'} = $_;
+           $entry{'Maintainer'} = "$1 <$2>" unless $entry{'Maintainer'};
+           unless($entry{'Date'} && $entry{'Parsed_Date'}) {
+               $entry{'Date'} = $4;
+               $entry{'Parsed_Date'} = str2time($4)
+                   or $self->do_parse_error( $file, $NR, "couldn't parse date 
$4" );
+           }
+           $expect = 'next heading or eof';
+       } elsif (m/^ \-\-/) {
+           $entry{ERROR} = [ $file, $NR,
+                             "badly formatted trailer line", "$_" ];
+           $self->do_parse_error(@{$entry{ERROR}});
+#          $expect = 'next heading or eof'
+#              if $expect eq 'more change data or trailer';
+       } elsif (m/^\s{2,}(\S)/) {
+           $expect eq 'start of change data'
+               || $expect eq 'more change data or trailer'
+               || do {
+                   $self->do_parse_error($file, $NR,
+                           "found change data where expected $expect", "$_");
+                   if (($expect eq 'next heading or eof')
+                       && %entry) {
+                       # lets assume we have missed the actual header line
+                       my @closes;
+                       while ($entry{'Changes'} && ($entry{'Changes'} =~ 
/closes:\s*(?:bug)?\#?\s?\d+(?:,\s*(?:bug)?\#?\s?\d+)*/igo)) {
+                           push(@closes, $& =~ /\#?\s?(\d+)/g);
+                       }
+                       $entry{'Closes'} = [ sort { $a <=> $b } @closes ];
+                       
+#                  print STDERR, Dumper(%entry);
+                       push @{$self->{data}}, { %entry };
+                       %entry = ();
+                       $entry{Source} =
+                           $entry{Distribution} = $entry{Urgency} = 
+                           $entry{Urgency_LC} = 'unknown';
+                       $entry{Version} = 'unknown'.($unknowncounter++);
+                       $entry{Urgency_Comment} = '';
+                       $entry{ERROR} = [ $file, $NR,
+                           "found change data where expected $expect", "$_" ];
+                   }
+               };
+           $entry{'Changes'} .= (" \n" x $blanklines)." $_\n";
+           if (!$entry{'Items'} || ($1 eq '*')) {
+               $entry{'Items'} ||= [];
+               push @{$entry{'Items'}}, "$_\n";
+           } else {
+               $entry{'Items'}[-1] .= (" \n" x $blanklines)." $_\n";
+           }
+           $blanklines = 0;
+           $expect = 'more change data or trailer';
+       } elsif (!m/\S/) {
+           next if $expect eq 'start of change data'
+               || $expect eq 'next heading or eof';
+           $expect eq 'more change data or trailer'
+               || $self->do_parse_error($file, $NR,
+                                        "found blank line where expected 
$expect");
+           $blanklines++;
+       } else {
+           $self->do_parse_error($file, $NR, "unrecognised line", "$_");
+           ($expect eq 'start of change data'
+               || $expect eq 'more change data or trailer')
+               && do {
+                   # lets assume change data if we expected it
+                   $entry{'Changes'} .= (" \n" x $blanklines)." $_\n";
+                   if (!$entry{'Items'}) {
+                       $entry{'Items'} ||= [];
+                       push @{$entry{'Items'}}, "$_\n";
+                   } else {
+                       $entry{'Items'}[-1] .= (" \n" x $blanklines)." $_\n";
+                   }
+                   $blanklines = 0;
+                   $expect = 'more change data or trailer';
+                   $entry{ERROR} = [ $file, $NR, "unrecognised line", "$_" ];
+               };
+       }
+    }
+
+    $expect eq 'next heading or eof'
+       || do {
+           $entry{ERROR} = [ $file, $NR, "found eof where expected $expect" ];
+           $self->do_parse_error( @{$entry{ERROR}} );
+       };
+    if (%entry) {
+       my @closes;
+       while ($entry{'Changes'} =~ 
/closes:\s*(?:bug)?\#?\s?\d+(?:,\s*(?:bug)?\#?\s?\d+)*/ig) {
+           push(@closes, $& =~ /\#?\s?(\d+)/g);
+       }
+       $entry{'Closes'} = join(' ', sort { $a <=> $b } @closes);
+       
+       push @{$self->{data}}, \%entry;
+    }
+    
+    close $fh or return undef;
+
+#    use Data::Dumper;
+#    print Dumper( $self );
+
+    return $self;
+}
+
+sub dpkg_out {
+    my ($self, $config) = @_;
+
+    $self->{config}{DPKG} = $config if $config;
+
+    $config = $self->{config}{DPKG} || {};
+    my $data = $self->{data} or return undef;
+    my $since = $config->{since} || '';
+
+    my $dpkglibdir="/usr/lib/dpkg";
+    push @INC, $dpkglibdir;
+    require 'controllib.pl';
+
+    our ( %fieldimps, %urgencies, %f );
+    my $i=100;
+    grep($fieldimps{$_}=$i--,
+        qw(Source Version Distribution Urgency Maintainer Date Closes
+           Changes));
+    $i=1;
+    grep($urgencies{$_}=$i++,
+        qw(low medium high critical emergency));
+
+    foreach my $field (qw( Urgency Source Version
+                          Distribution Maintainer Date )) {
+       $f{$field} = $data->[0]{$field};
+    }
+
+    error( "-v<since> option specifies most recent version" )
+       if $f{Version} eq $since;
+
+    $f{Changes} = "\n $data->[0]{Header}\n .\n$data->[0]{Changes}";
+    chomp $f{Changes};
+    $f{Closes} = "@{$data->[0]{Closes}}";
+
+    my $first = 1;
+    foreach my $entry (@$data) {
+       $first = 0, next if $first;
+       last if !$since or $entry->{Version} eq $since;
+
+       my $oldurg = $f{Urgency} || '';
+       my $oldurgn = $urgencies{$f{Urgency}} || -1;
+       my $newurg = $entry->{Urgency_LC} || '';
+       my $newurgn = $urgencies{$entry->{Urgency_LC}} || -1;
+       $f{Urgency} = ($newurgn > $oldurgn) ? $newurg : $oldurg;
+       $f{Urgency_Comment} .= $entry->{Urgency_Comment};
+       
+       $f{Changes} .= "\n .\n $entry->{Header}\n .\n$entry->{Changes}";
+       chomp $f{Changes};
+       $f{Closes} .= " @{$entry->{Closes}}";
+
+    }
+
+    $f{Changes} =~ s/^ $/ ./mgo;
+    $f{Urgency} .= $f{Urgency_Comment};
+    delete $f{Urgency_Comment};
+
+    outputclose(0);
+}
+
+sub html_out {
+    my ($self, $config) = @_;
+    
+    $self->{config}{HTML} = $config if $config;
+    $config = $self->{config}{HTML} || {};
+    my $data = $self->{data} or return undef;
+
+    require CGI;
+    import CGI qw( -no_xhtml -no_debug );
+    require HTML::Entities;
+    import HTML::Entities;
+    require URI::Escape;
+    import URI::Escape;
+
+    my $outfile = $config->{outfile} or return undef;
+    my $cgi = new CGI;
+
+    open my $fh, '>', $outfile or return undef;
+    flock $fh, LOCK_EX or return undef;
+
+    print $fh $cgi->start_html( -title => $config->{title}
+                               || "Debian Changelog $data->[0]{Source} 
($data->[0]{Version})",
+                               -author => $config->{author}
+                               || $data->[0]{Maintainer},
+                               -meta=>{ keywords => $config->{keywords}
+                                        || "Debian Changelog 
$data->[0]{Source} $data->[0]{Version}",
+                                        generator => "$CLASSNAME (v$VERSION)" 
},
+                               -head=>[ $cgi->meta({ -http_equiv => 
'Content-Type',
+                                                     -content => 'text/html; 
charset=UTF-8' }),
+                                        $cgi->Link({-rel=>'stylesheet',
+                                                    -href => $config->{style}
+                                                    || 'changelogs.css',
+                                                    -type => 'text/css',
+                                                    -media => 'screen' }),
+                                        $cgi->Link({-rel=>'stylesheet',
+                                                    -href => 
$config->{print_style}
+                                                    || 'changelogs-print.css',
+                                                    -type => 'text/css',
+                                                    -media => 'print' }),
+                                        ],
+                               );
+
+    print $fh $cgi->p({ -class=>'hide' },
+                     $cgi->a({ -href=>'#content' },
+                             'Skip to content' ));
+
+    print $fh $cgi->ul( { -class=>'navbar' },
+                       $cgi->li( [
+                                  $cgi->a({ 
-href=>"http://packages.debian.org/src:$data->[0]{Source}" }, 'Package 
Information' ),
+                                  $cgi->a({ 
-href=>"http://packages.qa.debian.org/$data->[0]{Source}" }, 'Package Developer 
Information' ),
+                                  $cgi->a({ 
-href=>"http://bugs.debian.org/src:$data->[0]{Source}" }, 'Bug Information' ),
+                                  ] ) );
+
+    print $fh $cgi->h1( { -class=>"document_header" },
+                       $config->{title}
+                       || "Debian Changelog $data->[0]{Source} 
($data->[0]{Version})" );
+
+    my %navigation;
+    my $last_year;
+    foreach my $entry (@$data) {
+       my $year = $last_year; # try to deal gracefully with unparsable dates
+       if ($entry->{Parsed_Date}) {
+           $year = (gmtime($entry->{Parsed_Date}))[5] + 1900;
+           $last_year = $year;
+       }
+       
+       $year ||= (($entry->{Date} =~ /\s(\d{4})\s/) ? $1 : (gmtime)[5] + 1900);
+       $navigation{$year} ||= [];
+       $entry->{Maintainer} ||= 'unkown';
+       $entry->{Date} ||= 'unkown';
+       push @{$navigation{$year}}, $cgi->a({-href=>"#version$entry->{Version}",
+                                            
-title=>encode_entities("$entry->{Maintainer} $entry->{Date}",'<>&"')},
+                                           $entry->{Version});
+    }
+    print $fh $cgi->start_ul( { -class=>'outline' } );
+    foreach my $y (reverse sort keys %navigation) {
+       print $fh $cgi->li(
+                          $cgi->a({ -href=>"#year$y" },$y).": ".
+                          $cgi->ul( $cgi->li( $navigation{$y} ) ) );
+    }
+    if ($self->{oldformat}) {
+       print $fh $cgi->li($cgi->a({ -href=>'#oldformat' }, 'old format'));
+    }
+    print $fh $cgi->end_ul;
+       
+    print $fh $cgi->start_div({ -id=>'content'});
+    $last_year = undef;
+    foreach my $entry (@$data) {
+       my $year = $last_year; # try to deal gracefully with unparsable dates
+       if ($entry->{Parsed_Date}) {
+           $year = (gmtime($entry->{Parsed_Date}))[5] + 1900;
+       }
+       $year ||= (($entry->{Date} =~ /\s(\d{4})\s/) ? $1 : (gmtime)[5] + 
1900);        
+
+       if (!$last_year || ($year < $last_year)) {
+           print $fh $cgi->h2( { -class=>'year_header',
+                                 -id=>"year$year" }, $year );
+           $last_year = $year;
+       }
+
+       my $pkg = $cgi->a({ -href=>"http://packages.debian.org/src:";.
+                               uri_escape($entry->{Source}),
+                           -class=>'packagelink' }, 
+                         $entry->{Source} );
+
+       print $fh $cgi->h3( { -class=>'entry_header',
+                             -id=>"version$entry->{Version}" },
+                           "$pkg ($entry->{Version}) ".
+                           $cgi->span( { -class=>$entry->{Distribution} },
+                                       $entry->{Distribution} ).
+                           "; urgency=".
+                           $cgi->span( { -class=>$entry->{Urgency_LC} },
+                                       $entry->{Urgency}.
+                                       $entry->{Urgency_Comment} ) );
+       
+       my $text = encode_entities( $entry->{Changes}, '<>&"' ) || "";
+       $text=~ s|&lt;URL:([-\w\.\/:~_\@]+):([a-zA-Z0-9\'() ]+)&gt;
+                |$cgi->a({ -href=>$1 }, $2)
+                |xego;
+       $text=~ s|https?:[\w/\.:\@+\-~\%\#?=&;,]+[\w/]
+                |$cgi->a({ -href=>$& }, $&)
+                |xego;
+       $text=~ s|ftp:[\w/\.:\@+\-~\%\#?=&;,]+[\w/]
+                |$cgi->a({ -href=>$& }, $&)
+                |xego;
+       $text=~ s|[a-zA-Z0-9_\+\-\.]+\@([a-zA-Z0-9][\w\.+\-]+\.[a-zA-Z]{2,})
+                |$cgi->a({ 
-href=>"http://qa.debian.org/developer.php?login=$&"; }, $&)
+                |xego;
+       $text=~ s|Closes:\s*(?:Bug)?\#\d+(?:\s*,\s*(?:Bug)?\#\d+)*
+                |my $tmp = $&; { no warnings;
+                 $tmp =~ s@(Bug)?\#(\d+)@<a class="buglink" 
href="http://bugs.debian.org/$2";>$1\#$2</a>@ig; }
+                 "$tmp"
+                |xiego;
+       $text=~ s|\B\*([a-z][a-z -]*[a-z])\*\B
+                |$cgi->em($1)
+                |xiego;
+       $text=~ s|\B\*([a-z])\*\B
+                |$cgi->em($1)
+                |xiego;
+       $text=~ s|\B\#([a-z][a-z -]*[a-z])\#\B
+                |$cgi->strong($1)
+                |xego;
+       $text=~ s|\B\#([a-z])\#\B
+                |$cgi->strong($1)
+                |xego;
+       $text=~ s|/usr/share/common-licenses/GPL(?:-2)?
+                |$cgi->a({ -href=>"http://www.gnu.org/copyleft/gpl.html"; }, $&)
+                |xego;
+       $text=~ s|/usr/share/common-licenses/LGPL(?:-2(?:\.1)?)?
+                |$cgi->a({ -href=>"http://www.gnu.org/copyleft/lgpl.html"; }, 
$&)
+                |xego;
+       $text=~ s|/usr/share/common-licenses/Artistic
+                |$cgi->a({ 
-href=>"http://www.opensource.org/licenses/artistic-license.php"; }, $&)
+                |xego;
+       $text=~ s|/usr/share/common-licenses/BSD
+                |$cgi->a({ -href=>"http://www.debian.org/misc/bsd.license"; }, 
$&)
+                |xego;
+
+       print $fh $cgi->pre($text);
+
+       my $maint = encode_entities( $entry->{Maintainer}, '<>&"' );
+       $maint =~ s|[a-zA-Z0-9_\+\-\.]+\@([a-zA-Z0-9][\w\.+\-]+\.[a-zA-Z]{2,})
+                  |$cgi->a({ 
-href=>"http://qa.debian.org/developer.php?login=$&"; }, $&)
+                  |xego;
+
+       print $fh $cgi->p( { -class=>'trailer' }, "  -- $maint $entry->{Date}" 
);
+       print $fh $cgi->p( { -class=>'parse_error' },
+                          "(There has been a parse error in the entry above, 
if some values don't make sense please check the original changelog)" ) if 
$entry->{ERROR};
+
+    }
+    if ($self->{oldformat}) {
+       print $fh $cgi->h2({ -class=>'year_header', -id=>'oldformat' },
+                          'Old changelog format(s), not parsed' );
+       print $fh $cgi->pre({ -class=>'oldformat' },
+                           encode_entities( $self->{oldformat}, '<>&"' ) );
+    }
+    print $fh $cgi->end_div; # content
+    
+    print $fh $cgi->div({-class=>'footer'},
+                       $cgi->hr({-class=>'hide'}).
+                       $cgi->address(
+                                     'Generated '.
+                                     gmtime().
+                                     ' UTC by '.
+                                     $cgi->tt("$CLASSNAME (v$VERSION)").
+                                     $cgi->br().
+                                     'Contact '.
+                                     $cgi->a({ 
-href=>'mailto:debian-...@lists.debian.org' },
+                                             'debian-...@lists.debian.org' ).
+                                     ' in case of problems.'
+                                     ) );
+
+    print $fh $cgi->end_html;
+    close $fh or return undef;
+
+    return $self;
+}
+
+1;
+__END__
+=head1 AUTHOR
+
+Frank Lichtenheld, E<lt>fr...@lichtenheld.dee<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2005 by Frank Lichtenheld
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+
+=cut
diff --git a/t/Parse-DebianChangelog.t b/t/Parse-DebianChangelog.t
new file mode 100644
index 0000000..1a46d28
--- /dev/null
+++ b/t/Parse-DebianChangelog.t
@@ -0,0 +1,16 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl 
Parse-DebianChangelog.t'
+
+#########################
+
+# change 'tests => 1' to 'tests => last_test_to_print';
+
+use Test::More tests => 2;
+BEGIN { use_ok('Parse::DebianChangelog') };
+
+#########################
+
+my $changes = Parse::DebianChangelog->init( { infile => 'Changes' } );
+my $errors = $changes->get_parse_errors();
+
+ok( !$errors, 'Parse the own changelog without errors' );

-- 
Alioth's /usr/local/bin/git-commit-notice on 
/srv/git.debian.org/git/pkg-perl/packages/libparse-debianchangelog-perl.git

_______________________________________________
Pkg-perl-cvs-commits mailing list
Pkg-perl-cvs-commits@lists.alioth.debian.org
http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-perl-cvs-commits

Reply via email to