view release on metacpan or  search on metacpan

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

Config::Patcher::Util::make_accessor( __PACKAGE__, $_ ) for @accessors;

###########################################
sub new {
###########################################
    my($class, %options) = @_;

    my $self = {
        comment_char => '#',
        mode         => "append",
        key          => undef,
        text         => undef,
        %options,
    };

    bless $self, $class;
}

###########################################
sub patch_marker {
###########################################
    my($self) = @_;

    return $self->{comment_char} .
           "(Config::Patch-" .
           "$self->{key}-" .
           $self->mode() .
           ")" .
           "\n";
}

###########################################
sub string_generate {
###########################################
    my($self) = @_;

    return $self->patch_marker() . 
           $self->text() .
           $self->patch_marker();
}

###########################################
sub freeze {
###########################################
    my($self, $string) = @_;

    # Hide an arbitrary string in a comment
    my $encoded = encode_base64($string);

    $encoded =~ s/^/$self->{comment_char} /gm;
    return $encoded;
}

###########################################
sub thaw {
###########################################
    my($self, $string) = @_;

    # Decode a hidden string 
    $string =~ s/^$self->{comment_char} //gm;
    my $decoded = decode_base64($string);
    return $decoded;
}

###########################################
sub replstring_extract {
###########################################
    my($self) = @_;

    my $text = $self->text();

    # Find the replace string in a patch
    my $replace_marker = $self->replace_marker();
    $replace_marker = quotemeta($replace_marker);
    if($text =~ /^$replace_marker\n(.*?)
                  ^$replace_marker/xms) {
        my $repl = $1;
        $text =~ s/^$replace_marker.*?
                    ^$replace_marker\n//xms;

        return($self->thaw($repl), $text);
    }

    return undef;
}

###########################################
sub replstring_hide {
###########################################
    my($self, $replstring) = @_;

    # Add a replace string to a patch
    my $replace_marker = $self->replace_marker();
    my $encoded = $replace_marker . "\n" .
                  $self->freeze($replstring) .
                  $replace_marker .
                  "\n";

    return $encoded;
}

###########################################
sub replace_marker {
###########################################
    my($self) = @_;

    return $self->{comment_char} .
           "(Config::Patch::replace)";
}

###########################################
package Config::Patch;
###########################################
use strict;
use warnings;
use Set::IntSpan;
use Fcntl qw(:flock);
use Log::Log4perl qw(:easy);

our $VERSION     = "0.09";

our @accessors = qw(data file comment_char key);