view release on metacpan or  search on metacpan

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

                content_pos_to    => $end_pos   - length($&),
                as_string         => substr( $self->{data}, $start_pos,
                                             $end_pos - $start_pos + 1 ),
            );

            $patch_cb->($self, $patch_obj);
            $patch_text = "";
        }

            # toggle flag
        if($_ =~ $self->{patch_regex}) {
            if($in_patch) {
                # End line
            } else {
                # Start Line
                $text_cb->($self, $text);
                $start_pos = $pos - length $_;
                $header = $_;
            }
            $text = "";
            $in_patch = ($in_patch xor 1);
        }
    }

    $text_cb->($self, $text) if length $text;

    return 1;
}

###############################################
sub blurt {
###############################################
    my($self, $data, $file) = @_;

    open FILE, ">$file" or LOGDIE "Cannot open $file ($!)";
    print FILE $data;
    close FILE;
}

###############################################
sub slurp {
###############################################
    my($self, $file) = @_;

    local $/ = undef;
    open FILE, "<$file" or LOGDIE "Cannot open $file ($!)";
    my $data = <FILE>;
    close FILE;

    return $data;
}

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

        # Ignore if locking wasn't requested
    return if ! $self->{flock};

        # Already locked?
    if($self->{locked}) {
        $self->{locked}++;
        return 1;
    }

    open my $fh, "+<$self->{file}" or 
        LOGDIE "Cannot open $self->{file} ($!)";

    flock($fh, LOCK_EX);

    $self->{fh} = $fh;

    $self->{locked} = 1;
}

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

        # Ignore if locking wasn't requested
    return if ! $self->{flock};

    if(! $self->{locked}) {
            # Not locked?
        return 1;
    }

    if($self->{locked} > 1) {
            # Multiple lock released?
        $self->{locked}--;
        return 1;
    }

        # Release the last lock
    flock($self->{fh}, LOCK_UN);
    $self->{locked} = undef;
    1;
}

# LEGACY METHODS

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

    # LEGACY METHOD, DON'T USE

    my @patches = ();
    my %patches = ();

    $self->data_traverse(
        sub { my($patcher, $patch) = @_;
              push @patches, 
                   [$patch->key(), 
                    $patch->mode(),
                    $patch->text(),
                    $patch->pos_from(),
                    $patch->pos_to(),
                    $patch->header(),
                    $patch->content_pos_from(),
                    $patch->content_pos_to(),
                   ];
              $patches{ $patch->key() }++;
            },
        sub { },
    );

    return \@patches, \%patches;
}

###########################################
sub prepend {
###########################################
    my($self, $text) = @_;

    # LEGACY METHOD, DON'T USE

    $self->lock();
    $self->read() unless $self->{read};

    $self->patch_by_stretch( $text, "prepend" );

    $self->save();
    $self->unlock();
    return 1;
}

###########################################
sub append {
###########################################
    my($self, $text) = @_;

    # LEGACY METHOD, DON'T USE

    $self->lock();