--- /dev/null
+#
+# Deb::Versions
+# $Id$
+#
+# Copyright 2003, 2004 Frank Lichtenheld <frank@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
+
+Deb::Versions - compare Versions of Debian packages
+
+=head1 SYNOPSIS
+
+ use Deb::Versions
+
+ my $res = version_cmp( "1:0.2.2-2woody1", "1:0.2.3-7" );
+
+ my @sorted = version_sort( "1:0.2.2-2woody1", "1:0.2.3-7", "2:0.1.1" );
+
+=head1 DESCRIPTION
+
+This module allows you to compare version numbers like defined
+in the Debian policy, section 5.6.11 (L<SEE ALSO>).
+
+It provides two functions:
+
+=over 4
+
+=item *
+
+version_cmp() gets two version strings as parameters and returns
+-1, if the first is lower than the second, 0 if equal, 1 if greater.
+You can use this function as first parameter for the sort() function.
+
+=item *
+
+version_sort() is just an usefull abbrevation for
+
+ sort { version_cmp( $b, $a ) } @_;
+
+=back
+
+=head1 EXPORTS
+
+By default, Deb::Versions exports version_cmp() and version_sort().
+
+=cut
+
+package Deb::Versions;
+
+use strict;
+use Exporter;
+
+our @ISA = qw( Exporter );
+our @EXPORT = qw( version_cmp version_sort );
+
+our $VERSION = v1.0.0;
+
+sub version_cmp {
+ my ( $ver1, $ver2 ) = @_;
+
+ my ( $e1, $e2, $u1, $u2, $d1, $d2 );
+ my $re = qr/^(?:(\d+):)?([\w.+:~-]+?)(?:-([\w+.~]+))?$/;
+ if ( $ver1 =~ $re ) {
+ ( $e1, $u1, $d1 ) = ( $1, $2, $3 );
+ $e1 ||= 0;
+ } else {
+ warn "This seems not to be a valid version number:"
+ . "<$ver1>\n";
+ return -1;
+ }
+ if ( $ver2 =~ $re ) {
+ ( $e2, $u2, $d2 ) = ( $1, $2, $3 );
+ $e2 ||= 0;
+ } else {
+ warn "This seems not to be a valid version number:"
+ . "<$ver2>\n";
+ return 1;
+ }
+
+# warn "D: <$e1><$u1><$d1> <=> <$e2><$u2><$d2>\n";
+
+ my $res = ($e1 <=> $e2);
+ return $res if $res;
+ $res = _cmp_part ( $u1, $u2 );
+ return $res if $res;
+ $res = _cmp_part ( $d1, $d2 );
+ return $res;
+}
+
+sub version_sort {
+ return sort { version_cmp( $b, $a ) } @_;
+}
+
+sub _cmp_part {
+ my ( $v1, $v2 ) = @_;
+ my $r;
+
+ while ( $v1 && $v2 ) {
+ $v1 =~ s/^(\D*)//o;
+ my $sp1 = $1;
+ $v2 =~ s/^(\D*)//o;
+ my $sp2 = $1;
+# warn "$sp1 cmp $sp2 = "._lcmp( $sp1,$sp2)."\n";
+ if ( $r = _lcmp( $sp1, $sp2 ) ) {
+ return $r;
+ }
+ $v1 =~ s/^(\d*)//o;
+ my $np1 = $1 || 0;
+ $v2 =~ s/^(\d*)//o;
+ my $np2 = $1 || 0;
+# warn "$np1 <=> $np2 = ".($np1 <=> $np2)."\n";
+ if ( $r = ($np1 <=> $np2) ) {
+ return $r;
+ }
+ }
+ if ( $v1 || $v2 ) {
+ return $v1 ? 1 : -1;
+ }
+
+ return 0;
+}
+
+sub _lcmp {
+ my ( $v1, $v2 ) = @_;
+
+ for ( my $i = 0; $i < length( $v1 ); $i++ ) {
+ my ( $n1, $n2 ) = ( ord( substr( $v1, $i, 1 ) ),
+ ord( substr( $v2, $i, 1 ) ) );
+ $n1 += 256 if $n1 < 65; # letters sort earlier than non-letters
+ $n1 = -1 if $n1 == 126; # '~' sorts earlier than everything else
+ $n2 += 256 if $n2 < 65;
+ $n2 = -1 if $n2 == 126;
+ if ( my $r = ($n1 <=> $n2) ) {
+ return $r;
+ }
+ }
+ return length( $v1 ) <=> length( $v2 );
+}
+
+1;
+__END__
+
+=head1 COPYRIGHT
+
+Copyright 2003, 2004 Frank Lichtenheld <frank@lichtenheld.de>
+
+This file is distributed under the terms of the GNU Public
+License, Version 2. See the source code for more details.
+
+=head1 SEE ALSO
+
+Debian policy <URL:http://www.debian.org/doc/debian-policy/>
--- /dev/null
+package Parse::DebControl;
+
+###########################################################
+# Parse::DebControl - Parse debian-style control
+# files (and other colon key-value fields)
+#
+# Copyright 2003 - Jay Bonci <jaybonci@cpan.org>
+# Licensed under the same terms as perl itself
+#
+###########################################################
+
+use strict;
+use IO::Scalar;
+
+use vars qw($VERSION);
+$VERSION = '1.8';
+
+sub new {
+ my ($class, $debug) = @_;
+ my $this = {};
+
+ my $obj = bless $this, $class;
+ if($debug)
+ {
+ $obj->DEBUG();
+ }
+ return $obj;
+};
+
+sub parse_file {
+ my ($this, $filename, $options) = @_;
+ unless($filename)
+ {
+ $this->_dowarn("parse_file failed because no filename parameter was given");
+ return;
+ }
+
+ my $fh;
+ unless(open($fh,"$filename"))
+ {
+ $this->_dowarn("parse_file failed because $filename could not be opened for reading");
+ return;
+ }
+
+ return $this->_parseDataHandle($fh, $options);
+};
+
+sub parse_mem {
+ my ($this, $data, $options) = @_;
+
+ unless($data)
+ {
+ $this->_dowarn("parse_mem failed because no data was given");
+ return;
+ }
+
+ my $IOS = new IO::Scalar \$data;
+
+ unless($IOS)
+ {
+ $this->_dowarn("parse_mem failed because IO::Scalar creation failed.");
+ return;
+ }
+
+ return $this->_parseDataHandle($IOS, $options);
+
+};
+
+sub write_file {
+ my ($this, $filenameorhandle, $dataorarrayref, $options) = @_;
+
+ unless($filenameorhandle)
+ {
+ $this->_dowarn("write_file failed because no filename or filehandle was given");
+ return;
+ }
+
+ unless($dataorarrayref)
+ {
+ $this->_dowarn("write_file failed because no data was given");
+ return;
+ }
+
+ my $handle = $this->_getValidHandle($filenameorhandle, $options);
+
+ unless($handle)
+ {
+ $this->_dowarn("write_file failed because we couldn't negotiate a valid handle");
+ return;
+ }
+
+ my $arrayref = $this->_makeArrayref($dataorarrayref);
+
+ my $string = $this->_makeControl($arrayref);
+ $string ||= "";
+
+ print $handle $string;
+ close $handle;
+
+ return length($string);
+}
+
+sub write_mem {
+ my ($this, $dataorarrayref, $options) = @_;
+
+ unless($dataorarrayref)
+ {
+ $this->_dowarn("write_mem failed because no data was given");
+ return;
+ }
+
+ my $arrayref = $this->_makeArrayref($dataorarrayref);
+
+ my $string = $this->_makeControl($arrayref);
+
+ return $string;
+}
+
+sub DEBUG
+{
+ my($this, $verbose) = @_;
+ $verbose = 1 unless(defined($verbose) and int($verbose) == 0);
+ $this->{_verbose} = $verbose;
+ return;
+
+}
+
+sub _getValidHandle {
+ my($this, $filenameorhandle, $options) = @_;
+
+ if(ref $filenameorhandle eq "GLOB")
+ {
+ unless($filenameorhandle->opened())
+ {
+ $this->_dowarn("Can't get a valid filehandle to write to, because that is closed");
+ return;
+ }
+
+ return $filenameorhandle;
+ }else
+ {
+ my $openmode = ">>";
+ $openmode=">" if $options->{clobberFile};
+ $openmode=">>" if $options->{appendFile};
+
+ my $handle;
+
+ unless(open $handle,"$openmode$filenameorhandle")
+ {
+ $this->_dowarn("Couldn't open file: $openmode$filenameorhandle for writing");
+ return;
+ }
+
+ return $handle;
+ }
+}
+
+sub _makeArrayref {
+ my ($this, $dataorarrayref) = @_;
+
+ if(ref $dataorarrayref eq "ARRAY")
+ {
+ return $dataorarrayref;
+ }else{
+ return [$dataorarrayref];
+ }
+}
+
+sub _makeControl
+{
+ my ($this, $dataorarrayref) = @_;
+
+ my $str;
+
+ foreach my $stanza(@$dataorarrayref)
+ {
+ foreach my $key(keys %$stanza)
+ {
+ $stanza->{$key} ||= "";
+
+ my @lines = split("\n", $stanza->{$key});
+ if (@lines) {
+ $str.="$key\: ".(shift @lines)."\n";
+ } else {
+ $str.="$key\:\n";
+ }
+
+ foreach(@lines)
+ {
+ if($_ eq "")
+ {
+ $str.=" .\n";
+ }
+ else{
+ $str.=" $_\n";
+ }
+ }
+
+ }
+
+ $str ||= "";
+ $str.="\n";
+ }
+
+ chomp($str);
+ return $str;
+
+}
+
+sub _parseDataHandle
+{
+ my ($this, $handle, $options) = @_;
+
+ my $structs;
+
+ unless($handle)
+ {
+ $this->_dowarn("_parseDataHandle failed because no handle was given. This is likely a bug in the module");
+ return;
+ }
+
+ my $data = $this->_getReadyHash($options);
+
+ my $linenum = 0;
+ my $lastfield = "";
+
+ foreach my $line (<$handle>)
+ {
+ #Sometimes with IO::Scalar, lines may have a newline at the end
+ chomp $line;
+
+ if($options->{stripComments}){
+ next if $line =~ /^\s*\#/;
+ $line =~ s/\#.*//
+ }
+
+ $linenum++;
+ if($line =~ /^[^\t\s]/)
+ {
+ #we have a valid key-value pair
+ if($line =~ /(.*?)\s*\:\s*(.*)$/)
+ {
+ my $key = $1;
+ my $value = $2;
+
+ if($options->{discardCase})
+ {
+ $key = lc($key);
+ }
+
+ unless($options->{verbMultiLine})
+ {
+ $value =~ s/[\s\t]+$//;
+ }
+
+ $data->{$key} = $value;
+
+
+ if ($options->{verbMultiLine}
+ && (($data->{$lastfield} || "") =~ /\n/o)){
+ $data->{$lastfield} .= "\n";
+ }
+
+ $lastfield = $key;
+ }else{
+ $this->_dowarn("Parse error on line $linenum of data; invalid key/value stanza");
+ return $structs;
+ }
+
+ }elsif($line =~ /^([\t\s])(.*)/)
+ {
+ #appends to previous line
+
+ unless($lastfield)
+ {
+ $this->_dowarn("Parse error on line $linenum of data; indented entry without previous line");
+ return $structs;
+ }
+ if($options->{verbMultiLine}){
+ $data->{$lastfield}.="\n$1$2";
+ }elsif($2 eq "." ){
+ $data->{$lastfield}.="\n";
+ }else{
+ my $val = $2;
+ $val =~ s/[\s\t]+$//;
+ $data->{$lastfield}.="\n$val";
+ }
+
+ }elsif($line =~ /^[\s\t]*$/){
+ if ($options->{verbMultiLine}
+ && ($data->{$lastfield} =~ /\n/o)) {
+ $data->{$lastfield} .= "\n";
+ }
+ if(keys %$data > 0){
+ push @$structs, $data;
+ }
+ $data = $this->_getReadyHash($options);
+ $lastfield = "";
+ }else{
+ $this->_dowarn("Parse error on line $linenum of data; unidentified line structure");
+ return $structs;
+ }
+
+ }
+
+ if(keys %$data > 0)
+ {
+ push @$structs, $data;
+ }
+
+ return $structs;
+}
+
+sub _getReadyHash
+{
+ my ($this, $options) = @_;
+ my $data;
+
+ if($options->{useTieIxHash})
+ {
+ eval("use Tie::IxHash");
+ if($@)
+ {
+ $this->_dowarn("Can't use Tie::IxHash. You need to install it to have this functionality");
+ return;
+ }
+ tie(%$data, "Tie::IxHash");
+ return $data;
+ }
+
+ return {};
+}
+
+sub _dowarn
+{
+ my ($this, $warning) = @_;
+
+ if($this->{_verbose})
+ {
+ warn "DEBUG: $warning";
+ }
+
+ return;
+}
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+Parse::DebControl - Easy OO parsing of debian control-like files
+
+=head1 SYNOPSIS
+
+ use Parse::DebControl
+
+ $parser = new Parse::DebControl;
+
+ $data = $parser->parse_mem($control_data, %options);
+ $data = $parser->parse_file('./debian/control', %options);
+
+ $writer = new Parse::DebControl;
+
+ $string = $writer->write_mem($singlestanza);
+ $string = $writer->write_mem([$stanza1, $stanza2]);
+
+ $writer->write_file($filename, $singlestanza, %options);
+ $writer->write_file($filename, [$stanza1, $stanza2], %options);
+
+ $writer->write_file($handle, $singlestanza, %options);
+ $writer->write_file($handle, [$stanza1, $stanza2], %options);
+
+ $parser->DEBUG();
+
+=head1 DESCRIPTION
+
+ Parse::DebControl is an easy OO way to parse debian control files and
+ other colon separated key-value pairs. It's specifically designed
+ to handle the format used in Debian control files, template files, and
+ the cache files used by dpkg.
+
+ For basic format information see:
+ http://www.debian.org/doc/debian-policy/ch-controlfields.html#s-controlsyntax
+
+ This module does not actually do any intelligence with the file content
+ (because there are a lot of files in this format), but merely handles
+ the format. It can handle simple control files, or files hundreds of lines
+ long efficiently and easily.
+
+=head2 Class Methods
+
+=over 4
+
+=item * C<new()>
+
+=item * C<new(I<$debug>)>
+
+Returns a new Parse::DebControl object. If a true parameter I<$debug> is
+passed in, it turns on debugging, similar to a call to C<DEBUG()> (see below);
+
+=back
+
+=over 4
+
+=item * C<parse_file($control_filename,I<%options>)>
+
+Takes a filename as a scalar. Will parse as much as it can,
+warning (if C<DEBUG>ing is turned on) on parsing errors.
+
+Returns an array of hashes, containing the data in the control file, split up
+by stanza. Stanzas are deliniated by newlines, and multi-line fields are
+expressed as such post-parsing. Single periods are treated as special extra
+newline deliniators, per convention. Whitespace is also stripped off of lines
+as to make it less-easy to make mistakes with hand-written conf files).
+
+The options hash can take parameters as follows. Setting the string to true
+enables the option.
+
+ useTieIxHash - Instead of an array of regular hashes, uses Tie::IxHash-
+ based hashes
+ discardCase - Remove all case items from keys (not values)
+ stripComments - Remove all commented lines in standard #comment format
+ verbMultiLine - Keep the description AS IS, and no not collapse leading
+ spaces or dots as newlines. This also keeps whitespace from being
+ stripped off the end of lines.
+
+=back
+
+=over 4
+
+=item * C<parse_mem($control_data, I<%options>)>
+
+Similar to C<parse_file>, except takes data as a scalar. Returns the same
+array of hashrefs as C<parse_file>. The options hash is the same as
+C<parse_file> as well; see above.
+
+=back
+
+=over 4
+
+=item * C<write_file($filename, $data, I<%options>)>
+
+=item * C<write_file($handle, $data>
+
+=item * C<write_file($filename, [$data1, $data2, $data3], I<%options>)>
+
+=item * C<write_file($handle, [$data, $data2, $data3])>
+
+This function takes a filename or a handle and writes the data out. The
+data can be given as a single hash(ref) or as an arrayref of hash(ref)s. It
+will then write it out in a format that it can parse. The order is dependant
+on your hash sorting order. If you care, use Tie::IxHash. Remember for
+reading back in, the module doesn't care.
+
+The I<%options> hash can contain one of the following two items:
+
+ appendFile - (default) Write to the end of the file
+ clobberFile - Overwrite the file given.
+
+Since you determine the mode of your filehandle, passing it an options hash
+obviously won't do anything; rather, it is ignored.
+
+This function returns the number of bytes written to the file, undef
+otherwise.
+
+=back
+
+=over 4
+
+=item * C<write_mem($data)>
+
+=item * C<write_mem([$data1,$data2,$data3])>;
+
+This function works similarly to the C<write_file> method, except it returns
+the control structure as a scalar, instead of writing it to a file. There
+is no I<%options> for this file (yet);
+
+=back
+
+=over 4
+
+=item * C<DEBUG()>
+
+Turns on debugging. Calling it with no paramater or a true parameter turns
+on verbose C<warn()>ings. Calling it with a false parameter turns it off.
+It is useful for nailing down any format or internal problems.
+
+=back
+
+=head1 CHANGES
+
+B<Version 1.7> - July 11th, 2003
+
+=over 4
+
+=item * By default, we now strip off whitespace unless verbMultiLine is in place. This makes sense for things like conf files where trailing whitespace has no meaning. Thanks to pudge for reporting this.
+
+=back
+
+B<Version 1.7> - June 25th, 2003
+
+=over 4
+
+=item * POD documentation error noticed again by Frank Lichtenheld
+
+=item * Also by Frank, applied a patch to add a "verbMultiLine" option so that we can hand multiline fields back unparsed.
+
+=item * Slightly expanded test suite to cover new features
+
+=back
+
+B<Version 1.6.1> - June 9th, 2003
+
+=over 4
+
+=item * POD cleanups noticed by Frank Lichtenheld. Thank you, Frank.
+
+=back
+
+B<Version 1.6> - June 2nd, 2003
+
+=over 4
+
+=item * Cleaned up some warnings when you pass in empty hashrefs or arrayrefs
+
+=item * Added stripComments setting
+
+=item * Cleaned up POD errors
+
+=back
+
+B<Version 1.5> - May 8th, 2003
+
+=over 4
+
+=item * Added a line to quash errors with undef hashkeys and writing
+
+=item * Fixed the Makefile.PL to straighten up DebControl.pm being in the wrong dir
+
+=back
+
+B<Version 1.4> - April 30th, 2003
+
+=over 4
+
+=item * Removed exports as they were unnecessary. Many thanks to pudge, who pointed this out.
+
+=back
+
+B<Version 1.3> - April 28th, 2003
+
+=over 4
+
+=item * Fixed a bug where writing blank stanzas would throw a warning. Fix found and supplied by Nate Oostendorp.
+
+=back
+
+B<Version 1.2b> - April 25th, 2003
+
+Fixed:
+
+=over 4
+
+=item * A bug in the test suite where IxHash was not disabled in 40write.t. Thanks to Jeroen Latour from cpan-testers for the report.
+
+=back
+
+B<Version 1.2> - April 24th, 2003
+
+Fixed:
+
+=over 4
+
+=item * A bug in IxHash support where multiple stanzas might be out of order
+
+=back
+
+B<Version 1.1> - April 23rd, 2003
+
+Added:
+
+=over 4
+
+=item * Writing support
+
+=item * Tie::IxHash support
+
+=item * Case insensitive reading support
+
+=back
+
+* B<Version 1.0> - April 23rd, 2003
+
+=over 4
+
+=item * This is the initial public release for CPAN, so everything is new.
+
+=back
+
+=head1 BUGS
+
+The module will let you parse otherwise illegal key-value pairs and pairs with spaces. Badly formed stanzas will do things like overwrite duplicate keys, etc. This is your problem.
+
+=head1 TODO
+
+Change the name over to the Debian:: namespace, probably as Debian::ControlFormat. This will happen as soon as the project that uses this module reaches stability, and we can do some minor tweaks.
+
+=head1 COPYRIGHT
+
+Parse::DebControl is copyright 2003 Jay Bonci E<lt>jaybonci@cpan.orgE<gt>.
+This program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
--- /dev/null
+#
+# Parse::DebianChangelog
+#
+# Copyright 1996 Ian Jackson
+# Copyright 2005 Frank Lichtenheld <frank@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., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 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;
+
+ # the following is semantically equivalent
+ my $chglog = Parse::DebianChangelog->init();
+ $chglog->parse( { infile => 'debian/changelog' } );
+ $chglog->html( { outfile => 'changelog.html' } );
+
+ my $changes = $chglog->dpkg_str( { since => '1.0-1' } );
+ print $changes;
+
+=head1 DESCRIPTION
+
+Parse::DebianChangelog parses Debian changelogs as described in the Debian
+policy (version 3.6.2.1 at the time of this writing). See section
+L<"SEE ALSO"> for locations where to find this definition.
+
+The parser tries to ignore most cruft like # or /* */ style comments,
+CVS comments, vim variables, emacs local variables and stuff from
+older changelogs with other formats at the end of the file.
+NOTE: most of these are ignored silently currently, there is no
+parser error issued for them. This should become configurable in the
+future.
+
+Beside giving access to the details of the parsed file via the
+L<"data"> method, Parse::DebianChangelog also supports converting these
+changelogs to various other formats. These are currently:
+
+=over 4
+
+=item dpkg
+
+Format as known from L<dpkg-parsechangelog(1)>. All requested entries
+(see L<"METHODS"> for an explanation what this means) are returned in
+the usual Debian control format, merged in one stanza, ready to be used
+in a F<.changes> file.
+
+=item rfc822
+
+Similar to the C<dpkg> format, but the requested entries are returned
+as one stanza each, i.e. they are not merged. This is probably the format
+to use if you want a machine-usable representation of the changelog.
+
+=item xml
+
+Just a simple XML dump of the changelog data. Without any schema or
+DTD currently, just some made up XML. The actual format might still
+change. Comments and Improvements welcome.
+
+=item html
+
+The changelog is converted to a somewhat nice looking HTML file with
+some nice features as a quick-link bar with direct links to every entry.
+NOTE: This is not very configurable yet and was specifically designed
+to be used on L<http://packages.debian.org/>. This is planned to be
+changed until version 1.0.
+
+=back
+
+=head2 METHODS
+
+=cut
+
+package Parse::DebianChangelog;
+
+use strict;
+use warnings;
+
+use Fcntl qw( :flock );
+use English;
+use Date::Parse;
+use Parse::DebianChangelog::Util qw( :all );
+use Parse::DebianChangelog::Entry;
+
+our $VERSION = '1.0';
+
+=pod
+
+=head3 init
+
+Creates a new object instance. Takes a reference to a hash as
+optional argument, which is interpreted as configuration options.
+There are currently no supported general configuration options, but
+see the other methods for more specific configuration options which
+can also specified to C<init>.
+
+If C<infile> or C<instring> are specified (see L<parse>), C<parse()>
+is called from C<init>. If a fatal error is encountered during parsing
+(e.g. the file can't be opened), C<init> will not return a
+valid object but C<undef>!
+
+=cut
+
+sub init {
+ my $classname = shift;
+ my $config = shift || {};
+ my $self = {};
+ bless( $self, $classname );
+
+ $config->{verbose} = 1 if $config->{debug};
+ $self->{config} = $config;
+
+ $self->init_filters;
+ $self->reset_parse_errors;
+
+ if ($self->{config}{infile} || $self->{config}{instring}) {
+ defined($self->parse) or return undef;
+ }
+
+ return $self;
+}
+
+=pod
+
+=head3 reset_parse_errors
+
+Can be used to delete all information about errors ocurred during
+previous L<parse> runs. Note that C<parse()> also calls this method.
+
+=cut
+
+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";
+ }
+ }
+}
+
+=pod
+
+=head3 get_parse_errors
+
+Returns all error messages from the last L<parse> run.
+If called in scalar context returns a human readable
+string representation. If called in list context returns
+an array of arrays. Each of these arrays contains
+
+=over 4
+
+=item 1.
+
+the filename of the parsed file or C<String> if a string was
+parsed directly
+
+=item 2.
+
+the line number where the error occurred
+
+=item 3.
+
+an error description
+
+=item 4.
+
+the original line
+
+=back
+
+NOTE: This format isn't stable yet and may change in later versions
+of this module.
+
+=cut
+
+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 _do_fatal_error {
+ my ($self, @msg) = @_;
+
+ $self->{errors}{fatal} = "@msg";
+ warn "FATAL: @msg\n" unless $self->{config}{quiet};
+}
+
+=pod
+
+=head3 get_error
+
+Get the last non-parser error (e.g. the file to parse couldn't be opened).
+
+=cut
+
+sub get_error {
+ my ($self) = @_;
+
+ return $self->{errors}{fatal};
+}
+
+=pod
+
+=head3 parse
+
+Parses either the file named in configuration item C<infile> or the string
+saved in configuration item C<instring>.
+Accepts a hash ref as optional argument which can contain configuration
+items.
+
+Returns C<undef> in case of error (e.g. "file not found", B<not> parse
+errors) and the object if successful. If C<undef> was returned, you
+can get the reason for the failure by calling the L<get_error> method.
+
+=cut
+
+sub parse {
+ my ($self, $config) = @_;
+
+ foreach my $c (keys %$config) {
+ $self->{config}{$c} = $config->{$c};
+ }
+
+ my ($fh, $file);
+ if ($file = $self->{config}{infile}) {
+ open $fh, '<', $file or do {
+ $self->_do_fatal_error( "can't open file $file: $!" );
+ return undef;
+ };
+ flock $fh, LOCK_SH or do {
+ $self->_do_fatal_error( "can't lock file $file: $!" );
+ return undef;
+ };
+ } elsif (my $string = $self->{config}{instring}) {
+ eval { require IO::String };
+ if ($@) {
+ $self->_do_fatal_error( "can't load IO::String: $@" );
+ return undef;
+ }
+ $fh = IO::String->new( $string );
+ $file = 'String';
+ } else {
+ $self->_do_fatal_error( 'no changelog file specified' );
+ return undef;
+ }
+
+ $self->reset_parse_errors;
+
+ $self->{data} = [];
+
+# based on /usr/lib/dpkg/parsechangelog/debian
+ my $expect='first heading';
+ my $entry = Parse::DebianChangelog::Entry->init();
+ 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}});
+ }
+ unless ($entry->is_empty) {
+ $entry->{'Closes'} = find_closes( $entry->{Changes} );
+# print STDERR, Dumper($entry);
+ push @{$self->{data}}, $entry;
+ $entry = Parse::DebianChangelog::Entry->init();
+ }
+ {
+ $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->{ExtraFields}{"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->{'Timestamp'}) {
+ $entry->{'Date'} = $4;
+ $entry->{'Timestamp'} = 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->is_empty) {
+ # lets assume we have missed the actual header line
+ $entry->{'Closes'} = find_closes( $entry->{Changes} );
+# print STDERR, Dumper($entry);
+ push @{$self->{data}}, $entry;
+ $entry = Parse::DebianChangelog::Entry->init();
+ $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}} );
+ };
+ unless ($entry->is_empty) {
+ $entry->{'Closes'} = find_closes( $entry->{Changes} );
+ push @{$self->{data}}, $entry;
+ }
+
+ if ($self->{config}{infile}) {
+ close $fh or do {
+ $self->_do_fatal_error( "can't close file $file: $!" );
+ return undef;
+ };
+ }
+
+# use Data::Dumper;
+# print Dumper( $self );
+
+ return $self;
+}
+
+=pod
+
+=head3 data
+
+C<data> returns an array (if called in list context) or a reference
+to an array of Parse::DebianChangelog::Entry objects which each
+represent one entry of the changelog.
+
+This is currently merely a placeholder to enable users to get to the
+raw data, expect changes to this API in the near future.
+
+This method supports the common output options described in
+section L<"COMMON OUTPUT OPTIONS">.
+
+=cut
+
+sub data {
+ my ($self, $config) = @_;
+
+ my $data = $self->{data};
+ if ($config) {
+ $self->{config}{DATA} = $config if $config;
+ $data = $self->_data_range( $config ) or return undef;
+ }
+ return @$data if wantarray;
+ return $data;
+}
+
+sub __sanity_check_range {
+ my ( $data, $from, $to, $since, $until, $start, $end ) = @_;
+
+ if (($$start || $$end) && ($$from || $$since || $$to || $$until)) {
+ warn( "you can't combine 'count' or 'offset' with any other range option\n" );
+ $$from = $$since = $$to = $$until = '';
+ }
+ if ($$from && $$since) {
+ warn( "you can only specify one of 'from' and 'since'\n" );
+ $$from = '';
+ }
+ if ($$to && $$until) {
+ warn( "you can only specify one of 'to' and 'until'\n" );
+ $$to = '';
+ }
+ if ($data->[0]{Version} eq $$since) {
+ warn( "'since' option specifies most recent version\n" );
+ $$since = '';
+ }
+ if ($data->[$#{$data}]{Version} eq $$until) {
+ warn( "'until' option specifies oldest version\n" );
+ $$until = '';
+ }
+ $$start = 0 if $$start < 0;
+ return if $$start > $#$data;
+ $$end = $#$data if $$end > $#$data;
+ return if $$end < 0;
+ $$end = $$start if $$end < $$start;
+ #TODO: compare versions
+ return 1;
+}
+
+sub _data_range {
+ my ($self, $config) = @_;
+
+ my $data = $self->data or return undef;
+
+ return [ @$data ] if $config->{all};
+
+ my $since = $config->{since} || '';
+ my $until = $config->{until} || '';
+ my $from = $config->{from} || '';
+ my $to = $config->{to} || '';
+ my $count = $config->{count} || 0;
+ my $offset = $config->{offset} || 0;
+
+ return if $offset and not $count;
+ if ($offset > 0) {
+ $offset -= ($count < 0);
+ } elsif ($offset < 0) {
+ $offset = $#$data + ($count > 0) + $offset;
+ } else {
+ $offset = $#$data if $count < 0;
+ }
+ my $start = my $end = $offset;
+ $start += $count+1 if $count < 0;
+ $end += $count-1 if $count > 0;
+
+ return unless __sanity_check_range( $data, \$from, \$to,
+ \$since, \$until,
+ \$start, \$end );
+
+
+ unless ($from or $to or $since or $until or $start or $end) {
+ return [ @$data ] if $config->{default_all} and not $count;
+ return [ $data->[0] ];
+ }
+
+ return [ @{$data}[$start .. $end] ] if $start or $end;
+
+ my @result;
+
+ my $include = 1;
+ $include = 0 if $to or $until;
+ foreach (@$data) {
+ my $v = $_->{Version};
+ $include = 1 if $v eq $to;
+ last if $v eq $since;
+
+ push @result, $_ if $include;
+
+ $include = 1 if $v eq $until;
+ last if $v eq $from;
+ }
+
+ return \@result;
+}
+
+=pod
+
+=head3 dpkg
+
+(and B<dpkg_str>)
+
+C<dpkg> returns a hash (in list context) or a hash reference
+(in scalar context) where the keys are field names and the values are
+field values. The following fields are given:
+
+=over 4
+
+=item Source
+
+package name (in the first entry)
+
+=item Version
+
+packages' version (from first entry)
+
+=item Distribution
+
+target distribution (from first entry)
+
+=item Urgency
+
+urgency (highest of all printed entries)
+
+=item Maintainer
+
+person that created the (first) entry
+
+=item Date
+
+date of the (first) entry
+
+=item Closes
+
+bugs closed by the entry/entries, sorted by bug number
+
+=item Changes
+
+content of the the entry/entries
+
+=back
+
+C<dpkg_str> returns a stringified version of this hash which should look
+exactly like the output of L<dpkg-parsechangelog(1)>. The fields are
+ordered like in the list above.
+
+Both methods only support the common output options described in
+section L<"COMMON OUTPUT OPTIONS">.
+
+=head3 dpkg_str
+
+See L<dpkg>.
+
+=cut
+
+our ( %FIELDIMPS, %URGENCIES );
+BEGIN {
+ 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));
+}
+
+sub dpkg {
+ my ($self, $config) = @_;
+
+ $self->{config}{DPKG} = $config if $config;
+
+ $config = $self->{config}{DPKG} || {};
+ my $data = $self->_data_range( $config ) or return undef;
+
+ my %f;
+ foreach my $field (qw( Urgency Source Version
+ Distribution Maintainer Date )) {
+ $f{$field} = $data->[0]{$field};
+ }
+
+ $f{Changes} = get_dpkg_changes( $data->[0] );
+ $f{Closes} = [ @{$data->[0]{Closes}} ];
+
+ my $first = 1; my $urg_comment = '';
+ foreach my $entry (@$data) {
+ $first = 0, next if $first;
+
+ 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;
+ $urg_comment .= $entry->{Urgency_Comment};
+
+ $f{Changes} .= "\n .".get_dpkg_changes( $entry );
+ push @{$f{Closes}}, @{$entry->{Closes}};
+ }
+
+ $f{Closes} = join " ", sort { $a <=> $b } @{$f{Closes}};
+ $f{Urgency} .= $urg_comment;
+
+ return %f if wantarray;
+ return \%f;
+}
+
+sub dpkg_str {
+ return data2rfc822( scalar dpkg(@_), \%FIELDIMPS );
+}
+
+=pod
+
+=head3 rfc822
+
+(and B<rfc822_str>)
+
+C<rfc822> returns an array of hashes (in list context) or a reference
+to this array (in scalar context) where each hash represents one entry
+in the changelog. For the format of such a hash see the description
+of the L<"dpkg"> method (while ignoring the remarks about which
+values are taken from the first entry).
+
+C<rfc822_str> returns a stringified version of this hash which looks
+similar to the output of dpkg-parsechangelog but instead of one
+stanza the output contains one stanza for each entry.
+
+Both methods only support the common output options described in
+section L<"COMMON OUTPUT OPTIONS">.
+
+=head3 rfc822_str
+
+See L<rfc822>.
+
+=cut
+
+sub rfc822 {
+ my ($self, $config) = @_;
+
+ $self->{config}{RFC822} = $config if $config;
+
+ $config = $self->{config}{RFC822} || {};
+ my $data = $self->_data_range( $config ) or return undef;
+ my @out_data;
+
+ foreach my $entry (@$data) {
+ my %f;
+ foreach my $field (qw( Urgency Source Version
+ Distribution Maintainer Date )) {
+ $f{$field} = $entry->{$field};
+ }
+
+ $f{Urgency} .= $entry->{Urgency_Comment};
+ $f{Changes} = get_dpkg_changes( $entry );
+ $f{Closes} = join " ", sort { $a <=> $b } @{$entry->{Closes}};
+ push @out_data, \%f;
+ }
+
+ return @out_data if wantarray;
+ return \@out_data;
+}
+
+sub rfc822_str {
+ return data2rfc822_mult( scalar rfc822(@_), \%FIELDIMPS );
+}
+
+sub __version2id {
+ my $version = shift;
+ $version =~ s/[^\w.:-]/_/go;
+ return "version$version";
+}
+
+=pod
+
+=head3 xml
+
+(and B<xml_str>)
+
+C<xml> converts the changelog to some free-form (i.e. there is neither
+a DTD or a schema for it) XML.
+
+The method C<xml_str> is an alias for C<xml>.
+
+Both methods support the common output options described in
+section L<"COMMON OUTPUT OPTIONS"> and additionally the following
+configuration options (as usual to give
+in a hash reference as parameter to the method call):
+
+=over 4
+
+=item outfile
+
+directly write the output to the file specified
+
+=back
+
+=head3 xml_str
+
+See L<xml>.
+
+=cut
+
+sub xml {
+ my ($self, $config) = @_;
+
+ $self->{config}{XML} = $config if $config;
+ $config = $self->{config}{XML} || {};
+ $config->{default_all} = 1 unless exists $config->{all};
+ my $data = $self->_data_range( $config ) or return undef;
+ my %out_data;
+ $out_data{Entry} = [];
+
+ require XML::Simple;
+ import XML::Simple qw( :strict );
+
+ foreach my $entry (@$data) {
+ my %f;
+ foreach my $field (qw( Urgency Source Version
+ Distribution Closes )) {
+ $f{$field} = $entry->{$field};
+ }
+ foreach my $field (qw( Maintainer Changes )) {
+ $f{$field} = [ $entry->{$field} ];
+ }
+
+ $f{Urgency} .= $entry->{Urgency_Comment};
+ $f{Date} = { timestamp => $entry->{Timestamp},
+ content => $entry->{Date} };
+ push @{$out_data{Entry}}, \%f;
+ }
+
+ my $xml_str;
+ my %xml_opts = ( SuppressEmpty => 1, KeyAttr => {},
+ RootName => 'Changelog' );
+ $xml_str = XMLout( \%out_data, %xml_opts );
+ if ($config->{outfile}) {
+ open my $fh, '>', $config->{outfile} or return undef;
+ flock $fh, LOCK_EX or return undef;
+
+ print $fh $xml_str;
+
+ close $fh or return undef;
+ }
+
+ return $xml_str;
+}
+
+sub xml_str {
+ return xml(@_);
+}
+
+=pod
+
+=head3 html
+
+(and B<html_str>)
+
+C<html> converts the changelog to a HTML file with some nice features
+such as a quick-link bar with direct links to every entry. The HTML
+is generated with the help of HTML::Template. If you want to change
+the output you should use the default template provided with this module
+as a base and read the documentation of HTML::Template to understand
+how to edit it.
+
+The method C<html_str> is an alias for C<html>.
+
+Both methods support the common output options described in
+section L<"COMMON OUTPUT OPTIONS"> and additionally the following
+configuration options (as usual to give
+in a hash reference as parameter to the method call):
+
+=over 4
+
+=item outfile
+
+directly write the output to the file specified
+
+=item template
+
+template file to use, defaults to
+/usr/share/libparse-debianchangelog-perl/default.tmpl.
+NOTE: The plan is to provide a configuration file for the module
+later to be able to use sane defaults here.
+
+=item style
+
+path to the CSS stylesheet to use (a default might be specified
+in the template and will be honoured, see the default template
+for an example)
+
+=item print_style
+
+path to the CSS stylesheet to use for printing (see the notes for
+C<style> about default values)
+
+=back
+
+=head3 html_str
+
+See L<html>.
+
+=cut
+
+sub html {
+ my ($self, $config) = @_;
+
+ $self->{config}{HTML} = $config if $config;
+ $config = $self->{config}{HTML} || {};
+ $config->{default_all} = 1 unless exists $config->{all};
+ my $data = $self->_data_range( $config ) or return undef;
+
+ require CGI;
+ import CGI qw( -no_xhtml -no_debug );
+ require HTML::Template;
+
+ my $template = HTML::Template->new(filename => $config->{template}
+ || '/usr/share/libparse-debianchangelog-perl/default.tmpl',
+ die_on_bad_params => 0);
+ $template->param( MODULE_NAME => ref($self),
+ MODULE_VERSION => $VERSION,
+ GENERATED_DATE => gmtime()." UTC",
+ SOURCE_NEWEST => $data->[0]{Source},
+ VERSION_NEWEST => $data->[0]{Version},
+ MAINTAINER_NEWEST => $data->[0]{Maintainer},
+ );
+
+ $template->param( CSS_FILE_SCREEN => $config->{style} )
+ if $config->{style};
+ $template->param( CSS_FILE_PRINT => $config->{print_style} )
+ if $config->{print_style};
+
+ my $cgi = new CGI;
+ $cgi->autoEscape(0);
+
+ my %navigation;
+ my $last_year;
+ foreach my $entry (@$data) {
+ my $year = $last_year; # try to deal gracefully with unparsable dates
+ if ($entry->{Timestamp}) {
+ $year = (gmtime($entry->{Timestamp}))[5] + 1900;
+ $last_year = $year;
+ }
+
+ $year ||= (($entry->{Date} =~ /\s(\d{4})\s/) ? $1 : (gmtime)[5] + 1900);
+ $navigation{$year}{NAV_VERSIONS} ||= [];
+ $navigation{$year}{NAV_YEAR} ||= $year;
+
+ $entry->{Maintainer} ||= 'unknown';
+ $entry->{Date} ||= 'unknown';
+ push @{$navigation{$year}{NAV_VERSIONS}},
+ { NAV_VERSION_ID => __version2id($entry->{Version}),
+ NAV_VERSION => $entry->{Version},
+ NAV_MAINTAINER => $entry->{Maintainer},
+ NAV_DATE => $entry->{Date} };
+ }
+ my @nav_years;
+ foreach my $y (reverse sort keys %navigation) {
+ push @nav_years, $navigation{$y};
+ }
+ $template->param( OLDFORMAT => (($self->{oldformat}||'') ne ''),
+ NAV_YEARS => \@nav_years );
+
+
+ my %years;
+ $last_year = undef;
+ foreach my $entry (@$data) {
+ my $year = $last_year; # try to deal gracefully with unparsable dates
+ if ($entry->{Timestamp}) {
+ $year = (gmtime($entry->{Timestamp}))[5] + 1900;
+ }
+ $year ||= (($entry->{Date} =~ /\s(\d{4})\s/) ? $1 : (gmtime)[5] + 1900);
+
+ if (!$last_year || ($year < $last_year)) {
+ $last_year = $year;
+ }
+
+ $years{$last_year}{CONTENT_VERSIONS} ||= [];
+ $years{$last_year}{CONTENT_YEAR} ||= $last_year;
+
+ my $text = $self->apply_filters( 'html::changes',
+ $entry->{Changes}, $cgi );
+
+ (my $maint_name = $entry->{Maintainer} ) =~ s|<([a-zA-Z0-9_\+\-\.]+\@([a-zA-Z0-9][\w\.+\-]+\.[a-zA-Z]{2,}))>||o;
+ my $maint_mail = $1;
+
+ my $parse_error;
+ $parse_error = $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};
+
+ push @{$years{$last_year}{CONTENT_VERSIONS}}, {
+ CONTENT_VERSION => $entry->{Version},
+ CONTENT_VERSION_ID => __version2id($entry->{Version}),
+ CONTENT_URGENCY => $entry->{Urgency}.$entry->{Urgency_Comment},
+ CONTENT_URGENCY_NORM => $entry->{Urgency_LC},
+ CONTENT_DISTRIBUTION => $entry->{Distribution},
+ CONTENT_DISTRIBUTION_NORM => lc($entry->{Distribution}),
+ CONTENT_SOURCE => $entry->{Source},
+ CONTENT_CHANGES => $text,
+ CONTENT_CHANGES_UNFILTERED => $entry->{Changes},
+ CONTENT_DATE => $entry->{Date},
+ CONTENT_MAINTAINER_NAME => $maint_name,
+ CONTENT_MAINTAINER_EMAIL => $maint_mail,
+ CONTENT_PARSE_ERROR => $parse_error,
+ };
+ }
+ my @content_years;
+ foreach my $y (reverse sort keys %years) {
+ push @content_years, $years{$y};
+ }
+ $template->param( OLDFORMAT_CHANGES => $self->{oldformat},
+ CONTENT_YEARS => \@content_years );
+
+ my $html_str = $template->output;
+
+ if ($config->{outfile}) {
+ open my $fh, '>', $config->{outfile} or return undef;
+ flock $fh, LOCK_EX or return undef;
+
+ print $fh $html_str;
+
+ close $fh or return undef;
+ }
+
+ return $html_str;
+}
+
+sub html_str {
+ return html(@_);
+}
+
+
+=pod
+
+=head3 init_filters
+
+not yet documented
+
+=cut
+
+sub init_filters {
+ my ($self) = @_;
+
+ require Parse::DebianChangelog::ChangesFilters;
+
+ $self->{filters} = {};
+
+ $self->{filters}{'html::changes'} =
+ [ @Parse::DebianChangelog::ChangesFilters::all_filters ];
+}
+
+=pod
+
+=head3 apply_filters
+
+not yet documented
+
+=cut
+
+sub apply_filters {
+ my ($self, $filter_class, $text, $data) = @_;
+
+ foreach my $f (@{$self->{filters}{$filter_class}}) {
+ $text = &$f( $text, $data );
+ }
+ return $text;
+}
+
+=pod
+
+=head3 add_filter, delete_filter, replace_filter
+
+not yet documented
+
+=cut
+
+sub add_filter {
+ my ($self, $filter_class, $filter, $pos) = @_;
+
+ $self->{filters}{$filter_class} ||= [];
+ unless ($pos) {
+ push @{$self->{filters}{$filter_class}}, $filter;
+ } elsif ($pos == 1) {
+ unshift @{$self->{filters}{$filter_class}}, $filter;
+ } elsif ($pos > 1) {
+ my $length = @{$self->{filters}{$filter_class}};
+ $self->{filters}{$filter_class} =
+ [ @{$self->{filters}{$filter_class}[0 .. ($pos-2)]}, $filter,
+ @{$self->{filters}{$filter_class}[($pos-1) .. ($length-1)]} ];
+ }
+
+ return $self;
+}
+
+sub delete_filter {
+ my ($self, $filter_class, $filter) = @_;
+
+ my $pos;
+ unless (ref $filter) {
+ $pos = $filter;
+
+ return delete $self->{filters}{$filter_class}[$pos];
+ }
+
+ $self->{filters}{$filter_class} ||= [];
+ my @deleted;
+ for my $i (0 .. $#{$self->{filters}{$filter_class}}) {
+ push @deleted, delete $self->{filters}{$filter_class}[$i]
+ if $self->{filters}{$filter_class}[$i] == $filter;
+ }
+
+ return @deleted;
+}
+
+sub replace_filter {
+ my ($self, $filter_class, $filter, @new_filters) = @_;
+
+ my @pos;
+ unless (ref $filter) {
+ $pos[0] = $filter;
+ } else {
+ $self->{filters}{$filter_class} ||= [];
+ for my $i (0 .. $#{$self->{filters}{$filter_class}}) {
+ push @pos, $i
+ if $self->{filters}{$filter_class}[$i] == $filter;
+ }
+ }
+
+ foreach my $p (@pos) {
+ $self->delete_filter( $filter_class, $p );
+
+ foreach my $f (@new_filters) {
+ $self->add_filter( $filter_class, $f, $p++);
+ }
+ }
+
+ return $self;
+}
+
+1;
+__END__
+
+=head1 COMMON OUTPUT OPTIONS
+
+The following options are supported by all output methods,
+all take a version number as value:
+
+=over 4
+
+=item since
+
+Causes changelog information from all versions strictly
+later than B<version> to be used.
+
+(works exactly like the C<-v> option of dpkg-parsechangelog).
+
+=item until
+
+Causes changelog information from all versions strictly
+earlier than B<version> to be used.
+
+=item from
+
+Similar to C<since> but also includes the information for the
+specified B<version> itself.
+
+=item to
+
+Similar to C<until> but also includes the information for the
+specified B<version> itself.
+
+=back
+
+The following options also supported by all output methods but
+don't take version numbers as values:
+
+=over 4
+
+=item all
+
+If set to a true value, all entries of the changelog are returned,
+this overrides all other options. While the XML and HTML formats
+default to all == true, this does of course not overwrite other
+options unless it is set explicitly with the call.
+
+=item count
+
+Expects a signed integer as value. Returns C<value> entries from the
+top of the changelog if set to a positive integer, and C<abs(value)>
+entries from the tail if set to a negative integer.
+
+=item offset
+
+Expects a signed integer as value. Changes the starting point for
+C<count>, either counted from the top (positive integer) or from
+the tail (negative integer). C<offset> has no effect if C<count>
+wasn't given as well.
+
+=back
+
+Some examples for the above options. Imagine an example changelog with
+entries for the versions 1.2, 1.3, 2.0, 2.1, 2.2, 3.0 and 3.1.
+
+ Call Included entries
+ C<E<lt>formatE<gt>({ since =E<gt> '2.0' })> 3.1, 3.0, 2.2
+ C<E<lt>formatE<gt>({ until =E<gt> '2.0' })> 1.3, 1.2
+ C<E<lt>formatE<gt>({ from =E<gt> '2.0' })> 3.1, 3.0, 2.2, 2.1, 2.0
+ C<E<lt>formatE<gt>({ to =E<gt> '2.0' })> 2.0, 1.3, 1.2
+ C<E<lt>formatE<gt>({ count =E<gt> 2 }>> 3.1, 3.0
+ C<E<lt>formatE<gt>({ count =E<gt> -2 }>> 1.3, 1.2
+ C<E<lt>formatE<gt>({ count =E<gt> 3,
+ offset=E<gt> 2 }>> 2.2, 2.1, 2.0
+ C<E<lt>formatE<gt>({ count =E<gt> 2,
+ offset=E<gt> -3 }>> 2.0, 1.3
+ C<E<lt>formatE<gt>({ count =E<gt> -2,
+ offset=E<gt> 3 }>> 3.0, 2.2
+ C<E<lt>formatE<gt>({ count =E<gt> -2,
+ offset=E<gt> -3 }>> 2.2, 2.1
+
+Any combination of one option of C<since> and C<from> and one of
+C<until> and C<to> returns the intersection of the two results
+with only one of the options specified.
+
+=head1 SEE ALSO
+
+Parse::DebianChangelog::Entry, Parse::DebianChangelog::ChangesFilters
+
+Description of the Debian changelog format in the Debian policy:
+L<http://www.debian.org/doc/debian-policy/ch-source.html#s-dpkgchangelog>.
+
+=head1 AUTHOR
+
+Frank Lichtenheld, E<lt>frank@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., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+
+=cut
--- /dev/null
+#
+# Parse::DebianChangelog::ChangesFilters
+#
+# Copyright 2005 Frank Lichtenheld <frank@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., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+#
+
+=head1 NAME
+
+Parse::DebianChangelog::ChangesFilters - filters to be applied to Debian changelog entries
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+This is currently only used internally by Parse::DebianChangelog and
+is not yet documented. There may be still API changes until this module
+is finalized.
+
+=cut
+
+package Parse::DebianChangelog::ChangesFilters;
+
+our @ISA = qw(Exporter);
+
+our %EXPORT_TAGS = ( 'all' => [ qw(
+ encode_entities
+ http_ftp_urls
+ email_to_ddpo
+ bugs_to_bts
+ cve_to_mitre
+ pseudo_markup
+ common_licenses
+) ] );
+
+our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
+
+our @all_filters = (
+ \&encode_entities,
+ \&http_ftp_urls,
+ \&email_to_ddpo,
+ \&bugs_to_bts,
+ \&cve_to_mitre,
+ \&pseudo_markup,
+ \&common_licenses,
+ );
+
+sub encode_entities {
+ require HTML::Entities;
+
+ return HTML::Entities::encode_entities( "$_[0]", '<>&"' ) || '';
+}
+
+sub http_ftp_urls {
+ my ($text, $cgi) = @_;
+
+ $text=~ s|<URL:([-\w\.\/:~_\@]+):([a-zA-Z0-9\'() ]+)>
+ |$cgi->a({ -href=>$1 }, $2)
+ |xego;
+ $text=~ s|https?:[\w/\.:\@+\-~\%\#?=&;,]+[\w/]
+ |$cgi->a({ -href=>$& }, $&)
+ |xego;
+ $text=~ s|ftp:[\w/\.:\@+\-~\%\#?=&;,]+[\w/]
+ |$cgi->a({ -href=>$& }, $&)
+ |xego;
+
+ return $text;
+}
+
+sub email_to_ddpo {
+ my ($text, $cgi) = @_;
+
+ $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;
+ return $text;
+}
+
+sub bugs_to_bts {
+ (my $text = $_[0]) =~ 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;
+ return $text;
+}
+
+sub cve_to_mitre {
+ my ($text, $cgi) = @_;
+
+ $text =~ s!\b(?:CVE|CAN)-\d{4}-\d{4}\b
+ !$cgi->a({ -href=>"http://cve.mitre.org/cgi-bin/cvename.cgi?name=$&" }, $&)
+ !xego;
+ return $text;
+}
+
+sub pseudo_markup {
+ my ($text, $cgi) = @_;
+
+ $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;
+
+ return $text;
+}
+
+sub common_licenses {
+ my ($text, $cgi) = @_;
+
+ $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;
+
+ return $text;
+}
+
+sub all_filters {
+ my ($text, $cgi) = @_;
+
+ $text = encode_entities( $text, $cgi );
+ $text = http_ftp_urls( $text, $cgi );
+ $text = email_to_ddpo( $text, $cgi );
+ $text = bugs_to_bts( $text, $cgi );
+ $text = cve_to_mitre( $text, $cgi );
+ $text = pseudo_markup( $text, $cgi );
+ $text = common_licenses( $text, $cgi );
+
+ return $text;
+}
+
+1;
+__END__
+
+=head1 SEE ALSO
+
+Parse::DebianChangelog
+
+=head1 AUTHOR
+
+Frank Lichtenheld, E<lt>frank@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., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+
+=cut
--- /dev/null
+#
+# Parse::DebianChangelog::Entry
+#
+# Copyright 2005 Frank Lichtenheld <frank@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., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+#
+
+=head1 NAME
+
+Parse::DebianChangelog::Entry - represents one entry in a Debian changelog
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head2 Methods
+
+=head3 init
+
+Creates a new object, no options.
+
+=head3 new
+
+Alias for init.
+
+=head3 is_empty
+
+Checks if the object is actually initialized with data. Due to limitations
+in Parse::DebianChangelog this currently simply checks if one of the
+fields Source, Version, Maintainer, Date, or Changes is initalized.
+
+=head2 Accessors
+
+The following fields are available via accessor functions (all
+fields are string values unless otherwise noted):
+
+=over 4
+
+=item *
+
+Source
+
+=item *
+
+Version
+
+=item *
+
+Distribution
+
+=item *
+
+Urgency
+
+=item *
+
+ExtraFields (all fields except for urgency as hash)
+
+=item *
+
+Header (the whole header in verbatim form)
+
+=item *
+
+Changes (the actual content of the bug report, in verbatim form)
+
+=item *
+
+Trailer (the whole trailer in verbatim form)
+
+=item *
+
+Closes (Array of bug numbers)
+
+=item *
+
+Maintainer (name B<and> email address)
+
+=item *
+
+Date
+
+=item *
+
+Timestamp (Date expressed in seconds since the epoche)
+
+=item *
+
+ERROR (last parse error related to this entry in the format described
+at Parse::DebianChangelog::get_parse_errors.
+
+=back
+
+=cut
+
+package Parse::DebianChangelog::Entry;
+
+use strict;
+use warnings;
+
+use base qw( Class::Accessor );
+use Parse::DebianChangelog::Util qw( :all );
+
+Parse::DebianChangelog::Entry->mk_accessors(qw( Closes Changes Maintainer
+ MaintainerEmail Date
+ Urgency Distribution
+ Source Version ERROR
+ ExtraFields Header
+ Trailer Timestamp ));
+
+sub new {
+ return init(@_);
+}
+
+sub init {
+ my $classname = shift;
+ my $self = {};
+ bless( $self, $classname );
+
+ return $self;
+}
+
+sub is_empty {
+ my ($self) = @_;
+
+ return !($self->{Changes}
+ || $self->{Source}
+ || $self->{Version}
+ || $self->{Maintainer}
+ || $self->{Date});
+}
+
+1;
+__END__
+
+=head1 SEE ALSO
+
+Parse::DebianChangelog
+
+=head1 AUTHOR
+
+Frank Lichtenheld, E<lt>frank@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., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+
+=cut
--- /dev/null
+#
+# Parse::DebianChangelog::Util
+#
+# Copyright 1996 Ian Jackson
+# Copyright 2005 Frank Lichtenheld <frank@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., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+#
+
+=head1 NAME
+
+Parse::DebianChangelog::Util - utility functions for parsing Debian changelogs
+
+=head1 DESCRIPTION
+
+This is currently only used internally by Parse::DebianChangelog.
+There may be still API changes until this module is finalized.
+
+=head2 Functions
+
+=cut
+
+package Parse::DebianChangelog::Util;
+
+use strict;
+use warnings;
+
+require Exporter;
+
+our @ISA = qw(Exporter);
+
+our %EXPORT_TAGS = ( 'all' => [ qw(
+ find_closes
+ data2rfc822
+ data2rfc822_mult
+ get_dpkg_changes
+) ] );
+
+our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
+
+our @EXPORT = qw(
+);
+
+=pod
+
+=head3 find_closes
+
+Takes one string as argument and finds "Closes: #123456, #654321" statements
+as supported by the Debian Archive software in it. Returns all closed bug
+numbers in an array reference.
+
+=cut
+
+sub find_closes {
+ my $changes = shift;
+ my @closes = ();
+
+ while ($changes && ($changes =~ /closes:\s*(?:bug)?\#?\s?\d+(?:,\s*(?:bug)?\#?\s?\d+)*/ig)) {
+ push(@closes, $& =~ /\#?\s?(\d+)/g);
+ }
+
+ @closes = sort { $a <=> $b } @closes;
+ return \@closes;
+}
+
+=pod
+
+=head3 data2rfc822
+
+Takes two hash references as arguments. The first should contain the
+data to output in RFC822 format. The second can contain a sorting order
+for the fields. The higher the numerical value of the hash value, the
+earlier the field is printed if it exists.
+
+Return the data in RFC822 format as string.
+
+=cut
+
+sub data2rfc822 {
+ my ($data, $fieldimps) = @_;
+ my $rfc822_str = '';
+
+# based on /usr/lib/dpkg/controllib.pl
+ for my $f (sort { $fieldimps->{$b} <=> $fieldimps->{$a} } keys %$data) {
+ my $v= $data->{$f} or next;
+ $v =~ m/\S/o || next; # delete whitespace-only fields
+ $v =~ m/\n\S/o && warn("field $f has newline then non whitespace >$v<");
+ $v =~ m/\n[ \t]*\n/o && warn("field $f has blank lines >$v<");
+ $v =~ m/\n$/o && warn("field $f has trailing newline >$v<");
+ $v =~ s/\$\{\}/\$/go;
+ $rfc822_str .= "$f: $v\n";
+ }
+
+ return $rfc822_str;
+}
+
+=pod
+
+=head3 data2rfc822_mult
+
+The first argument should be an array ref to an array of hash references.
+The second argument is a hash reference and has the same meaning as
+the second argument of L<data2rfc822>.
+
+Calls L<data2rfc822> for each element of the array given as first
+argument and returns the concatenated results.
+
+=cut
+
+sub data2rfc822_mult {
+ my ($data, $fieldimps) = @_;
+ my @rfc822 = ();
+
+ foreach my $entry (@$data) {
+ push @rfc822, data2rfc822($entry,$fieldimps);
+ }
+
+ return join "\n", @rfc822;
+}
+
+=pod
+
+=head3 get_dpkg_changes
+
+Takes a Parse::DebianChangelog::Entry object as first argument.
+
+Returns a string that is suitable for using it in a C<Changes> field
+in the output format of C<dpkg-parsechangelog>.
+
+=cut
+
+sub get_dpkg_changes {
+ my $changes = "\n ".$_[0]->Header."\n .\n".$_[0]->Changes;
+ chomp $changes;
+ $changes =~ s/^ $/ ./mgo;
+ return $changes;
+}
+
+1;
+__END__
+
+=head1 SEE ALSO
+
+Parse::DebianChangelog, Parse::DebianChangelog::Entry
+
+=head1 AUTHOR
+
+Frank Lichtenheld, E<lt>frank@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., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
+
+=cut
--- /dev/null
+
+.hide {
+ display: none;
+}
+
+ul.navbar {
+ display: none;
+}
+ul.outline {
+ display: none;
+}
+
+.document_header {
+ font-size: xx-large;
+}
+
+.year_header {
+ font-size: x-large;
+}
+
+.entry_header {
+ font-size: medium;
+}
+
+.packagelink {
+ text-decoration: none;
+}
+
+.medium {
+ color: orange;
+}
+.high,
+.critical,
+.emergency {
+ color: red;
+}
+
+.testing,
+.stable,
+.testing-proposed-updates,
+.stable-proposed-updates,
+.frozen {
+ color: orange;
+}
+.stable-security,
+.testing-security,
+.experimental {
+ color: red;
+}
+
+.trailer a {
+ text-decoration: none;
+}
--- /dev/null
+
+.hide {
+ display: none;
+}
+
+ul.navbar {
+ display: inline;
+ list-style-type: none;
+ padding: 0;
+}
+ul.navbar li {
+ display: inline;
+ list-style-type: none;
+}
+ul.navbar li a:before {
+ content: '[';
+}
+ul.navbar li a:after {
+ content: ']';
+}
+
+ul.outline {
+ position: absolute;
+ top: .1em;
+ right: .1em;
+ padding: .5em;
+ list-style-type: none;
+ border: thin solid black;
+ background: #ddd;
+ overflow: auto;
+ max-width: 30%;
+}
+ul.outline ul {
+ list-style-type: none;
+}
+
+.document_header {
+ font-size: xx-large;
+}
+
+.year_header {
+ font-size: x-large;
+}
+
+.entry_header {
+ font-size: medium;
+}
+
+.packagelink {
+ text-decoration: none;
+}
+
+.medium {
+ color: orange;
+}
+.high,
+.critical,
+.emergency {
+ color: red;
+}
+
+.testing,
+.stable,
+.testing-proposed-updates,
+.stable-proposed-updates,
+.frozen {
+ color: orange;
+}
+.stable-security,
+.testing-security,
+.experimental {
+ color: red;
+}
+
+.trailer a {
+ text-decoration: none;
+}
+
+.parse_error {
+ font-style: italic;
+ font-size: small;
+ margin-top: -1em;
+}
+
+.footer address {
+ padding: .5em;
+ border-top: thin solid black;
+ background-color: #ddd;
+}
--- /dev/null
+/* css file for debian web site - Jutta Wrage 2004 */
+
+/* all pages have a header, outer inner and footer
+leftcol and maincol can be omitted, there will be other boxes
+to replace later (eg. two content columns)
+normal page:
+<div id="header">
+ <div id="upperheader">
+ <div id="logo">
+ </div> <!-- end logo -->
+ <div id="serverselect">
+ </div> <!-- end serverselect -->
+ </div> <!-- end upperheader -->
+ <div id="navbar">
+ </div> <!-- end navbar -->
+</div> <!-- end header -->
+<div id="outer">
+ <div id="inner">
+ <div id="leftcol">
+ Leftcol is for menus - if omitted, maincol can be omitted, too
+ </div> <!-- end leftcol -->
+ <div id="maincol">
+ Maincol with margin left is for the content
+ But content may go directly to inner
+ </div> <!-- end maincol -->
+ </div> <!-- end inner -->
+ <div id="footer">
+ <hr class="hidecss"> This line is a divider for lynx
+ </div> <!-- end footer -->
+</div> <!-- end outer -->
+color logo #C60036
+cd-pages: bgcolor="#e09e86" - navbar
+*/
+
+/* { border: 1px solid yellow; } */
+html, body {
+ color: #000000;
+ background-color: #FFFFFF;
+ margin: 0 4px 0 4px;
+ padding: 0;
+ text-align: left;
+ /* min-width: 440px - commented out due to mozilla problems*/
+}
+/* direction directive reverses the navbar, too */
+/* html[lang|=ar] {
+ direction: rtl !important;
+ text-align: right !important;
+} */
+
+img { border: 0; }
+
+h1 { text-align: center; }
+
+acronym {
+ border-bottom: 1px dotted #000000;
+}
+
+hr.hidecss {
+ border: 0;
+}
+
+hr {
+ border-bottom: 0;
+ border-top: 1px solid #BFC3DC;
+}
+
+samp {
+ display: block;
+ margin-left: 2em;
+}
+div.sampleblock {
+ width: 80%;
+ margin: auto;
+ font-family:courier, serif;
+ font-size: 90%;
+}
+div.quoteblock {
+ width: 75%;
+ margin: auto;
+ font-size: 90%;
+ text-align: justify;
+}
+
+.quoteblock div.preimg {
+ float: left;
+ margin-top: 0.2em;
+}
+.quoteblock cite {
+ display: block;
+ text-align: right;
+}
+blockquote.question {
+ font-style: italic;
+}
+blockquote.question p span {
+ font-style: normal;
+ width: 10%;
+}
+#pagewidth {
+ width: 100%;
+ text-align: left;
+}
+
+/* now the header*/
+#header {
+ margin-left: -3px;
+ width: 100%;
+ height: auto;
+}
+
+/* upper nested header box*/
+#upperheader {
+ width: 100%;
+ margin-top: 11px;
+ height: auto;
+ /* height: 4.8em; */
+ background: #FFFFFF;
+}
+
+#logo {
+ float: left;
+ margin-left: 6px;
+ background: #FFFFFF;
+}
+
+#serverselect {
+ float: right;
+ display: block;
+ padding-top: 1px;
+ margin-right: 6px;
+ margin-left: auto;
+ text-align: right;
+ top: 0;
+ right: 0;
+}
+
+#serverselect:lang(de) {
+ width: 15em;
+}
+#serverselect:lang(en) {
+ width: 13em;
+}
+
+#serverselect p {
+ color: #990000;
+ font-size: 0.8em;
+ font-weight: normal;
+}
+
+#serverselect p select {
+ font-size: 88%;
+}
+
+#serverselect p input {
+ font-size: 88%;
+}
+.centerlogo {
+ margin-left: 260px;
+ margin-right: auto;
+ width: 125px;
+ text-align: center;
+ vertical-align: bottom;
+}
+#cdlogo {
+}
+
+#hpacketsearch {
+ display: block;
+ padding-top: 1px;
+ padding-left: 5px;
+ margin-right: 0.2em;
+ margin-left: auto;
+ text-align: left;
+ width: 25em;
+ top: 0em;
+ right: 0em;
+}
+
+#hpacketsearch p small {
+ color: #990000;
+ font-size: 0.8em;
+ font-weight: normal;
+}
+
+#hpacketsearch p select {
+ font-size: 88%;
+}
+
+#hpacketsearch p input {
+ font-size: 88%;
+}
+
+#navbar {
+ /* margin-top: 1em; */
+ clear: both;
+ padding-left: 0px;
+ /* margin-top: 5px; */
+ padding-top: 6px;
+ padding-bottom: 4px;
+ width: 100%;
+ height: auto;
+ text-align: center;
+ background: #DF0451;
+}
+#navbar ul {
+ display: inline;
+ list-style-type: none;
+ padding-left: 0px;
+ line-height: 1.5em;
+}
+#navbar ul li {
+ display: inline;
+ margin: 0;
+ white-space: nowrap;
+}
+#navbar a {
+ color: #FFFFFF;
+ text-decoration: none;
+ padding: 0.2em 0.4em 0.2em 0.4em;
+ background-color: #000084;
+ border: 1px solid #000084;
+ font-family: Arial, Helvetica, sans-serif;
+ font-weight: bold;
+ font-size: 0.9em;
+}
+#navbar a:hover {
+ background: #0000CC;
+}
+#navbar .hidecss, .hidecss {
+ display: none;
+}
+
+/* the rest of page out of two nested boxes around */
+
+#outer {
+ background-color: #FFFFFF;
+ width: auto;
+ /* border:solid white 2px; */
+}
+
+#inner {
+ margin: -2px;
+ margin-top: 0;
+ width: 100%;
+ background: #FFFFFF;
+ /* overflow: auto; */
+}
+
+#leftcol {
+ float: left;
+ margin: 0em 0.4em 0 0;
+ padding-left: 0;
+ padding-bottom: 1em;
+ width: auto;
+ background: #BBDDFF;
+ font-size: 0.9em;
+ font-family: Arial, Helvetica, sans-serif;
+ border: 1px solid #BBDDFF;
+ /* overflow: auto; */
+}
+#leftcol a:link, #leftcol a:visited {
+ display: block;
+}
+#leftcol a:hover {
+ background-color: #DDEEFF;
+ /* background-color: #FFFFFF; */
+}
+#leftcol ul {
+ margin: 2px;
+ padding: 0;
+ list-style-type: none;
+ font-weight: bold;
+}
+#leftcol ul.votemenu {
+ width: 11em;
+}
+#leftcol ul.cdmenu {
+ width: 12em;
+}
+#leftcol ul.votemenu ul li, #leftcol ul.cdmenu ul li {
+ padding-bottom: 0.4em;
+}
+#leftcol li ul {
+ display: inline;
+}
+#leftcol ul li {
+ padding: 0.2em 0;
+}
+#leftcol ul ul {
+ font-size: 0.9em;
+ margin: 0;
+}
+#leftcol ul li a {
+ line-height: 1.2em;
+ padding-right: 0.5em;
+ /* padding: 0.2em 0 0.3em 0em; */
+}
+#leftcol ul ul li a {
+ font-weight: normal;
+ padding: 0.1em 0.5em;
+ line-height: 1.1em;
+}
+#leftcol ul ul li {
+ padding-top: 0;
+}
+#leftcol p {
+ margin-left: 2px;
+ margin-right: 2px;
+}
+#leftcol p a {
+ display: block;
+ margin: 0;
+}
+#leftcol p img {
+ margin-left: 1em;
+}
+
+#maincol {
+ background: #FFFFFF;
+ margin-left: 12em;
+ margin-right: 0.5em;
+ margin-bottom: 1em;
+}
+
+#maincol:lang(en), #maincol:lang(cz), #maincol:lang(ko),
+ #maincol:lang(no), #maincol:lang(sk), #maincol:lang(tr),
+ #maincol:lang(zh-CN), #maincol:lang(zh-HK), #maincol:lang(zh-TW) {
+ margin-left: 10em;
+}
+
+#lefthalfcol {
+ float: left;
+ margin-left: 0em;
+ width: 49%;
+}
+
+#lefthalfcol dl {
+ margin-top: 0em;
+}
+
+#righthalfcol {
+ margin-left: 50%;
+ width: 50%;
+}
+
+#righthalfcol dl {
+ margin-right: 0.2em;
+}
+
+#footer {
+ clear: both;
+ width: 100%;
+ padding-top: 3px;
+ bottom: 0;
+ text-align: center;
+ margin: 0px;
+}
+
+#fineprint {
+ margin-top: 0.2em;
+ padding-top: 3px;
+ text-align: center;
+ font-size: 0.85em;
+}
+
+#outer>#inner { border-bottom: 1px solid #BFC3DC; }
+.bordertop { border-top: 1px solid #BFC3DC; }
+
+dl.gloss dt {
+ font-weight: bold;
+}
+
+#footer ul {
+ display: inline;
+ list-style-type: none;
+}
+
+#footer ul li {
+ display: inline;
+}
+
+#footer ul li a, table.y2k td {
+ white-space: nowrap;
+}
+
+#footer p {
+ margin: 0px;
+}
+
+#main {
+ background: #bbddff;
+ padding: 1em 0; /* have some padding to get rid of collapsed margins */
+}
+
+/* classes for cards */
+
+.cardleft {
+ margin: 0 0 1em;
+ float: left;
+ width: 49%;
+}
+.cardright {
+ margin-left: 50%
+ /*margin: 0 1% 2em 50%; */
+}
+.card {
+ clear: left;
+ margin: 0 0 1em;
+}
+
+.cardleft h2, .cardright h2, .card h2 {
+ font-size: 120%;
+ background: #000000;
+ color: #FFD400;
+ display: inline;
+ padding: 0.2em 0.4em;
+ margin: 0 10px;
+ font-family: Arial, Helvetica, sans-serif;
+ letter-spacing: 0.2em;
+}
+
+.cardleft dl dd, .cardright dl dd , .card dl dd {
+ padding-bottom: 0.5em;
+}
+
+.cardleft div, .cardright div, .card div {
+ border: 2px solid #000000;
+ background: #FFFFFF;
+ padding: 0.5em;
+ margin: 2px 10px;
+ /* the next two lines xpand the div to heigth of left inner div */
+ overflow: auto;
+}
+
+div.lefthalf {
+ float: left;
+ width: 49%;
+ border: 0;
+ margin: 0;
+ padding: 0;
+}
+
+div.righthalf {
+ border: 0;
+ margin: 0;
+ padding: 0;
+}
+/* classes and div names for package pages */
+
+#pdesc, #pdeps, #pdownload, #pmoreinfo {
+ margin-left: 1em;
+ margin-right: 1em;
+}
+
+#pdesc p {
+ text-align: justify;
+}
+
+.pdescshort {
+ text-align: left;
+ font-size: large;
+ font-weight: bold;
+}
+
+#pdeps table tr td {
+ font-size: 0.9em;
+}
+
+#pdeps ul {
+ list-style-type: none;
+ padding-left: 2em;
+}
+
+#pdeps li {
+ text-indent: -2em;
+}
+
+#pdeps ul.uldep, #pdeps ul.uladep {
+ list-style-type: disc;
+ list-style-image: url(http://packages.debian.org/Pics/dep.gif);
+}
+
+#pdeps ul.ulrec, #pdeps ul.ulidep {
+ list-style-type: disc;
+ list-style-image: url(http://packages.debian.org/Pics/rec.gif);
+}
+
+#pdeps ul.ulsug {
+ list-style-type: disc;
+ list-style-image: url(http://packages.debian.org/Pics/sug.gif);
+}
+
+#pdeps ul.uldep li, #pdeps ul.ulrec li, #pdeps ul.ulsug li, #pdeps ul.uladep li, #pdeps ul.ulidep li {
+ padding-left: 2em;
+}
+#pdeps dl {
+ margin: 0;
+}
+
+#pdownload p, #pdownload form, #pdownload submit {
+ display: inline;
+}
+
+#pdownload td {
+ font-size: 0.85em;
+ text-align: center;
+}
+
+#pmoreinfo p {
+ font-size: 0.85em;
+}
+
+/* colors for packages, warnings and news in ports */
+.pred, .warning, dt.new, .no {
+ color: red; /* FF0000 */
+}
+
+.psmallcenter, .psmalltrademark {
+ clear: both;
+ font-size: 0.85em;
+ text-align: center;
+}
+
+.psmalltrademark {
+ color: green;
+}
+#pdownload table, table.ridgetable, table.reltable {
+ border-width: 4px;
+ border-color: gray;
+ margin: 0 1em 1em 1em;
+ border-style: ridge;
+ border-collapse: collapse;
+}
+table.vote {
+ margin: 0 auto;
+ border-width: 3px;
+ border-color: gray;
+ border-style: ridge;
+ border-collapse: collapse;
+}
+#pdownload th, #pdownload td, table.ridgetable th, table.ridgetable td,
+ table.reltable td, table.reltable th {
+ border: 2px gray;
+ border-style: ridge;
+ padding: 0.1em;
+}
+table.reltable th {
+ background-color: #44CCCC;
+}
+table.vote th {
+ border: 1px solid gray;
+ background-color: #DDDDDD;
+}
+table.vote td {
+ border: 1px solid gray;
+ padding: 4px;
+}
+table.reltable tr.odd {
+ background-color: #FFFFFF;
+}
+table.reltable tr.even {
+ background-color: #DDDDDD;
+}
+table.stattrans {
+ margin: 0 auto;
+ width: 95%;
+ border: 1px solid black;
+ background-color: #cdc9c9;
+}
+table.stattrans th {
+ text-align: center;
+ padding: 2px;
+}
+table.stattrans td {
+ text-align: right;
+ padding: 2px;
+}
+table.stattrans tbody th {
+ text-align: left;
+ font-weight: normal;
+}
+
+/* partners */
+.partnertype {
+ background-color: #DD0000;
+ padding: 0.2em 0 0.2em 1em;
+ color: #FFFFFF;
+
+}
+div.partnerlogo {
+ display: table-cell;
+ vertical-align: middle;
+ text-align: center;
+ width: 30%;
+}
+div.partnerdesc {
+ display: table-cell;
+ font-size: 85%;
+}
+div.cdflash {
+ background-color: #E09E86;
+ width: 80%;
+ margin: auto;
+ text-align: center;
+}
+.cdrsync {
+ color: #6B1300;
+}
+/* debian installer */
+
+.dierror {
+ background-color: #FF6060;
+}
+.dibad {
+ background-color: #F7FF60;
+}
+.digood {
+ background-color: #7AFF71;
+}
+
+/* useful classes */
+
+th.eventheader {
+ background-color: #BBDDFF;
+}
+.center {
+ text-align: center;
+}
+.right {
+ text-align: right;
+}
+ul.circlelist {
+ list-style-type: circle;
+}
+.centerdiv table {
+ margin-left: auto;
+ margin-right: auto;
+}
+ul.discless {
+ list-style-type: none;
+}
+.top, img.ico {
+ vertical-align: top;
+}
+img.ico {
+ float: left;
+ margin: 0 0.2em 0 0;
+}
+img.rightico {
+ float: right;
+ vertical-align: top;
+ margin: 0 0 0 0.2em;
+}
+img.cve {
+ vertical-align: -25px;
+}
+.y2kok, .yes {
+ color: #00BB00;
+}
+.y2kok2 {
+ color: #00BBBB;
+}
+.bluehead {
+ color: #0000FF !important;
+}
+span.halfsize {
+ font-size: 80%;
+}
+span.ddpbooktitle, span.merchtitle {
+ font-size: larger;
+}
+a:link { color: #0000FF; }
+a:visited { color: #800080; }
+a:hover { color: #F000FF; }
+a:active { color: #FF0000; }
+
+.navpara a, col.y2k {
+ white-space: nowrap;
+ /* this is to keep from breaking at whitespace in anchors */
+}
+
+/* language dependent stuff */
+/* quotes */
+html[lang="de"] q:before {
+ content: "\00BB";
+}
+html[lang="de"] q:after {
+ content: "\00AB";
+}
+html[lang="de"] q q:before {
+ content: "\203A";
+}
+html[lang="de"] q q:after {
+ content: "\2039";
+}
+html[lang="pl"] q:before { content: "\201E"; }
+html[lang="pl"] q:after { content: "\201D"; }
+html[lang="pl"] q q:after { content: "\2019"; }
+html[lang="pl"] q q:before { content: "\201A"; }
+
+html[lang="fr"] q:before { content: "\00AB\00A0"; }
+html[lang="fr"] q:after { content: "\00A0\00BB"; }
+html[lang="fr"] q q:before { content: "\2039\00A0"; }
+html[lang="fr"] q q:after { content: "\00A0\203A"; }
+
+#leftcol:lang(ja) ul ul {
+ font-size: 0.95em;
+}
+html[lang|="zh"] strong {
+ /* color: #FFFFFF; */
+ background-color: yellow;
+}
+.underline { text-decoration: underline; }
+.clr { clear:both; }
+/*.content{padding:5px;} */ /*padding for content */
+/* #header .content{padding-bottom:0;} */ /*padding bottom 0 to remove space in IE5 Mac*/
+
+/* for l10n-arabic */
+.bidi {
+ direction: rtl;
+ text-align: right;
+}
+
+#leftcol, #navbar, #navbar a {
+ -moz-border-radius: 15px;
+ /* this goes to the end as the css validator does not like it
+ will be replaced by border-radius with css3 */
+}
projects / deb / packages.git / commitdiff
