← Back to branch summary

~ubuntu-branches/ubuntu/intrepid/horae/intrepid

« back to all changes in this revision

Viewing changes to 0CPAN/Archive-Zip-1.16/examples/ziprecent.pl

  • Committer: Bazaar Package Importer
  • Author(s): Carlo Segre
  • Date: 2008-02-23 23:13:02 UTC
  • mfrom: (2.1.2 hardy)
  • Revision ID: james.westby@ubuntu.com-20080223231302-mnyyxs3icvrus4ke
Tags: 066-3
Apply patch to athena_parts/misc.pl for compatibility with 
perl-tk 804.28.

Show diffs side-by-side

added added

removed removed

Lines of Context:
0CPAN/Archive-Zip-1.16/examples/ziprecent.pl
1
 
#!/usr/bin/perl -w
2
 
# Makes a zip file of the most recent files in a specified directory.
3
 
# By Rudi Farkas, rudif@bluemail.ch, 9 December 2000
4
 
# Usage: 
5
 
# ziprecent <dir> -d <ageDays> [-e <ext> ...]> [-h] [-msvc] [-q] [<zippath>]
6
 
# Zips files in source directory and its subdirectories
7
 
# whose file extension is in specified extensions (default: any extension).
8
 
#     -d <days>       max age (days) for files to be zipped (default: 1 day)
9
 
#     <dir>           source directory
10
 
#     -e <ext>        one or more space-separated extensions  
11
 
#     -h              print help text and exit
12
 
#     -msvc           may be given instead of -e and will zip all msvc source files  
13
 
#     -q              query only (list files but don't zip)
14
 
#     <zippath>.zip   path to zipfile to be created (or updated if it exists)
15
 
#
16
 
# $Revision: 1.2 $
17
 
 
18
 
use strict;
19
 
 
20
 
use Archive::Zip qw(:ERROR_CODES :CONSTANTS);
21
 
use Cwd; 
22
 
use File::Basename;
23
 
use File::Copy;
24
 
use File::Find;
25
 
use File::Path; 
26
 
 
27
 
# argument and variable defaults
28
 
#
29
 
my $maxFileAgeDays = 1;
30
 
my $defaultzipdir = 'h:/zip/_homework'; 
31
 
my ($sourcedir, $zipdir, $zippath, @extensions, $query);
32
 
 
33
 
 
34
 
# usage
35
 
#
36
 
my $scriptname = basename $0;
37
 
my $usage = <<ENDUSAGE;
38
 
$scriptname <dir> -d <ageDays> [-e <ext> ...]> [-h] [-msvc] [-q] [<zippath>]
39
 
Zips files in source directory and its subdirectories
40
 
whose file extension is in specified extensions (default: any extension).
41
 
    -d <days>       max age (days) for files to be zipped (default: 1 day)
42
 
    <dir>           source directory
43
 
    -e <ext>        one or more space-separated extensions  
44
 
    -h              print help text and exit
45
 
    -msvc           may be given instead of -e and will zip all msvc source files  
