ACIL FM

Nama	Ukuran	Aksi
calcSizes.pl	948 B	View DL Edit
copy.pl	452 B	View DL Edit
extract.pl	896 B	View DL Edit
mailZip.pl	1.58 MB	View DL Edit
mfh.pl	640 B	View DL Edit
readScalar.pl	750 B	View DL Edit
selfex.pl	1.54 MB	View DL Edit
unzipAll.pl	561 B	View DL Edit
updateTree.pl	822 B	View DL Edit
updateZip.pl	892 B	View DL Edit
writeScalar.pl	614 B	View DL Edit
writeScalar2.pl	613 B	View DL Edit
zip.pl	666 B	View DL Edit
zipcheck.pl	1.03 MB	View DL Edit
zipGrep.pl	1.42 MB	View DL Edit
zipinfo.pl	4.43 MB	View DL Edit
ziprecent.pl	7.51 MB	View DL Edit
ziptest.pl	1.76 MB	View DL Edit

Edit file: /usr/share/doc/perl-Archive-Zip/examples/ziprecent.pl

#!/usr/bin/perl -w
# Makes a zip file of the most recent files in a specified directory.
# By Rudi Farkas, rudif@bluemail.ch, 9 December 2000
# Usage:
# ziprecent <dir> -d <ageDays> [-e <ext> ...]> [-h] [-msvc] [-q] [<zippath>]
# Zips files in source directory and its subdirectories
# whose file extension is in specified extensions (default: any extension).
#     -d <days>       max age (days) for files to be zipped (default: 1 day)
#     <dir>           source directory
#     -e <ext>        one or more space-separated extensions
#     -h              print help text and exit
#     -msvc           may be given instead of -e and will zip all msvc source files
#     -q              query only (list files but don't zip)
#     <zippath>.zip   path to zipfile to be created (or updated if it exists)
#
# $Revision: 1.2 $

use strict;

use Archive::Zip qw(:ERROR_CODES :CONSTANTS);
use Cwd;
use File::Basename;
use File::Copy;
use File::Find;
use File::Path;

# argument and variable defaults
#
my $maxFileAgeDays = 1;
my $defaultzipdir  = 'h:/zip/_homework';
my ($sourcedir, $zipdir, $zippath, @extensions, $query);

