lists.def blocks http mboxes, unused otherwise
[mharc.git] / bin / compress-files
1 #!/usr/bin/perl
2 ##--------------------------------------------------------------------------##
3 ##  File:
4 ##      $Id: compress-files,v 1.8 2002/09/15 03:33:08 ehood Exp $
5 ##  Description:
6 ##      Gzip files matching a specified pattern and older then specified
7 ##      time period.
8 ##--------------------------------------------------------------------------##
9 ##  Copyright (C) 2001-2002     Earl Hood <earl@earlhood.com>
10 ##
11 ##  This program is free software; you can redistribute it and/or modify
12 ##  it under the terms of the GNU General Public License as published by
13 ##  the Free Software Foundation; either version 2 of the License, or
14 ##  (at your option) any later version.
15 ##  
16 ##  This program is distributed in the hope that it will be useful,
17 ##  but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
19 ##  GNU General Public License for more details.
20 ##  
21 ##  You should have received a copy of the GNU General Public License
22 ##  along with this program; if not, write to the Free Software
23 ##  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
24 ##  02111-1307, USA
25 ##--------------------------------------------------------------------------##
26
27 package MHArc::compress_files;
28
29 ##--------------------------------------------------------------------------##
30 # <boot-strap>
31 BEGIN { die qq/CGI use FORBIDDEN!\n/ if (defined($ENV{'GATEWAY_INTERFACE'})); }
32 my $Dir; BEGIN { $Dir = `dirname $0`; chomp $Dir; }
33 use lib "$Dir/../lib";  # Add relative lib to search path
34 # </boot-strap>
35 ##--------------------------------------------------------------------------##
36
37
38 use Getopt::Long;
39 use File::Find;
40 use MHArc::Util qw( usage );
41
42 # Amount of seconds in a year
43 my $year_secs = 31536000;
44
45 my %opt = ( );
46 my $clstatus = GetOptions(\%opt,
47     "debug!",
48     "pattern=s",
49     "mbox-mode!",
50     "mtime=i",
51     "n!",
52
53     'help',
54     'man'
55 );
56 usage(0) unless $clstatus;
57 usage(1) if $opt{'help'};
58 usage(2) if $opt{'man'};
59
60 my $debug = $opt{'debug'};
61 my $mbox_mode = $opt{'mbox-mode'};
62 my $pattern = $opt{'pattern'} || ($mbox_mode ? '^\d+(?:-\d+)?$' : '^[^.]');
63 my $compress_time = $opt{'mtime'} || 31;
64 my $noact = $opt{'n'};
65
66 my $time = time;
67 $compress_time *= 24 * 3600; # convert to seconds
68
69 sub wanted {
70   if (-d $_ ||
71       /\.gz$/i ||
72       !/$pattern/o) {
73     print qq/Ignoring "$File::Find::name"\n/  if $debug;
74     return;
75   }
76
77   my $mtime = (stat($_))[9];
78   print qq/$File::Find::name (/, scalar(localtime($mtime)), qq/)\n/  if $debug;
79
80   if ($mbox_mode && (/^\d+$/)) {
81     if ($time-$mtime < ($compress_time+$year_secs)) {
82       print qq/Skipping "$File::Find::name"\n/  if $debug;
83       return;
84     }
85   } elsif ($time-$mtime < $compress_time) {
86     print qq/Skipping "$File::Find::name"\n/  if $debug;
87     return;
88   }
89
90   print qq/Compressing "$File::Find::name"\n/  if $debug;
91   if ($noact) {
92     print qq/gzip $File::Find::name\n/;
93   } else {
94     if (system('gzip', $_)) {
95       die qq/gzip $File::Find::name failed: $?\n/;
96     }
97   }
98 }
99
100 if ($#ARGV < 0) {
101   die qq/No directories, or files, specified\n/;
102 }
103 find(\&wanted, @ARGV);
104
105 ##---------------------------------------------------------------------------##
106 __END__
107
108 =head1 NAME
109
110 compress-files - Gzip files not modified over a given period of time
111
112 =head1 SYNOPSIS
113
114   compress-files [options] <directory> [<directory> ...]
115
116 =head1 DESCRIPTION
117
118 This program is part of mharc.  This program is used to compress
119 files that have not been modified over a given period of time.
120
121 =head1 OPTIONS
122
123 =over
124
125 =item C<-debug>
126
127 Print out alot of status information.
128
129 =item C<-help>
130
131 Print out usage information.
132
133 =item C<-n>
134
135 Print the commands that would be executed, but do not execute them.
136
137 =item C<-mbox-mode>
138
139 A hack for compress mailbox files.  When this option is specified,
140 the default C<-pattern> is C<^\d+(?:-\d+)?$>.  This pattern basically
141 searches for files with names in YYYY and YYYY-MM format.  Files with
142 names in YYYY format are handled slightly different.  When checking
143 if the file can be compressed, a year is added to C<-mtime>.
144
145 =item C<-man>
146
147 Print out manpage.
148
149 =item C<-mtime> I<days>
150
151 Modification time in days a file has to be older than to get compressed.
152 If this option is not specified, 31 days is used.
153
154 =item C<-pattern> I<regex>
155
156 Perl regular expression that represents files that should be
157 checked.  If not specifed, the following regex is used:
158 C<^[^.]>.
159
160 =back
161
162 =head1 SEE ALSO
163
164 L<compress-mboxes|compress-mboxes>
165
166 =head1 VERSION
167
168 $Id: compress-files,v 1.8 2002/09/15 03:33:08 ehood Exp $
169
170 =head1 AUTHOR
171
172 Earl Hood, earl@earlhood.com
173
174 This program is part of the mharc archiving system and comes with
175 ABSOLUTELY NO WARRANTY and may be copied only under the terms of
176 the GNU General Public License, which may be found in the mharc
177 distribution.
178
179 =cut
180