libparse-debcontrol-perl 2.005-4 / usr / share / perl5 / Parse / DebControl / Patch.pm

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;