Alien-wxWidgets

 view release on metacpan or  search on metacpan

inc/bin/patch  view on Meta::CPAN

tie *PATCH, Pushback => $patchfile or die "Can't open '$patchfile': $!";

# Extract patches from patchfile.  We unread/pushback lines by printing to
# the PATCH filehandle:  'print PATCH'
PATCH:
while (<PATCH>) {
    if (/^(\s*)(\@\@ -(\d+)(?:,(\d+))? \+(\d+)(?:,(\d+))? \@\@\n)/) {
        # UNIFIED DIFF
        my ($space, $range, $i_start, $i_lines, $o_start, $o_lines) =
           ($1,     $2,     $3,       $4 || 1,  $5,       $6 || 1);
        $patch->bless('unified') or next PATCH;
        my @hunk;
        my %saw = map {$_, 0} split //, ' +-';
        my $re = qr/^$space([ +-])/;
        while (<PATCH>) {
            unless (s/$re/$1/) {
                $patch->note("Short hunk ignored.\n");
                $patch->reject($range, @hunk);
                print PATCH;
                next  PATCH;
            }

inc/bin/patch  view on Meta::CPAN

    } elsif (/^(\s*)\*{15}$/) {
        # CONTEXT DIFF
        my $space = $1;
        $_ = <PATCH>;
        unless (/^$space(\*\*\* (\d+)(?:,(\d+))? \*\*\*\*\n)/) {
            print PATCH;
            next  PATCH;
        }
        my ($i_range, $i_start, $i_end, @i_hunk) = ($1, $2, $3 || $2);
        my ($o_range, $o_start, $o_end, @o_hunk);
        $patch->bless('context') or next PATCH;
        my $o_hunk = qr/^$space(--- (\d+)(?:,(\d+))? ----\n)/;
        my $re = qr/^$space([ !-] )/;
        $_ = <PATCH>;
        if (/$o_hunk/) {
            ($o_range, $o_start, $o_end) = ($1, $2, $3 || $2);
        } else {
            print PATCH;
            for ($i_start..$i_end) {
                $_ = <PATCH>;
                unless (s/$re/$1/) {

inc/bin/patch  view on Meta::CPAN

                }
                push @o_hunk, $_;
            }
        }
        $patch->apply($i_start, $o_start, \@i_hunk, \@o_hunk)
            or $patch->reject($i_range, @i_hunk, $o_range, @o_hunk);
    } elsif (/^(\s*)((\d+)(?:,(\d+))?([acd])(\d+)(?:,(\d+))?\n)/) {
        # NORMAL DIFF
        my ($space, $range, $i_start, $i_end, $cmd, $o_start, $o_end) =
           ($1,     $2,     $3,     $4 || $3, $5,   $6,       $7 || $6);
        $patch->bless('normal') or next PATCH;
        my (@d_hunk, @a_hunk);
        my $d_re = qr/^$space< /;
        my $a_re = qr/^$space> /;
        if ($cmd eq 'c' || $cmd eq 'd') {
            for ($i_start..$i_end) {
                $_ = <PATCH>;
                unless (s/$d_re//) {
                    $patch->note("Short hunk ignored.\n");
                    $patch->reject($range, @d_hunk);
                    print PATCH;

inc/bin/patch  view on Meta::CPAN

                    next  PATCH;
                }
                push @a_hunk, $_;
            }
        }
        $patch->apply($i_start, $o_start, $cmd, \@d_hunk, \@a_hunk)
            or $patch->reject($range, @d_hunk, "---\n", @a_hunk);
    } elsif (/^(\s*)\d+(?:,\d+)?[acd]$/) {
        # ED SCRIPT
        my $space = qr/^$1/;
        $patch->bless('ed') or next PATCH;
        print PATCH;
        my @cmd;
        ED:
        while (<PATCH>) {
            unless (s/$space// && m!^\d+(?:,\d+)?([acd]|s\Q/^\.\././\E)$!) {
                print PATCH;
                last ED;
            }
            push @cmd, [$_];
            $1 =~ /^[ac]$/ or next;

inc/bin/patch  view on Meta::CPAN

    print @_;
    local $_ = <STDIN>;
    chomp;
    $_;
}

# Constructs a Patch object.
sub new {
    my $class = shift;
    my %copy = %{$_[0]} if ref $_[0];
    bless {
        %copy,
        options => [@_],
        garbage => [],
        rejects => [],
    }, $class;
}

# Blesses object into a subclass.
sub bless {
    my $type = pop;
    my $class = "Patch::\u$type";

    my ($options, $garbage) = @{$_[0]}{'options', 'garbage'};

    # New hunk, same patch.
    $_[0]{hunk}++, return 1 if $_[0]->isa($class) && ! @$garbage;

    # Clean up previous Patch object first.
    $_[0]->end;

    # Get options/switches for new patch.
    my $self = @$options > 1    ? shift @$options :
               @$options == 1   ? { %{$options->[0]} } :
               {};
    bless $self, $class;

    # 'options' and 'garbage'  are probably better off as class
    # data.  Why didn't I do that before?  But it's not broken
    # so I'm not fixing it.
    $self->{options} = $options;    # @options 
    $self->{garbage} = [];          # garbage lines
    $self->{i_pos}   = 0;           # current position in 'in' file
    $self->{o_pos}   = 0;           # just for symmetry
    $self->{i_lines} = 0;           # lines read in 'in' file
    $self->{o_lines} = 0;           # lines written to 'out' file

inc/bin/patch  view on Meta::CPAN

package Pushback;

# Create filehandles that can unread or push lines back into queue.

sub TIEHANDLE {
    my ($class, $file) = @_;
    local *FH;
    open *FH, "< $file" or return;
    binmode FH;
    bless [*FH], $class;
}

sub READLINE {
    my $self = shift;
    @$self == 1 ? readline $self->[0] : pop @$self;
}

sub PRINT {
    my $self = shift;
    $self->[1] = shift;

inc/bin/patch  view on Meta::CPAN

    $self = undef;
}




package Dev::Null;

# Create filehandles that go nowhere.

sub TIEHANDLE { bless \my $null }
sub PRINT {}
sub PRINTF {}
sub WRITE {}
sub READLINE {''}
sub READ {''}
sub GETC {''}

inc/inc_Archive-Extract/Archive/Extract.pm  view on Meta::CPAN

                $ar =~ /.+?\.bz2$/i                 ? BZ2   :
                $ar =~ /.+?\.Z$/                    ? Z     :
                '';

        }

        ### don't know what type of file it is ###
        return __PACKAGE__->_error(loc("Cannot determine file type for '%1'",
                                $parsed->{archive} )) unless $parsed->{type};

        return bless $parsed, $class;
    }
}

=head2 $ae->extract( [to => '/output/path'] )

Extracts the archive represented by the C<Archive::Extract> object to
the path of your choice as specified by the C<to> argument. Defaults to
C<cwd()>.

Since C<.gz> files never hold a directory, but only a single file; if 

inc/inc_File-Fetch/File/Fetch.pm  view on Meta::CPAN

                        return $self->{$method};
                    }
    }
    
    sub _create {
        my $class = shift;
        my %hash  = @_;
        
        my $args = check( $Tmpl, \%hash ) or return;
        
        bless $args, $class;
    
        if( lc($args->scheme) ne 'file' and not $args->host ) {
            return File::Fetch->_error(loc(
                "Hostname required when fetching from '%1'",$args->scheme));
        }
        
        for (qw[path file]) {
            unless( $args->$_ ) {
                return File::Fetch->_error(loc("No '%1' specified",$_));
            }

inc/inc_version/version.pm  view on Meta::CPAN

    *version::qv = \&version::vxs::qv;
}

# Preloaded methods go here.
sub import {
    my ($class) = shift;
    my $callpkg = caller();
    no strict 'refs';
    
    *{$callpkg."::qv"} = 
	    sub {return bless version::qv(shift), $class }
	unless defined(&{"$callpkg\::qv"});

#    if (@_) { # must have initialization on the use line
#	if ( defined $_[2] ) { # CVS style
#	    $_[0] = version::qv($_[2]);
#	}
#	else {
#	    $_[0] = version->new($_[1]);
#	}
#    }

inc/inc_version/version/vpp.pm  view on Meta::CPAN

    eval '
	package warnings;
	sub enabled {return $^W;}
	1;
    ';
}

sub new
{
	my ($class, $value) = @_;
	my $self = bless ({}, ref ($class) || $class);
	
	if ( ref($value) && eval("$value->isa('version')") ) {
	    # Can copy the elements directly
	    $self->{version} = [ @{$value->{version} } ];
	    $self->{qv} = 1 if $value->{qv};
	    $self->{alpha} = 1 if $value->{alpha};
	    $self->{original} = ''.$value->{original};
	    return $self;
	}