# usage
#
my $scriptname = basename $0;
my $usage      = <<ENDUSAGE;
$scriptname <dir> -d <ageDays> [-e <ext> ...]> [-h] [-msvc] [-q] [<zippath>]
Zips files in source directory and its subdirectories
whose file extension is in specified extensions (default: any extension).
    -d <days>       max age (days) for files to be zipped (default: 1 day)
    <dir>           source directory
    -e <ext>        one or more space-separated extensions
    -h              print help text and exit
    -msvc           may be given instead of -e and will zip all msvc source files
    -q              query only (list files but don't zip)
    <zippath>.zip   path to zipfile to be created (or updated if it exists)
ENDUSAGE

# parse arguments
#
while (@ARGV) {
    my $arg = shift;

if ($arg eq '-d') {
        $maxFileAgeDays = shift;
        $maxFileAgeDays = 0.0 if $maxFileAgeDays < 0.0;
    } elsif ($arg eq '-e') {
        while ($ARGV[0] && $ARGV[0] !~ /^-/) {
            push @extensions, shift;
        }
    } elsif ($arg eq '-msvc') {
        push @extensions,
          qw / bmp c cpp def dlg dsp dsw h ico idl mak odl rc rc2 rgs /;
    } elsif ($arg eq '-q') {
        $query = 1;
    } elsif ($arg eq '-h') {
        print STDERR $usage;
        exit;
    } elsif (-d $arg) {
        $sourcedir = $arg;
    } elsif ($arg eq '-z') {
        if ($ARGV[0]) {
            $zipdir = shift;
        }
    } elsif ($arg =~ /\.zip$/) {
        $zippath = $arg;
    } else {
        errorExit("Unknown option or argument: $arg");
    }
}

# process arguments
#
errorExit("Please specify an existing source directory")
  unless defined($sourcedir) && -d $sourcedir;

my $extensions;
if (@extensions) {
    $extensions = join "|", @extensions;
} else {
    $extensions = ".*";
}

# change '\' to '/' (avoids trouble in substitution on Win2k)
#
$sourcedir =~ s|\\|/|g;
$zippath =~ s|\\|/|g if defined($zippath);

# find files
#
my @files;
cwd $sourcedir;
find(\&listFiles, $sourcedir);
printf STDERR "Found %d file(s)\n", scalar @files;

# exit ?
#
exit if $query;
exit if @files <= 0;

# prepare zip directory
#
if (defined($zippath)) {

# deduce directory from zip path
    $zipdir = dirname($zippath);
    $zipdir = '.' unless length $zipdir;
} else {
    $zipdir = $defaultzipdir;
}

# make sure that zip directory exists
#
mkpath $zipdir unless -d $zipdir;
-d $zipdir or die "Can't find/make directory $zipdir\n";

# create the zip object
#
my $zip = Archive::Zip->new();

# read-in the existing zip file if any
#
if (defined $zippath && -f $zippath) {
    my $status = $zip->read($zippath);
    warn "Read $zippath failed\n" if $status != AZ_OK;
}

# add files
#
foreach my $memberName (@files) {
    if (-d $memberName) {
        warn "Can't add tree $memberName\n"
          if $zip->addTree($memberName, $memberName) != AZ_OK;
    } else {
        $zip->addFile($memberName)
          or warn "Can't add file $memberName\n";
    }
}

# prepare the new zip path
#
my $newzipfile = genfilename();
my $newzippath = "$zipdir/$newzipfile";

# write the new zip file
#
my $status = $zip->writeToFileNamed($newzippath);
if ($status == AZ_OK) {

# rename (and overwrite the old zip file if any)?
    #
    if (defined $zippath) {
        my $res = rename $newzippath, $zippath;
        if ($res) {
            print STDERR "Updated file $zippath\n";
        } else {
            print STDERR
              "Created file $newzippath, failed to rename to $zippath\n";
        }
    } else {
        print STDERR "Created file $newzippath\n";
    }
} else {
    print STDERR "Failed to create file $newzippath\n";
}

# subroutines
#

sub listFiles {
    if (/\.($extensions)$/) {
        cwd $File::Find::dir;
        return if -d $File::Find::name;    # skip directories
        my $fileagedays = fileAgeDays($_);
        if ($fileagedays < $maxFileAgeDays) {
            printf STDERR "$File::Find::name    (%.3g)\n", $fileagedays;
            (my $filename = $File::Find::name) =~
              s/^[a-zA-Z]://;              # remove the leading drive letter:
            push @files, $filename;
        }
    }
}

sub errorExit {
    printf STDERR "*** %s ***\n$usage\n", shift;
    exit;
}

sub mtime {
    (stat shift)[9];
}

sub fileAgeDays {
    (time() - mtime(shift)) / 86400;
}

sub genfilename {
    my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
      localtime(time);
    sprintf "%04d%02d%02d-%02d%02d%02d.zip", $year + 1900, $mon + 1, $mday,
      $hour, $min, $sec;
}

__END__

=head1 NAME

ziprecent.pl

=head1 SYNOPSIS

ziprecent h:/myperl

ziprecent h:/myperl -e pl pm -d 365

ziprecent h:/myperl -q

ziprecent h:/myperl h:/temp/zip/file1.zip

=head1 DESCRIPTION

This script helps to collect recently modified files in a source directory
into a zip file (new or existing).

It uses Archive::Zip.

=over 4

=item C<  ziprecent h:/myperl  >

Lists and zips all files more recent than 1 day (24 hours)
in directory h:/myperl and it's subdirectories,
and places the zip file into default zip directory.
The generated zip file name is based on local time (e.g. 20001208-231237.zip).

=item C<  ziprecent h:/myperl -e pl pm -d 365  >

Zips only .pl and .pm files more recent than one year.

=item C<  ziprecent h:/myperl -msvc  >

Zips source files found in a typical MSVC project.

=item C<  ziprecent h:/myperl -q  >

Lists files that should be zipped.

=item C<  ziprecent h:/myperl h:/temp/zip/file1.zip  >

Updates file named h:/temp/zip/file1.zip
(overwrites an existing file if writable).

=item C<  ziprecent -h  >

Prints the help text and exits.

ziprecent.pl <dir> -d <days> [-e <ext> ...]> [-h] [-msvc] [-q] [<zippath>]
 Zips files in source directory and its subdirectories
 whose file extension is in specified extensions (default: any extension).
    -d <days>       max age (days) for files to be zipped (default: 1 day)
    <dir>           source directory
    -e <ext>        one or more space-separated extensions
    -h              print help text and exit
    -msvc           may be given instead of -e and will zip all msvc source files
    -q              query only (list files but don't zip)
    <zippath>.zip   path to zipfile to be created (or updated if it exists)

=back

=head1 BUGS

Tested only on Win2k.

Does not handle filenames without extension.

Does not accept more than one source directory (workaround: invoke separately
for each directory, specifying the same zip file).

=head1 AUTHOR

Rudi Farkas rudif@lecroy.com rudif@bluemail.ch

=head1 SEE ALSO

perl ;-)

=cut

Batal