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