view release on metacpan or  search on metacpan

lib/ChainMake.pm  view on Meta::CPAN

    }
    return undef;    
}

sub execute_perl {
    my ($self,$cmd)=@_;
    print "> $cmd\n";
    system("$^X $cmd");
    if ($? == -1) {
    	$self->_diag(0,"failed to execute: $!\n");
    }
    elsif ($? & 127) {
	    $self->_diag(0,sprintf "child died with signal %d, %s coredump\n",
            ($? & 127),  ($? & 128) ? 'with' : 'without');
    }
    else {
	    my $value=$? >> 8;
        return ($value == 0);
    }
    return undef;    
}

sub available_targets {
    my $self=shift;
    my $list;
    for (@{$self->{targettypes}}) {
        my @targets=@{$_->{targets}};
        my $col=0;
        while (@targets) {
            $list.=sprintf "%-30.30s", shift @targets;
            $list.="\n" if $col++==3;
            $col%=3;
        }
        $list.="\n";
    }
    return $list;
}   

sub _check_requirements {
    # Alle Requirements checken (d.h. make darauf ausführen),
    # und Timestamp des jüngsten zurückgeben.
    # serieller Modus
    my ($self,$req,$insistent,$parallel)=@_;
    my ($cannot_make,$cannot_make_name)=(0,'');
    my $youngest;
    REQUIREMENTS:
    for my $dep (@$req) {
        my $age;
        # ist es der Name eines Targets?
        if ($self->_match_target($dep)) {
            $age=$self->chainmake($dep);
            unless ($age) {
                $self->_diag(1,"Requirement '$dep' failed.\n");
                $cannot_make=1;
                $cannot_make_name=$dep;
                last REQUIREMENTS unless ($insistent);
            }
        }
        # oder der Name einer Datei?
        elsif (-e $dep) {
            $age=(stat($dep))[9];
        }
        # Requirement nicht auffindbar
        else {
            $self->_diag(1,"Missing requirement '$dep'.\n");
            $cannot_make=1;
            $cannot_make_name=$dep;
            last REQUIREMENTS unless ($insistent);
        }

        # ist dieses Requirement jünger als das bisher Jüngste?
        if (!($youngest) || (($age) && ($age > $youngest))) {
            $youngest=$age;
        }
    }
    return ($cannot_make ? 0 : $youngest);# $cannot_make_name kann er auch noch returnen
}

sub _match_target {
    my ($self,$t_name)=@_;
    for my $t (@{$self->{targettypes}}) {
        for my $name (@{$t->{targets}}) {
            my $match;
            if (ref($name) eq 'Regexp') {
                $match=$t_name =~ $name;
            }
            else {
                $match=$t_name eq $name;
            }
            if ($match) {
                return $t;
            }
        }
    }
    return undef;
}
    
sub _check_file_timestamps {
    my ($self,$ver)=@_;
    my ($oldest,$youngest,$missing);
    for my $timestamps (@{$ver}) {
        if (-e $timestamps) {
            my $mtime = (stat($timestamps))[9];
            $youngest=$mtime unless (($youngest) && ($youngest >= $mtime));
            $oldest=$mtime unless (($oldest) && ($oldest <= $mtime));
        }
        else {
            $missing=$timestamps;
        }
    }
    return ($oldest,$youngest,$missing);
}

sub _get_timestamp {
    my ($self,$target)=@_;
    my $ts;
    my $tie=tie(my @array, 'Tie::File', $self->{timestamps_file}, memory => 0, mode => O_RDONLY | O_CREAT ) or die "Kann Datei $$self{timestamps_file} nicht zum Lesen verbinden";
    $tie->flock(LOCK_SH);
    for (@array) {
        my ($t,$v)=split "\t";
        if ($t eq $target) {
            $ts=$v;
            last;
        }
    }
    undef $tie;
    untie @array;
    
    return $ts;
}

sub _write_timestamp {
    my ($self,$target,$val) = @_;

    my $tie=tie(my @array, 'Tie::File', $self->{timestamps_file}, memory => 0 ) or die "Kann Datei $$self{timestamps_file} nicht zum Lesen verbinden";
    $tie->flock(LOCK_EX);

    for my $n (0 .. $#array) {
        my ($t,$v) = split "\t", $array[$n];
        next unless $t eq $target;
        splice @array, $n, 1;
        last;
    }
    push(@array,"$target\t$val");
    undef $tie;
    untie @array;
}

sub delete_timestamp {
    my ($self,$target) = @_;
    my $ret=0;

    my $tie=tie(my @array, 'Tie::File', $self->{timestamps_file}, memory => 0 ) or die "Kann Datei $$self{timestamps_file} nicht zum Lesen verbinden";
    $tie->flock(LOCK_EX);

    for my $n (0 .. $#array) {
        my ($t,$v) = split "\t", $array[$n];
        if ($t eq $target) {
            splice(@array, $n, 1);
            $ret=1;
            last;
        }
    }