view release on metacpan or  search on metacpan

lib/App/BCVI/InstallManager.pm  view on Meta::CPAN

    my($self) = @_;

    if(my $arg = $self->opt('update-all')) {  # usual value '' is false
        if($arg eq 'list') {
            return $self->list_all_installs
        }
        elsif($arg =~ m{^-(.+)$}) {
            return $self->untrack_host($1);
        }
        die "Unrecognised argument ('$arg') to --update-all\n";
    }

    my $sig = $self->install_source_signature();
    my $host_sigs = $self->all_install_signatures();
    my @hosts = grep { $host_sigs->{$_} ne $sig } sort keys %$host_sigs;
    if(@hosts) {
        $self->install_to_hosts(@hosts);
    }
    else {
        print "All known targets are up to date\n";
        exit(0);
    }
}


sub list_all_installs {
    my($self) = @_;

    my $valid = $self->install_source_signature();

    $self->tie_install_sig_db();

    foreach my $key (sort keys %sig_db) {
        my $sig = $sig_db{$key};
        if($sig eq $valid) {
            printf("%-30s  OK\n", $key);
        }
        else {
            printf("%-30s  Needs update\n", $key);
        }
    }

    $self->untie_install_sig_db();
}


sub untrack_host {
    my($self, $host) = @_;

    print "Discarding install info for $host\n";
    $self->tie_install_sig_db();
    delete $sig_db{$host};
    $self->untie_install_sig_db();
}


sub install_to_host {
    my($self, $host) = @_;

    my $sig = $self->install_source_signature();
    if( $self->SUPER::install_to_host($host) ) {
        $self->set_install_signature($host=> $sig);
        return 1;
    }
    return;
}


sub tie_install_sig_db {
    my($self) = @_;
    $db_file ||= File::Spec->catfile($self->conf_directory, 'install.db');
    tie(%sig_db, 'SDBM_File', $db_file,  O_RDWR|O_CREAT, 0666)
        or die "Couldn't tie SDBM file $db_file: $!; aborting";
}


sub untie_install_sig_db {
    my($self) = @_;
    untie %sig_db;
}


sub set_install_signature {
    my($self, $host, $sig) = @_;
    $self->tie_install_sig_db();
    $sig_db{$host} = $sig;
    $self->untie_install_sig_db();
}


sub get_install_signature {
    my($self, $host) = @_;
    $self->tie_install_sig_db();
    my $sig = $sig_db{$host};
    $self->untie_install_sig_db();
    return $sig;
}


sub all_install_signatures {
    my($self) = @_;
    $self->tie_install_sig_db();
    my $all = { %sig_db };
    $self->untie_install_sig_db();
    return $all;
}


sub install_source_signature {
    my($self) = @_;

    return $source_signature if $source_signature;

    my $md5 = Digest::MD5->new;
    open my $fh, '<', $0 or die "open($0): $!";
    $md5->addfile($fh);
    close($fh);

    foreach my $path ( $self->installable_files ) {
        open my $fh, '<', $path or die "open($path): $!";
        $md5->addfile($fh);