config/fast-update.pl

   1 #!/usr/bin/env perl
   2 #
   3 # fast-update.pl [-h hours] [-m module] [-r branch]
   4 #
   5 # This command, fast-update.pl, does a (fast) cvs update of the current
   6 # directory. It is fast because the cvs up command is only run on those
   7 # directories / sub-directories where changes have occurred since the
   8 # last fast-update.
   9 #
  10 # The last update time is stored in a ".fast-update" file in the current
  11 # directory. Thus one can choose to only fast-update a branch of the tree
  12 # and then fast-update the whole tree later.
  13 #
  14 # The first time this command is run in a directory the last cvs update
  15 # time is assumed to be the timestamp of the CVS/Entries file.
  16 #
  17 use Getopt::Long;
  18
  19 my $filename = ".fast-update";
  20 my $start_time = time();
  21
  22 my $branch;
  23 my $module="SeaMonkeyAll";
  24 my $maxdirs=5;
  25 my $rootdir = "";
  26 my $hours = 0;
  27 my @dirs = ();
  28 my $dirlocal = 0;
  29
  30 &GetOptions('d=s@' => \@dirs, 'h=s' => \$hours, 'm=s' => \$module, 'r=s' => \$branch, 'l' => \$dirlocal);
  31
  32 #print "dirs = (@dirs), hours = ($hours), module = ($module), branch = ($branch), dirlocal = ($dirlocal)\n";
  33 if (scalar(@dirs) > 0) {
  34   # put .fast-update in the first directory listed
  35   $filename = "$dirs[0]/$filename";
  36   $filename =~ s#mozilla/*##;
  37 }
  38
  39 if (!$hours) {
  40   $hours = get_hours_since_last_update();
  41 }
  42 if (!$hours) {
  43   $hours = 24;
  44 }
  45
  46
  47 # pull out the current directory
  48 # if there is no such file, this will all just fail, which is ok
  49 open REPOSITORY, "<CVS/Repository";
  50 $rootdir = <REPOSITORY>;
  51 $rootdir =~ tr/\r\n//d; # Remove newlines
  52 close REPOSITORY;
  53
  54 # try to guess the current branch by looking at all the
  55 # files in CVS/Entries
  56 if (!$branch) {
  57   my $foundbranch =0;
  58
  59   open ENTRIES, "<CVS/Entries";
  60   while (<ENTRIES>) {
  61     chop;
  62     @entry = split(/\//);
  63     my ($type, $file, $ver, $date, $unknown, $tag) = @entry;
  64
  65     # the tag usually starts with "T"
  66     $thisbranch = substr($tag, 1);
  67
  68     # look for more than one branch
  69     if ($type eq "") {
  70
  71       if ($foundbranch and ($lastbranch ne $thisbranch)) {
  72         die "Multiple branches in this directory, cannot determine branch\n";
  73       }
  74       $foundbranch = 1;
  75       $lastbranch = $thisbranch;
  76     }
  77
  78   }
  79
  80   $branch = $lastbranch if ($foundbranch);
  81
  82   close ENTRIES;
  83 }
  84
  85 # check for a static Tag
  86 # (at least that is what I think this does)
  87 # (bonsai does not report changes when the Tag starts with 'N')
  88 # (I do not really understand all this)
  89 if ($branch) {
  90   open TAG, "<CVS/Tag";
  91   my $line = <TAG>;
  92   if ($line =~ /^N/) {
  93     print "static tag, ignore branch\n";
  94     $branch = '';
  95   }
  96   close TAG;
  97 }
  98
  99
 100 my $url = "http://bonsai.mozilla.org/cvsquery.cgi?module=${module}&branch=${branch}&branchtype=match&sortby=File&date=hours&hours=${hours}&cvsroot=%2Fcvsroot";
 101
 102 my $dir_string = "";
 103 if (scalar(@dirs) > 0) {
 104   $dir_string = join(' ', @dirs);
 105   my $esc_dir = escape($dir_string);
 106   $url .= "&dir=$esc_dir";
 107 }
 108 if ($dirlocal) {
 109   $url .= "&dirtype=local";
 110 }
 111
 112 print "Contacting bonsai for updates to ${module} ";
 113 print "on the ${branch} branch " if ($branch);
 114 print "in the last ${hours} hours ";
 115 print "within the $rootdir directory..\n" if ($rootdir);
 116 print "\n" unless ($rootdir);
 117 #print "url = $url\n";
 118
 119 # first try wget, then try lynx, then try curl
 120
 121 # this is my lame way of checking if a command succeeded AND getting
 122 # output from it. I'd love a better way. -alecf@netscape.com
 123 my $have_checkins = 0;
 124 open CHECKINS,"wget --quiet --output-document=- \"$url\"|" or
 125   die "Error opening wget: $!\n";
 126
 127 $header = <CHECKINS> and $have_checkins=1;
 128
 129 if (!$have_checkins) {
 130
 131   open CHECKINS, "lynx -source '$url'|" or die "Error opening lynx: $!\n";
 132
 133   $header = <CHECKINS> and $have_checkins = 1;
 134 }
 135
 136 if (!$have_checkins) {
 137
 138   open CHECKINS, "curl -s '$url'|" or die "Error opening curl $!\n";
 139
 140   $header = <CHECKINS> and $have_checkins = 1;
 141 }
 142
 143 $have_checkins || die "Couldn't get checkins\n";
 144
 145 open REALOUT, ">.fast-update.bonsai.html" || die "argh $!\n";
 146 print "Processing checkins...";
 147 while (<CHECKINS>) {
 148   print REALOUT $_;
 149
 150   if (/js_file_menu\((.*),\s*\'(.*)\'\s*,\s*(.*),\s*(.*),\s*(.*),\s*(.*)\)/) {
 151     my ($repos, $dir, $file, $rev, $branch, $event) =
 152       ($1, $2, $3, $4, $5, $6);
 153     $dir =~ s/\/Attic$//;
 154     push @dirlist, $dir;
 155   }
 156 }
 157
 158 print "done.\n";
 159 close REALOUT;
 160 unlink '.fast-update.bonsai.html';
 161
 162 my $lastdir = "";
 163 my @uniquedirs;
 164
 165 foreach $dir (sort @dirlist) {
 166   next if ($lastdir eq $dir);
 167
 168   my $strippeddir = "";
 169   $lastdir = $dir;
 170
 171   # now strip out $rootdir
 172   if ($rootdir) {
 173
 174     # only deal with directories that start with $rootdir
 175     if (substr($dir, 0, (length $rootdir)) eq $rootdir) {
 176
 177       if ($dir eq $rootdir) {
 178         $strippeddir = ".";
 179       } else {
 180         $strippeddir = substr($dir,(length $rootdir) + 1 );
 181       }
 182
 183     }
 184   } else {
 185     $strippeddir = $dir;
 186   }
 187
 188   if ($strippeddir) {
 189     push @uniquedirs, $strippeddir;
 190   }
 191 }
 192
 193 my $status = 0;
 194 if (scalar(@uniquedirs)) {
 195   print "Updating tree... (" . scalar(@uniquedirs) . " directories)\n";
 196   my $i=0;
 197   my $dirlist = "";
 198   foreach $dir (sort @uniquedirs) {
 199     if (!-d $dir) {
 200       cvs_up_parent($dir);
 201     }
 202     $dirlist .= "\"$dir\" ";
 203     $i++;
 204     if ($i == 5) {
 205       $status |= spawn("cvs -z3 -q -f up -l -d $dirlist\n");
 206       $dirlist = "";
 207       $i=0;
 208     }
 209   }
 210   if ($i) {
 211     $status |= spawn("cvs -z3 -q -f up -l -d $dirlist\n");
 212   }
 213 }
 214 else {
 215   print "No directories to update.\n";
 216 }
 217
 218 close CHECKINS;
 219 if ($status == 0) {
 220   set_last_update_time($filename, $start_time);
 221   print "successfully updated ";
 222 }
 223 else {
 224   print "error while updating ";
 225 }
 226 if ($module ne "all") {
 227   print "$module/";
 228 }
 229 if (scalar(@dirs) > 0) {
 230   print $dir_string;
 231 }
 232 print "\n";
 233
 234 exit $status;
 235
 236 sub cvs_up_parent {
 237   my ($dir) = @_;
 238   my $pdir = $dir;
 239   $pdir =~ s|/*[^/]*/*$||;
 240   #$pdir =~ s|/$||;
 241   #$pdir =~ s|[^/]*$||;
 242   #$pdir =~ s|/$||;
 243   if (!$pdir) {
 244     $pdir = '.';
 245   }
 246   if (!-d $pdir) {
 247     cvs_up_parent($pdir);
 248   }
 249   $status |= system "cvs -z3 -q -f up -d -l $pdir\n";
 250 }
 251
 252 sub get_hours_since_last_update {
 253   # get the last time this command was run
 254   my $last_time = get_last_update_time($filename);
 255   if (!defined($last_time)) {
 256     #
 257     # This must be the first use of fast-update.pl so use the timestamp
 258     # of a file that:
 259     #  1) is managed by cvs
 260     #  2) the user should not be tampering with
 261     #  3) that gets updated fairly frequently.
 262     #
 263     $last_time = (stat "CVS/Entries")[9];
 264     if (defined($last_time)) {
 265       $last_time -= 3600*24; # for safety go back a bit
 266       print "use fallback time of ".localtime($last_time)."\n";
 267     }
 268   }
 269   if(!defined($last_time)) {
 270     print "last_time not defined\n";
 271   }
 272
 273   # figure the hours (rounded up) since the last fast-update
 274   my $hours = int(($start_time - $last_time + 3600)/3600);
 275   print "last updated $hours hour(s) ago at ".localtime($last_time)."\n";
 276   return $hours;
 277 }
 278
 279 # returns time of last update if known
 280 sub get_last_update_time {
 281   my ($filename) = @_;
 282   if (!-r $filename) {
 283     return undef;
 284   }
 285   open FILE, "<$filename";
 286   my $line = <FILE>;
 287   if (!defined(line)) {
 288     return undef;
 289   }
 290 #  print "line = $line";
 291   $line =~ /^(\d+):/;
 292   return $1;
 293 }
 294
 295 sub set_last_update_time {
 296   my ($filename, $time) = @_;
 297   my $time_str = localtime($time);
 298   open FILE, ">$filename";
 299   print FILE "$time: last fast-update.pl at ".localtime($time)."\n";
 300 }
 301
 302 # URL-encode data
 303 sub escape {
 304   my ($toencode) = @_;
 305   $toencode=~s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",ord($1))/eg;
 306   return $toencode;
 307 }
 308
 309 sub spawn {
 310   my ($procname) = @_;
 311   return system "$procname";
 312 }