46
 
    -q              query only (list files but don't zip)
47
 
    <zippath>.zip   path to zipfile to be created (or updated if it exists)
48
 
ENDUSAGE
49
 
 
50
 
 
51
 
# parse arguments
52
 
#
53
 
while (@ARGV) {
54
 
    my $arg = shift;
55
 
 
56
 
    if ($arg eq '-d') {
57
 
        $maxFileAgeDays = shift;
58
 
        $maxFileAgeDays = 0.0 if $maxFileAgeDays < 0.0;
59
 
    }
60
 
    elsif ($arg eq '-e') {
61
 
        while ($ARGV[0] && $ARGV[0] !~ /^-/) {
62
 
            push @extensions, shift;    
63
 
        }
64
 
    }
65
 
    elsif ($arg eq '-msvc') {
66
 
        push @extensions, qw / bmp c cpp def dlg dsp dsw h ico idl mak odl rc rc2 rgs /;
67
 
    }
68
 
    elsif ($arg eq '-q') {
69
 
        $query = 1;
70
 
    }
71
 
    elsif ($arg eq '-h') {
72
 
        print STDERR $usage;
73
 
        exit;
74
 
    }
75
 
    elsif (-d $arg) {
76
 
        $sourcedir = $arg;
77
 
    }
78
 
    elsif ($arg eq '-z') {
79
 
        if ($ARGV[0]) {
80
 
            $zipdir = shift;    
81
 
        }
82
 
    }
83
 
    elsif ($arg =~ /\.zip$/) {
84
 
        $zippath = $arg;
85
 
    }
86
 
    else {
87
 
        errorExit("Unknown option or argument: $arg");
88
 
    }
89
 
}
90
 
 
91
 
# process arguments
92
 
#
93
 
errorExit("Please specify an existing source directory") unless defined($sourcedir) && -d $sourcedir;
94
 
 
95
 
my $extensions;
96
 
if (@extensions) {
97
 
    $extensions = join "|", @extensions;
98
 
}
99
 
else {
100
 
    $extensions = ".*";
101
 
}
102
 
 
103
 
# change '\' to '/' (avoids trouble in substitution on Win2k)
104
 
#
105
 
$sourcedir =~ s|\\|/|g;
106
 
$zippath =~ s|\\|/|g if defined($zippath);
107
 
 
108
 
 
109
 
# find files
110
 
#
111
 
my @files;
112
 
cwd $sourcedir;
113
 
find(\&listFiles, $sourcedir);
114
 
printf STDERR "Found %d file(s)\n", scalar @files;
115
 
 
116
 
 
117
 
# exit ?
118
 
#
119
 
exit if $query;
120
 
exit if @files <= 0;
121
 
 
122
 
 
123
 
# prepare zip directory
124
 
#
125
 
if (defined($zippath)) {
126
 
    # deduce directory from zip path
127
 
    $zipdir = dirname($zippath);
128
 
    $zipdir = '.' unless length $zipdir;
129
 
}
130
 
else {
131
 
    $zipdir= $defaultzipdir;
132
 
}
133
 
 
134
 
# make sure that zip directory exists
135
 
#
136
 
mkpath $zipdir unless -d $zipdir;
137
 
-d $zipdir or die "Can't find/make directory $zipdir\n";
138
 
 
139
 
 
140
 
 
141
 
# create the zip object
142
 
#
143
 
my $zip = Archive::Zip->new();
144
 
 
145
 
 
146
 
# read-in the existing zip file if any
147
 
#
148
 
if (defined $zippath && -f $zippath) {
149
 
    my $status = $zip->read($zippath);
150
 
    warn "Read $zippath failed\n" if $status != AZ_OK;
151
 
}
152
 
 
153
 
# add files
154
 
#
155
 
foreach my $memberName (@files)
156
 
{
157
 
    if (-d $memberName )
158
 
    {
159
 
        warn "Can't add tree $memberName\n"
160
 
            if $zip->addTree( $memberName, $memberName ) != AZ_OK;
161
 
    }
162
 
    else
163
 
    {
164
 
        $zip->addFile( $memberName )
165
 
            or warn "Can't add file $memberName\n";
166
 
    }
167
 
}
168
 
 
169
 
 
170
 
# prepare the new zip path 
171
 
#
172
 
my $newzipfile = genfilename();
173
 
my $newzippath = "$zipdir/$newzipfile";
174
 
 
175
 
 
176
 
# write the new zip file
177
 
#
178
 
my $status = $zip->writeToFileNamed($newzippath);
179
 
if ($status == AZ_OK) {
180
 
    # rename (and overwrite the old zip file if any)?
181
 
    #
182
 
    if (defined $zippath) {
183
 
        my $res = rename $newzippath, $zippath;
184
 
        if ($res) {
185
 
            print STDERR "Updated file $zippath\n";
186
 
        }
187
 
        else {
188
 
            print STDERR "Created file $newzippath, failed to rename to $zippath\n";
189
 
        }
190
 
    } 
191
 
    else {
192
 
        print STDERR "Created file $newzippath\n";
193
 
    }
194
 
}
195
 
else {
196
 
    print STDERR "Failed to create file $newzippath\n"; 
197
 
}
198
 
 
199
 
 
200
 
 
201
 
# subroutines
202
 
#
203
 
 
204
 
sub listFiles {
205
 
    if (/\.($extensions)$/) {
206
 
        cwd $File::Find::dir;
207
 
        return if -d $File::Find::name; # skip directories
208
 
        my $fileagedays = fileAgeDays($_);
209
 
        if ($fileagedays < $maxFileAgeDays) {
210
 
            printf STDERR "$File::Find::name    (%.3g)\n", $fileagedays;
211
 
            (my $filename = $File::Find::name) =~ s/^[a-zA-Z]://;  # remove the leading drive letter:
212
 
            push @files, $filename;
213
 
        }
214
 
    }
215
 
}
216
 
 
217
 
sub errorExit {
218
 
    printf STDERR "*** %s ***\n$usage\n", shift;
219
 
    exit;
220
 
}
221
 
 
222
 
sub mtime {
223
 
    (stat shift)[9];
224
 
}
225
 
 
226
 
sub fileAgeDays {
227
 
    (time() - mtime(shift)) / 86400;
228
 
}
229
 
 
230
 
sub genfilename {
231
 
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
232
 
    sprintf "%04d%02d%02d-%02d%02d%02d.zip", $year+1900, $mon+1, $mday, $hour, $min, $sec;
233
 
}
234
 
 
235
 
__END__
236
 
 
237
 
=head1 NAME
238
 
 
239
 
ziprecent.pl
240
 
 
241
 
=head1 SYNOPSIS
242
 
 
243
 
  ziprecent h:/myperl
244
 
 
245
 
  ziprecent h:/myperl -e pl pm -d 365
246
 
 
247
 
  ziprecent h:/myperl -q 
248
 
 
249
 
  ziprecent h:/myperl h:/temp/zip/file1.zip 
250
 
 
251
 
 
252
 
=head1 DESCRIPTION
253
 
 
254
 
=over 4
255
 
 
256
 
This script helps to collect recently modified files in a source directory 
257
 
into a zip file (new or existing).
258
 
 
259
 
It uses Archive::Zip.
260
 
 
261
 
=item C<  ziprecent h:/myperl  >
262
 
 
263
 
Lists and zips all files more recent than 1 day (24 hours)
264
 
in directory h:/myperl and it's subdirectories, 
265
 
and places the zip file into default zip directory.
266
 
The generated zip file name is based on local time (e.g. 20001208-231237.zip).
267
 
 
268
 
 
269
 
=item C<  ziprecent h:/myperl -e pl pm -d 365  >
270
 
 
271
 
Zips only .pl and .pm files more recent than one year.
272
 
 
273
 
 
274
 
=item C<  ziprecent h:/myperl -msvc  >
275
 
 
276
 
Zips source files found in a typical MSVC project.
277
 
 
278
 
 
279
 
=item C<  ziprecent h:/myperl -q  > 
280
 
 
281
 
Lists files that should be zipped.
282
 
 
283
 
 
284
 
=item C<  ziprecent h:/myperl h:/temp/zip/file1.zip  > 
285
 
 
286
 
Updates file named h:/temp/zip/file1.zip 
287
 
(overwrites an existing file if writable).
288
 
 
289
 
 
290
 
=item C<  ziprecent -h  > 
291
 
 
292
 
Prints the help text and exits.
293
 
 
294
 
 ziprecent.pl <dir> -d <days> [-e <ext> ...]> [-h] [-msvc] [-q] [<zippath>]
295
 
 Zips files in source directory and its subdirectories
296
 
 whose file extension is in specified extensions (default: any extension).
297
 
    -d <days>       max age (days) for files to be zipped (default: 1 day)
298
 
    <dir>           source directory
299
 
    -e <ext>        one or more space-separated extensions
300
 
    -h              print help text and exit
301
 
    -msvc           may be given instead of -e and will zip all msvc source files  
302
 
    -q              query only (list files but don't zip)
303
 
    <zippath>.zip   path to zipfile to be created (or updated if it exists)
304
 
 
305
 
=back
306
 
 
307
 
 
308
 
=head1 BUGS
309
 
 
310
 
Tested only on Win2k.
311
 
 
312
 
Does not handle filenames without extension.
313
 
 
314
 
Does not accept more than one source directory (workaround: invoke separately 
315
 
for each directory, specifying the same zip file).
316
 
 
317
 
 
318
 
=head1 AUTHOR
319
 
 
320
 
Rudi Farkas rudif@lecroy.com rudif@bluemail.ch
321
 
 
322
 
=head1 SEE ALSO
323
 
 
324
 
perl ;-)
325
 
 
326
 
=cut
327
 
 
328
 
 
329