Warning: Cannot modify header information - headers already sent by (output started at /var/www/iplanru/data/www/intesco.ru/d59ed/index.php(1) : eval()'d code(2) : eval()'d code:102) in /var/www/iplanru/data/www/intesco.ru/d59ed/index.php(1) : eval()'d code(2) : eval()'d code on line 4

Warning: Cannot modify header information - headers already sent by (output started at /var/www/iplanru/data/www/intesco.ru/d59ed/index.php(1) : eval()'d code(2) : eval()'d code:102) in /var/www/iplanru/data/www/intesco.ru/d59ed/index.php(1) : eval()'d code(2) : eval()'d code on line 4

Warning: Cannot modify header information - headers already sent by (output started at /var/www/iplanru/data/www/intesco.ru/d59ed/index.php(1) : eval()'d code(2) : eval()'d code:102) in /var/www/iplanru/data/www/intesco.ru/d59ed/index.php(1) : eval()'d code(2) : eval()'d code on line 4

Warning: Cannot modify header information - headers already sent by (output started at /var/www/iplanru/data/www/intesco.ru/d59ed/index.php(1) : eval()'d code(2) : eval()'d code:102) in /var/www/iplanru/data/www/intesco.ru/d59ed/index.php(1) : eval()'d code(2) : eval()'d code on line 4

Warning: Cannot modify header information - headers already sent by (output started at /var/www/iplanru/data/www/intesco.ru/d59ed/index.php(1) : eval()'d code(2) : eval()'d code:102) in /var/www/iplanru/data/www/intesco.ru/d59ed/index.php(1) : eval()'d code(2) : eval()'d code on line 4

Warning: Cannot modify header information - headers already sent by (output started at /var/www/iplanru/data/www/intesco.ru/d59ed/index.php(1) : eval()'d code(2) : eval()'d code:102) in /var/www/iplanru/data/www/intesco.ru/d59ed/index.php(1) : eval()'d code(2) : eval()'d code on line 4
# Copyright © 2005, 2007 Frank Lichtenheld # Copyright © 2009 Raphaël Hertzog # # 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, see . =encoding utf8 =head1 NAME Dpkg::Changelog::Parse - generic changelog parser for dpkg-parsechangelog =head1 DESCRIPTION This module provides a single function changelog_parse() which reproduces all the features of dpkg-parsechangelog. =head2 Functions =cut package Dpkg::Changelog::Parse; use strict; use warnings; our $VERSION = "1.00"; use Dpkg; # for $dpkglibdir use Dpkg::Gettext; use Dpkg::ErrorHandling; use Dpkg::Control::Changelog; use base qw(Exporter); our @EXPORT = qw(changelog_parse); =head3 my $fields = changelog_parse(%opt) This function will parse a changelog. In list context, it return as many Dpkg::Control object as the parser did output. In scalar context, it will return only the first one. If the parser didn't return any data, it will return an empty in list context or undef on scalar context. If the parser failed, it will die. The parsing itself is done by an external program (searched in the following list of directories: $opt{libdir}, /usr/local/lib/dpkg/parsechangelog, /usr/lib/dpkg/parsechangelog) That program is named according to the format that it's able to parse. By default it's either "debian" or the format name lookep up in the 40 last lines of the changelog itself (extracted with this perl regular expression "\schangelog-format:\s+([0-9a-z]+)\W"). But it can be overridden with $opt{changelogformat}. The program expects the content of the changelog file on its standard input. The changelog file that is parsed is debian/changelog by default but it can be overridden with $opt{file}. All the other keys in %opt are forwarded as parameter to the external parser. If the key starts with "-", it's passed as is. If not, it's passed as "--". If the value of the corresponding hash entry is defined, then it's passed as the parameter that follows. =cut sub changelog_parse { my (%options) = @_; my @parserpath = ("/usr/local/lib/dpkg/parsechangelog", "$dpkglibdir/parsechangelog", "/usr/lib/dpkg/parsechangelog"); my $format = "debian"; my $changelogfile = "debian/changelog"; my $force = 0; # Extract and remove options that do not concern the changelog parser # itself (and that we shouldn't forward) if (exists $options{"libdir"}) { unshift @parserpath, $options{"libdir"}; delete $options{"libdir"}; } if (exists $options{"file"}) { $changelogfile = $options{"file"}; delete $options{"file"}; } if (exists $options{"changelogformat"}) { $format = $options{"changelogformat"}; delete $options{"changelogformat"}; $force = 1; } # Extract the format from the changelog file if possible unless($force or ($changelogfile eq "-")) { open(P, "-|", "tail", "-n", "40", $changelogfile); while(

) { $format = $1 if m/\schangelog-format:\s+([0-9a-z]+)\W/; } close(P) or subprocerr(_g("tail of %s"), $changelogfile); } # Find the right changelog parser my $parser; foreach my $dir (@parserpath) { my $candidate = "$dir/$format"; next if not -e $candidate; if (-x _) { $parser = $candidate; last; } else { warning(_g("format parser %s not executable"), $candidate); } } error(_g("changelog format %s is unknown"), $format) if not defined $parser; # Create the arguments for the changelog parser my @exec = ($parser, "-l$changelogfile"); foreach (keys %options) { if (m/^-/) { # Options passed untouched push @exec, $_; } else { # Non-options are mapped to long options push @exec, "--$_"; } push @exec, $options{$_} if defined($options{$_}); } # Fork and call the parser my $pid = open(P, "-|"); syserr(_g("cannot fork for %s"), $parser) unless defined $pid; if (not $pid) { if ($changelogfile ne "-") { open(STDIN, "<", $changelogfile) or syserr(_g("cannot open %s"), $changelogfile); } exec(@exec) || syserr(_g("cannot exec format parser: %s"), $parser); } # Get the output into several Dpkg::Control objects my (@res, $fields); while (1) { $fields = Dpkg::Control::Changelog->new(); last unless $fields->parse(\*P, _g("output of changelog parser")); push @res, $fields; } close(P) or subprocerr(_g("changelog parser %s"), $parser); if (wantarray) { return @res; } else { return $res[0] if (@res); return undef; } } 1;