view release on metacpan or  search on metacpan

lib/Cvs/Trigger.pm  view on Meta::CPAN

            push @{ $res->{files} }, @files;
        }
    }

    if($data =~ m#Log\sMessage:\n(.*)#sgx) {
        $res->{message} = $1;
    }

    return $res;
}

#Update of /tmp/vHmsem4xFV/cvsroot/m/a
#In directory mybox:/tmp/vHmsem4xFV/local_root/m/a
#
#Modified Files:
#       a1.txt
#Log Message:
#m/a/a1.txt-check-in-message

#2006/04/08 13:29:22 argv=loginfo
#2006/04/08 13:29:22 pid=20656 ppid=20653
#2006/04/08 13:29:22 stdin: a txt,1.20,1.21
#2006/04/08 13:29:22 stdin: Update of /home/mschilli/testcvs/a
#2006/04/08 13:29:22 stdin: In directory mybox:/mnt/big2/mschilli.do.not.delete/tmp/a
#2006/04/08 13:29:22 stdin: 
#2006/04/08 13:29:22 stdin: Modified Files:
#2006/04/08 13:29:22 stdin:      txt 
#2006/04/08 13:29:22 stdin: Log Message:
#2006/04/08 13:29:22 stdin: foobar
#2006/04/08 13:29:22 stdin: 

###########################################
sub _slurp {
###########################################
    my($file) = @_;

    local $/ = undef;

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

    return $data;
}

#2006/04/08 13:29:11 argv=commitinfo /home/mschilli/testcvs/a txt
#2006/04/08 13:29:11 Slurping data from /home/mschilli/testcvs/a
#2006/04/08 13:29:11 Read (0)[] from /home/mschilli/testcvs/a
#2006/04/08 13:29:11 data=
#2006/04/08 13:29:11 pid=20645 ppid=20644
#

###########################################
sub _cache_set {
###########################################
    my($self, $repo_dir, @files) = @_;

    my $ppid = getppid();

    my $cdata = $self->_cache_get();

    for my $file (@files) {
        DEBUG "Caching $repo_dir/$file under ppid=$ppid";

        push @{ $cdata->{$repo_dir} }, $file;
    }
    $cdata->{_ttl} += 1;
    DEBUG "Setting $ppid cache to ", Dumper($cdata);
    $self->{file_cache}->set($ppid, freeze $cdata);
}

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

    my $ppid = getppid();

    my $cdata = $self->_cache_get();
    $cdata->{_ttl}--;

    $self->{file_cache}->set($ppid, freeze $cdata);

    return $cdata->{_ttl};
}

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

    my $ppid = getppid();

    my $cdata;

    if(my $c = $self->{file_cache}->get($ppid)) {
        DEBUG "Cache hit on ppid=$ppid";
        $cdata = thaw $c;
    } else {
        DEBUG "Cache miss on ppid=$ppid";
        $cdata = { _ttl => 0 };
    }

    return $cdata;
}

###########################################
package Cvs::Temp;
###########################################
use strict;
use warnings;
use File::Temp qw(tempdir);
use Sysadm::Install qw(:all);
use Log::Log4perl qw(:easy);
use Cwd;

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

    my $self = {
        dir => tempdir(CLEANUP => 1),
        %options,
    };

    $self->{cvsroot}     = "$self->{dir}/cvsroot";
    $self->{local_root}  = "$self->{dir}/local_root";
    $self->{out_dir}     = "$self->{dir}/out_dir";
    $self->{bin_dir}     = "$self->{dir}/bin";

    mkd $self->{local_root};
    mkd $self->{out_dir};
    mkd $self->{bin_dir};

    DEBUG "tempdir = $self->{dir}";

    $self->{cvs_bin}  = bin_find("cvs") unless defined $self->{cvs_bin};
    $self->{perl_bin} = bin_find("perl") unless 
                        defined $self->{perl_bin};

    if(! defined $self->{cvs_bin}) {
        LOGDIE "Cannot find 'cvs' binary in your PATH.";
    }

    my($stdout, $stderr, $rc) = tap $self->{cvs_bin}, "-v";
    if($rc == 0 and $stdout =~ /(\d+\.\d+)/) {
        $self->{cvs_version} = $1;
    } else {
        LOGDIE "Cannot determine CVS version ($stderr)";
    }

    bless $self, $class;

    return $self;
}

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

    $self->cvs_cmd("init");
    DEBUG "New cvs created in $self->{cvsroot}";