view release on metacpan or  search on metacpan

lib/App/DistSync/Util.pm  view on Meta::CPAN

    # Original see Ext::Utils::maniread
    my $mfile = shift;
    my $skipflag = shift;

    my $read = {};
    return $read unless defined($mfile) && (-e $mfile) && (-r $mfile) && (-s $mfile);
    my $fh;
    unless (open $fh, "<", $mfile){
        printf STDERR "Can't open file \"%s\": %s\n", $mfile, $!;
        return $read;
    }
    local $_;
    while (<$fh>){
        chomp;
        next if /^\s*#/;
        my($file, $args);

        if ($skipflag && $_ =~ /^\s*\!\!perl\/regexp\s*/i) { # Working in SkipMode
            #s/\r//;
            #$_ =~ qr{^\s*\!\!perl\/regexp\s*(?:(?:'([^\\']*(?:\\.[^\\']*)*)')|([^#\s]\S*))?(?:(?:\s*)|(?:\s+(.*?)\s*))$};
            #$args = $3;
            #my $file = $2;
            #if ( defined($1) ) {
            #    $file = $1;
            #    $file =~ s/\\(['\\])/$1/g;
            #}
            unless (($file, $args) = /^'(\\[\\']|.+)+'\s*(.*)/) {
                ($file, $args) = /^(^\s*\!\!perl\/regexp\s*\S+)\s*(.*)/;
            }
        } else {
            # filename may contain spaces if enclosed in ''
            # (in which case, \\ and \' are escapes)
            if (($file, $args) = /^'(\\[\\']|.+)+'\s*(.*)/) {
                $file =~ s/\\([\\'])/$1/g;
            } else {
                ($file, $args) = /^(\S+)\s*(.*)/;
            }
        }
        next unless $file;
        $read->{$file} = [defined $args ? split(/\s+/,$args) : ""];
    }
    close $fh;
    return $read;
}
sub manifind {
    my $dir = shift;
    carp("Can't specified directory") && return {} unless defined($dir) && -e $dir;

    my $found = {};
    my $base = File::Spec->canonpath($dir);
    #my ($volume,$sdirs,$sfile) = File::Spec->splitpath( $base );

    my $wanted = sub {
        my $path = File::Spec->canonpath($_);
        my $name = File::Spec->abs2rel( $path, $base );
        my $fdir = File::Spec->canonpath($File::Find::dir);
        return if -d $_;

        my $key = join("/", File::Spec->splitdir(File::Spec->catfile($name)));
        $found->{$key} = {
                mtime   => (stat($_))[9] || 0,
                size    => (-s $_) || 0,
                dir     => $fdir,
                path    => $path,
                file    => File::Spec->abs2rel( $path, $fdir ),
            };
    };

    # We have to use "$File::Find::dir/$_" in preprocess, because
    # $File::Find::name is unavailable.
    # Also, it's okay to use / here, because MANIFEST files use Unix-style
    # paths.
    find({
            wanted      => $wanted,
            no_chdir    => 1,
        }, $dir);

    return $found;
}
sub maniwrite {
    my $file = shift;
    my $mani = shift;
    carp("Can't specified file") && return 0 unless defined($file);
    carp("Can't specified manifest-hash") && return 0 unless defined($mani) && ref($mani) eq 'HASH';
    my $file_bak = $file.".bak";

    rename $file, $file_bak;
    my $fh;

    unless (open $fh, ">", $file){
        printf STDERR "Can't open file \"%s\": %s\n", $file, $!;
        rename $file_bak, $file;
        return 0;
    }

    # Stamp
    print  $fh "###########################################\n";
    printf $fh "# File created at %s\n", scalar(localtime(time()));
    print  $fh "# Please, do NOT edit this file directly!!\n";
    print  $fh "###########################################\n\n";

    foreach my $f (sort { lc $a cmp lc $b } keys %$mani) {
        my $d = $mani->{$f};
        my $text = sprintf("%s\t%s\t%s",
                $d->{mtime} || 0,
                $d->{size} || 0,
                $d->{mtime} ? scalar(localtime($d->{mtime})) : 'UNKNOWN',
            );
        my $tabs = (8 - (length($f)+1)/8);
        $tabs = 1 if $tabs < 1;
        $tabs = 0 unless $text;
        if ($f =~ /\s/) {
            $f =~ s/([\\'])/\\$1/g;
            $f = "'$f'";
        }
        print $fh $f, "\t" x $tabs, $text, "\n";
    }
    close $fh;

    unlink $file_bak;