Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

Creating Neat CVS snapshots...

by cyberconte (Scribe)
on Dec 20, 2002 at 14:48 UTC ( [id://221444]=perlcraft: print w/replies, xml ) Need Help??

   1: Just thought i would share this... i created it after
   2: finding not finding anything with this functionality
   3: (a while ago).  It was made for my personal needs 
   4: initially, and was doctored up a few weeks later to
   5: be somewhat customizable.  Its about a year old.
   6: 
   7: I have a cronjob that runs it every day:
   8: 0 1 * * * /home/conteb/cvs/snapshot.pl phynd /var/www/snapshots /var/cvs >> /var/www/snapshots/snapshots.log 2>&1
   9: 
  10: Sample can be found at http://www.phynd.net/snapshots/
  11: 
  12: #!/usr/bin/perl
  13: #
  14: # Create nightly cvs snapshots of project in a 
  15: # repository, only saving the snapshot if the module 
  16: # has changed.
  17: # 
  18: # TODO: Error checking is by no means complete.
  19: #
  20: use Date::Manip;
  21: 
  22: use strict;
  23: use warnings;
  24: 
  25: sub printHelp; # print basic help screen
  26: 
  27: my $tempdir = '/tmp/';
  28: my $maxdayspast = 90; # will only check 90 days in the past before recording.
  29: 
  30: # Can take 1 - 3 args - project name and dir to put resulting snapshot
  31: my $project = shift(@ARGV) or printHelp;
  32: my $dest = shift(@ARGV) or printHelp;
  33: my $server = shift(@ARGV) or printHelp;
  34: 
  35: 
  36: # test $tempdir, $dest for access and writabilty
  37: die "Error: No access to /tmp or /tmp not a dir\n"
  38:     unless (-w $tempdir && -d $tempdir);
  39: die "Error: No access to $dest, $dest not a dir, or $dest doen't exist\n"
  40:     unless (-d $dest && -w $dest);
  41: 
  42: 
  43: # First checkout the needed cvs directory
  44: chdir $tempdir;
  45: if (defined $server) {
  46:     (`cvs -d $server co -P $project 2>&1`=~/cannot find module/) and 
  47: 	die "Error: Invalid project specified - could not find module\n";
  48: }
  49: 
  50: # get todays date and adjust acordingly...
  51: my $date=$1 if &ParseDate('today')=~/(\d{8})/;
  52: 
  53: # create tarball
  54: `tar czf $dest/$project-$date.tar.gz $project`;
  55: 
  56: # Now, find the last tarball
  57: my $prev=1;
  58: my $filename;
  59: do {
  60:     &DateCalc($date, "-".$prev." days")=~/(\d{8})/;
  61:     $filename=$dest.'/'.$project."-".$1.".tar.gz";
  62:     $prev++;
  63: } while ((!(-e $filename))&&($prev < $maxdayspast));
  64: 
  65: # for some reason, compressed tarballs of identical trees checked out
  66: # at different times create slightly different sized tarballs (on my 
  67: # machine, anyway, using reiserfs).  I'm not about to step out of my 
  68: # league and try to explain it - but it means we have to untar the package
  69: # and run a diff on the two trees to see if there is a difference.
  70: if ($prev == $maxdayspast) {
  71:     print "Did not find any snapshots within $maxdayspast days, recording new..."; }
  72: else {
  73:     `mv $project $project.new`;
  74:     `tar xzvf $filename `;
  75:     if (`diff -Naur $project $project.new`) {
  76: 	print "Changes detected, recording snapshot...";
  77:     }
  78:     else {
  79: 	`rm $dest/$project-$date.tar.gz`; # dont save if nothing changed
  80:     }
  81:     `rm -r $project.new`;
  82: }
  83: 
  84: # remove project directories
  85: `rm -r $project`;
  86: print "Done ($date)\n";
  87: exit;
  88: 
  89: sub printHelp {
  90:     print "Usage: snapshot.pl project destination_dir server\n";
  91:     print "  project           name of project to check out of cvs\n";
  92:     print "  destination_dir   where to put the snapshot\n";
  93:     print "  server            server to connect to.  used as cvs -d server...\n";
  94:     exit;
  95: }

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlcraft [id://221444]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others admiring the Monastery: (3)
As of 2024-03-19 02:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found