view release on metacpan or  search on metacpan

lib/SVK/Patch.pm  view on Meta::CPAN

 # feed things to $editor
 $patch->store ($file);

=head1 DESCRIPTION

SVK::Patch represents tree delta and assorted meta data, such as merge
info and anchor for the patch to be applied.

=cut

use SVK::Editor::Patch;
use SVK::Merge;
use SVK::Editor::Diff;
use SVK::Target::Universal;
use FreezeThaw qw(freeze thaw);
use MIME::Base64;
use Compress::Zlib;

=head1 METHODS

=head2 new

Create a SVK::Patch object.

=cut

sub new {
    my ($class, $name, $xd, $depotname, $src, $dst) = @_;
    my $self = bless { name   => $name,
		       level  => 0,
		       _xd    => $xd,
		       _source => $src,
		       _target => $dst }, $class;
    $self->{_depot} = $self->{_xd}->find_depot($depotname);
    $self->{source} = $self->{_source}->universal if $self->{_source};
    $self->{target} = $self->{_target}->universal;
    return $self;
}

=head2 load

Load a SVK::Patch object from file.

=cut

sub load {
    my ($class, $file, $xd, $depot) = @_;

    my $content = do {
        open my $fh, "< $file" or die loc("cannot open %1: %2\n", $file, $!);

        # Normalize all line endings to LF
        binmode($fh, ":eol(LF)");

        # Serialized patches always begins with a block marker.
        # We need the \nVersion: to not trip over inlined block makers.
        # This is safe because unidiff can't have lines beginning with 'V'.
        local $/ = "==== BEGIN SVK PATCH BLOCK ====\nVersion:"; <$fh>;

        # Now we ignore header paragraph.
        $/ = ""; <$fh>;
        # Slurp everything up to the '=' of the end marker.
        $/ = "\n="; <$fh>;
    };

    die loc("Cannot find a patch block in %1.\n", $file) unless $content;
    chop $content; # remove the final '='. look, a use of chop()!

    my ($self) = thaw (uncompress (decode_base64 ( $content ) ) );
    $self->{_xd} = $xd;
    $self->{_depot} = $self->{_xd}->find_depot($depot);

    my $not_applicable;

    for (qw/source target/) {
	next unless $self->{$_};
	my $tmp = $self->{"_$_"} = $self->{$_}->local($self->{_depot}) or next;
	$tmp = $tmp->new->refresh_revision;
	if (wantarray) {
	    eval { $tmp->normalize };
	    $not_applicable = $@
		if $@;
	} else {
	    $tmp->normalize;
	}
	$self->{"_${_}_updated"} = 1
	    if $tmp->{revision} > $self->{"_$_"}->revision;
    }
    return wantarray ? ($self, $not_applicable) : $self;
}

=head2 store

Store a SVK::Patch object to file.

=cut

sub store {
    my ($self, $file) = @_;
    my $store = bless {map {m/^_/ ? () : ($_ => $self->{$_})} keys %$self}, ref ($self);

    local $ENV{SVKDIFF} = '';
    $self->view(\(my $output));

    write_file(
        $file, join("\n", 
            $output,
            '==== BEGIN SVK PATCH BLOCK ====',
            "Version: svk $SVK::VERSION ($^O)",
            '',
            encode_base64(compress (freeze ($store))).
            '==== END SVK PATCH BLOCK ====',
            ''
        )
    );
}

=head2 editor

Return the SVK::Editor::Patch object for feeding editor calls to, or
driving other editors.