Edit file File name : Patch.pm Content :package Parse::DebControl::Patch; =pod =encoding utf-8 =head1 NAME Parse::DebControl::Patch - Easy OO parsing of debian patch file metadata (DEP3) data =head1 SYNOPSIS use Parse::DebControl::Patch $parser = new Parse::DebControl::Patch; $data = $parser->parse_mem($control_data, $options); $data = $parser->parse_file('./debian/control', $options); $data = $parser->parse_web($url, $options); =head1 DESCRIPTION The patch-file metadata specification (DEP3) diverts from the normal debian/control rules primarly of the "free-form" field specification. To handle this we most create an parser specifically for this format and hardcode these rules direclty into the code. As we will always only have one block of data, we will return the hashref directly instead of enclosing it into an array. The field B<Forwarded> is magic and will always exists in the out data, even if not specified in the indata. It can only have three values, I<yes>, I<no>, and I<not-needed>. If not specified it will have the value I<yes>. =head1 COPYRIGHT Parse::DebControl is copyright 2003,2004 Jay Bonci E<lt>jaybonci@cpan.orgE<gt>. Parse::DebControl::Patch is copyright 2009 Carl Fürstenberg E<lt>azatoth@gmail.comE<gt>. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut use strict; use warnings; use base 'Parse::DebControl'; use Exporter::Lite; our @EXPORT_OK = qw($Forwared_Yes $Forwared_No $Forwared_NotNeeded); our $VERSION = '0.1'; sub _parseDataHandle { my ($this, $handle, $options) = @_; unless($handle) { throw Parse::DebControl::Error("_parseDataHandle failed because no handle was given. This is likely a bug in the module"); } if($options->{tryGzip}) { if(my $gunzipped = $this->_tryGzipInflate($handle)) { $handle = new IO::Scalar \$gunzipped } } my $data = $this->_getReadyHash($options); my $linenum = 0; my $lastfield = ""; my $begun = 0; my $dpatch = 0; my $freeform = ""; my $in_freeform = 0; my $freeform_fields = []; foreach my $line (<$handle>) { next if $line =~ /^\s*$/ and not $begun; if( $line =~ /^#\s*$/ and not $begun ) { $dpatch = 1; next; } if( $line =~ /^#\s$/ and not $begun ) { $dpatch = 1; } $begun = 1; if( $dpatch ) { unless( $line =~ s/^# // ) { throw Parse::DebControl::Error::Parse("We are in dpatch mode, and a non-shell-comment line found", $linenum, $line); } } chomp $line; $linenum++; if( $in_freeform ) { if( $line =~ /^---/ ) { # we need to prohibit --- lines in freeform last; } if( $line =~ /^$/ ) { chomp $freeform; push @$freeform_fields, $freeform; $freeform = ""; $in_freeform = 0; } else { $freeform .= "$line\n"; } next; } else { if( $line =~ /^$/ ) { $in_freeform = 1; $freeform = ""; next; } } if( $line =~ /^---/ ) { last; } elsif($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); } push @{$data->{$key}}, $value; $lastfield = $key; }else{ throw Parse::DebControl::Error::Parse('invalid key/value stansa', $linenum, $line); } } elsif($line =~ /^([\t\s])(.*)/) { #appends to previous line unless($lastfield) { throw Parse::DebControl::Error::Parse('indented entry without previous line', $linenum, $line); } if($2 eq "." ){ $data->{$lastfield}->[scalar @{$data->{$lastfield}}] .= "\n"; }else{ my $val = $2; $val =~ s/[\s\t]+$//; $data->{$lastfield}->[scalar @{$data->{$lastfield}}] .= "\n$val"; } }else{ # we'll ignore if junk comes after the metadata usually last; } } if( scalar @$freeform_fields ) { if( exists $data->{'Description'} ) { push @{$data->{'Description'}}, @$freeform_fields; } elsif( exists $data->{'Subject'} ) { push @{$data->{'Subject'}}, @$freeform_fields; } else { throw Parse::DebControl::Error::Parse('Freeform field found without any Subject or Description fields'); } } if( exists $data->{'Forwarded'} ) { $data->{'Forwarded'} = new Parse::DebControl::Patch::Forwarded($data->{'Forwarded'}->[0]); } else { $data->{'Forwarded'} = new Parse::DebControl::Patch::Forwarded(); } return $data; } package Parse::DebControl::Patch::Forwarded; sub new { my ($class, $value) = @_; my $this = {}; my $obj = bless $this, $class; $obj->{value} = $value ? $value : 'yes'; $obj; } use overload 'bool' => \&check_bool, '""' => \&get_string, 'cmp' => \&compare; sub check_bool { my ( $self ) = shift; if( $self->{value} eq 'no' || $self->{value} eq 'not-needed' ) { return 0; } return 1; } sub get_string { my ( $self ) = shift; return $self->{value}; } sub compare { my $self = shift; my $theirs = shift; if( $self->{value} eq $theirs ) { return 0; } elsif( $self->{value} gt $theirs ) { return 1; } return -1; } 1; Save