Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl: the Markov chain saw
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
require v5.6; use strict; use warnings; use File::Spec; use File::Path; use File::Copy; use File::Find; use Getopt::Long qw (:config bundling); our $VERSION= v1.0.3; =head AUTHOR John M. Dlugosz - john@dlugosz.com =head ABSTRACT This is a Perl program to perform daily backups of interesting "work" +files in an intelligent manner. See http://www.dlugosz.com/tools/index.html +#work_backup for more information and the latest version. =head HISTORY v1.0.1 - quick fix to put fatal error messages into LOG. v1.0.2 - major bug fix! Got comparison backwards and didn't copy chang +ed files, only new files. - deal with read-only files by removing the read-only bit on the dest. + Uses chmod for portability, but abstracted for easy customization if needed. - turn on WIDE_SYSTEM_CALLS. It doesn't break anything (e.g. File::Fi +nd module) and does now copy files with names outside the common OEM/ANSI code pages. - run under ActiveState Perl 623, Perl 6.5.1. - add filename skip rules for Source Insight and Visual Studio interme +diate files. They generate errors when copying at night with programs still open, and we + don't need them, so filtering out will keep clutter out of the log. The rules should b +e smart enough to prevent false hits. v1.0.3 - further abstract the copy function in anticipation of future +changes, add eval block around a single file's processing. - add argument processing, with a few implemented and help screen to d +ocument plans for other options. planned for v1.1 - trap individual errors and continue with rest of fi +les. plans for future versions - encrypt destination files. =head INSTRUCTIONS Edit the values in the next section to indicate where you want the fil +es copied to and which directories you want copied. Don't include a trailing slash in +directory names! For the "locations", make a list of source directories you want copied +. The 'source' or 'docs' string is a "rule". 'norule' is also a rule that has no special proce +ssing but will copy all files. You can include "rules" to skip copying of specified files or director +ies. Edit the "skip_directory" or "skip_file" function to add your intelligence. For example, 'source' +directories don't back up the compiler output, and 'docs' directories skip MS Word's litter. The "r +ule" name is only used by these functions, so define the names and the logic to suit. The basic behavior of this program is to copy the files from your sour +ce locations to the backupdir. It will skip files based on date, only overwriting an olde +r file with a newer. =cut ########################## ### Configuration section - edit this. my $custom_message= 'Configured for JMD'; my $backupdir= '\\\\data01\\A0436084\\backup'; my @locations= ( [ source => 'D:\\dev' ], [ docs => 'D:\\My Documents' ], [ source => 'F:\\dev' ], [ docs => 'F:\\Documents' ], [ norule => 'D:\\Program Files\\util'] ); ########################### ### "rules" for skipping files. customize or extend this, if needed. # functions return true to skip, false to backup normally. ${^WIDE_SYSTEM_CALLS}= 1; # comment this out on Win9X/Me if it's not +simply ignored. sub skip_directory ($$) { my ($directory, $rule)= @_; if ($rule eq 'source') { return 1 if $directory =~ /Release/i; # dirname contains "Releas +e", includes things like "bin_Release" and "Releaseme"; return 1 if $directory =~ /Debug/i; # likewise # >>>>> add rules here. } return undef; # don't skip. } sub skip_file ($$) { my ($filename, $rule)= @_; if ($rule eq 'source') { if ($filename =~/\.(?:IAB|IMB)$/) { # all-caps KNOWN, so no i. # skip IAB and IMB files if a PR file with the same basename al +so exists. # these generate "file open" errors when Source Insight is runn +ing. (my $othername=$filename) =~ s/\....$/\.PR/; return 1 if -e $othername; # looks like Source Insight index +files. } if ($filename =~ /\.(?:ncb|opt)$/) { # all-lower known, so no i. (my $othername=$filename) =~ s/\....$/\.dsw/; # skip .NCB and .OPT if a .DSW exists. return 1 if -e $othername; # Visual Studio project files inte +rmediate junk. } # >>>>> add rules here. } elsif ($rule eq 'docs') { return 1 if $filename =~ /[\\\/]~.+\.tmp$/i; # skip filenames li +ke ~XXX.TMP; } return undef; # don't skip. } ########################### my $verbose= 0; # enable with -v my $quiet= 0; my $nolog= 0; # enable with -s my $filecount= 0; ########################### sub prep_target_file ($) # this was introduced to deal with read-only files. It is called on t +he dest filename # before the copy takes place, and may do any work needed in this situ +ation. { return unless -e $_[0]; chmod 0777, $_[0]; } ########################### sub check_backupdir { eval { mkpath ($backupdir); }; if ($@) { die "Error: cannot verify or create directory [$backupdir]\n$@\n"; } unless ($nolog) { my $logfile= File::Spec->catfile ($backupdir, "backup_log.txt"); print "logging results to [$logfile]\n" if $verbose; open LOG, ">> $logfile" or die "Cannot open file [$logfile] for w +riting.\n"; my $time= localtime(); print LOG "Started $time\n"; } } sub perform_copy ($$) { my ($sourcefile, $destfile) = @_; unless (copy ($sourcefile, $destfile)) { my $err= $!; my $err2= $^E; my $message= "ERROR COPYING FILE\n from $sourcefile\n to $destfile +\n $err\n $err2\n"; print LOG $message unless $nolog; print $message; } } sub do_backup ($$$) { my ($sourcefile, $destfile, $rule)= @_; if (-d $sourcefile) { # do the directory if (skip_directory ($sourcefile, $rule)) { $File::Find::prune= 1; # tell find to skip the contents. return; } mkpath ($destfile); } else { # is a file return if skip_file ($sourcefile, $rule); return if -e $destfile && (-M $destfile <= -M $sourcefile); # cop +y is up to date. print "==> $sourcefile\n" if $verbose; ++$filecount; prep_target_file ($destfile); perform_copy ($sourcefile, $destfile); } } sub process_location ($) { my ($rule, $source)= @{shift @_}; my $dest= $source; # change drive letter or server name to subdir $dest =~ s/^(.):/Drive $1/; $dest =~ s/^\\\\/\\/; $dest= File::Spec->catdir ($backupdir, $dest); print "Backing up [$source] to [$dest] using rule '$rule'\n" if $ver +bose; my $re= qr/^\Q$source\E/; my $sub= sub { my $sourcefile= $File::Find::name; (my $destfile= $sourcefile) =~ s/$re/$dest/; eval { do_backup ($sourcefile, $destfile, $rule); }; if ($@) { my $message= "EXCEPTION CAUGHT trying to copy from [$sourcefile +] to [$destfile].\n$@"; print LOG $message unless $nolog; print $message; } }; find ($sub, $source); print "Copied a total of $filecount files\n" if $verbose; } sub show_options { print <<"EOF"; NOTE: this is a placeholder and design docs. Options are not implemented yet. Usage: With no parameters, performs the pre-configured backup. Change th +e configuration by editing the config section of \"$0\". If filenames are given, will backup (or restore) just those named +files (directory names OK). If the named file is within the backup subd +irectory ($backupdir) then the file will be restored to the original positi +on. Otherwise it is taken as the name of a file to backup. Flags can modify this behavior. Flags are not order-dependant and mean the same thing whether before, mixed with, or after filename arguments. Flags: -restore Restores the named files. Unlike the implicit restore a +bove, the filename is the original location, not the backup location. -full Ignore dates, always copy the file. -all Ignore the skip rules and copy all files. -verbose Print messages concerning program's operation. -output=xxx Specify a different directory for restored files. -keep Rename restored files by adding '.restored' to the name. -secret Don't write to logfile. -quiet Show less output. -nowork Disable copy, used to try the options before doing it. -help Show this message. EOF exit 1; } ########################### ### "main" program GetOptions ( 'help|?|h' => \&show_options, 'verbose!' => \$verbose, 'v' => \$verbose, 'quiet!' => \$quiet, 'q' => \$quiet, 'secret!' => \$nolog, 's' => \$nolog ) || exit 1; print "work_backup utility - $custom_message\n" unless $quiet; check_backupdir(); eval { if (@ARGV) { # process named files on the command line die "filename arguments not implemented yet.\n"; } else { foreach my $item (@locations) { process_location ($item); } } my $time= localtime(); print LOG "finished $time\n" unless $nolog; print LOG "copied $filecount files\n" unless $nolog; }; if ($@) { print LOG "ABNORMAL TERMINATION: $@" unless $nolog; print $@; } print LOG "======== done =========\n" unless $nolog; close LOG unless $nolog; print "copied $filecount files\n" unless $quiet;

In reply to Work Backup by John M. Dlugosz

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others scrutinizing the Monastery: (6)
    As of 2014-08-01 23:40 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      Who would be the most fun to work for?















      Results (52 votes), past polls