Category: Utilities
Author/Contact Info draconis
Description: The nifty little routine runs on either a UNIX or Linux platform and is meant to archive a file or files. Archiving here is simply creating a copy with a specific date time stamp as a file extension. You can optionally perform this on a group of files using regular expressions. You can also compress the archive by using the -c switch (uses gzip). This was very handy when needing to store copies of code or any file for historical reasons (maybe even to roll back from later). I will be posting the companion program restfile.pl which does the reverse at a later point in time. 
#!/usr/local/bin/perl
######################################################################
+#
#     Program:  arcfile.pl
# Description:  Create an achive of a file with a new extension.
#      Author:  Peter Marek
#        Date:  October 23, 2000
######################################################################
+#


if($ARGV[0] eq '' || $ARGV[0] eq '-h'){
    print "\nUsage: arcfile.pl [-c] filespec\n\n";
    print "\t[-c]\t\tCompress the archive\n";
    print "\tfilespec\tAny UNIX regular typeglob expression\n\n";
    exit 0;
}


# CREATE A HASH FOR MONTH NAME TO NUMERICAL EQUIVALENT
%xref=('Jan' => '01',
       'Feb' => '02',
       'Mar' => '03',
       'Apr' => '04',
       'May' => '05',
       'Jun' => '06',
       'Jul' => '07',
       'Aug' => '08',
       'Sep' => '09',
       'Oct' => '10',
       'Nov' => '11',
       'Dec' => '12');

# RIP APART THE SYSTEM DATE COMPONENTS
$_=localtime;
my ($month,$date,$year,$time)=(split)[1,2,4,3];

# IF WE HAVE A 1 DIGIT DATE ZERO PAD TO THE LEFT
if (length($date) eq 1) {$date='0' . $date;}

# RIP APART THE SYSTEM TIME COMPONENTS
$_=$time;
my ($hours,$min,$sec)=(split/:/);

# BUILD THE NEW FILE EXTENSION
my $ext="$year$xref{$month}$date$hours$min";

# SPIN THROUGH THE EXPANDED LIST OF FILES
foreach (@ARGV) {

    if($_ eq '-c'){next;}

    $arcfile=$_ . '.' . $ext;


    # OPEN THE ORIGINAL FILE
    die "Can't open file for reading!\n" unless open(INFILE,"<$_");
    # OPEN THE NEW FILE
    die "Can't open file for writing!\n" unless open(OUTFILE,">$arcfil
+e");

    while (<INFILE>){

        print OUTFILE;

    }

    # CLOSE THE ORIGINAL
    close INFILE;
    # CLOSE THE NEW FILE
    close OUTFILE;
    
    if($ARGV[0] eq '-c'){
        @cmd=qw{gzip -9};
        push @cmd,$arcfile;
        system(@cmd);
        warn "Could not change the permissions for $_.$ext.gz to read-
+only"
            unless chmod 0444,"$arcfile.gz";
        next;
    }
    
    # SET THE FILE PERMISSIONS OF THE ARC FILE TO READ-ONLY
    warn "Could not change the permissions for $_.$ext to read-only"
      unless chmod 0444, $arcfile;
}

#__________ POD __________

=head1 NAME

arcfile.pl - Archive files using date/time file extension

=head1 SYNOPSIS

arcfile.pl [-c] filespec

=item c

This optional switch allows for compression of the archive.

=item filespec

The filespec can be either a single file name or a UNIX typeglob regul
+ar expression that r
esolves to a set of files.

=head1 DESCRIPTION

arcfile.pl will create a copy of the files represented by filespec wit
+h an extension of YY
YYMMDDhhmm (filespec.YYMMDDhhmm)  All files created use the same file 
+extension regardless
 of how long the individual archive takes to process.  THe permissions
+ of the archived fil
es are then set to read-only (0444).

=item
YYYY = Current Year

=item
MM = Current Month

=item
DD = Current Day of Month

=item
hh = Current Hour

=item
mm = Current Minute


=head1 AUTHOR

Peter Marek, October 23 2000


=end
Replies are listed 'Best First'.
Re: archive UNIX files
by Corion (Patriarch) on Apr 30, 2003 at 14:26 UTC

    Looking at your code, I see some things that can be simplified immensely :

    Pulling apart the string from localtime() and then piecing it together again is ingenious, but the POSIX module has a really useful routine, strftime(), which formats times very nicely. Other modules, like the DateTime module, also provide this.
    You can replace the top part of your script by the following lines : 

      use POSIX;
  my $ext = strftime "%Y%m%d%H%M", localtime;

    [download]

    Your parameter parsing will allow for weird things happening if there is a file -c in your directory.
    If you want to have nicer command line handling, turn to GetOpt::Long, at least I would recommend adding a second switch -- to turn off command line parameter processing and moving the command line processing out of the loop : 

      my $compress_files;
  if ($ARGV[0] eq '-c') {
    $compress_files = shift @ARGV;
  };

  foreach (@ARGV) {
    ...
  };

    [download]

    The program does not give a reason why exactly it failed when opening / creating a file fails. This is bad.

        # OPEN THE ORIGINAL FILE
    die "Can't open file for reading : $!\n" 
      unless open(INFILE,"<$_");
    # OPEN THE NEW FILE
    die "Can't open file for writing : $!\n" 
      unless open(OUTFILE,">$arcfile");

    [download]

    The program won't work on Windows as you are not setting binmode and thus, the files to be copied will be truncated at the first ^Z byte encountered in the file. This is not truly much of a concern for you, as you intend your script to be running under Unix, but knowing and caring about binmode dosen't hurt :

        # OPEN THE ORIGINAL FILE
    die "Can't open file for reading : $!\n" 
      unless open(INFILE,"<$_");
    binmode INFILE;

    # OPEN THE NEW FILE
    die "Can't open file for writing : $!\n" 
      unless open(OUTFILE,">$arcfile");
    binmode OUTFILE;

    [download]

    Of course, you could also use File::Copy or File::NCopy to copy the files, alleviating you from caring about these details.

    Documentation in the POD is cool. Take a look at Pod::Usage to reuse that documentation for your help text.

    perl -MHTTP::Daemon -MHTTP::Response -MLWP::Simple -e ' ;    # The  
$d = new HTTP::Daemon and fork and getprint $d->url and exit;#spider
($c = $d->accept())->get_request(); $c->send_response( new   #in the
HTTP::Response(200,$_,$_,qq(Just another Perl hacker\n))); ' #  web

    [download]
[reply]
[d/l]
[select]

Back to Code Catacombs