DXR is a code search and navigation tool aimed at making sense of large projects. It supports full-text and regex searches as well as structural queries.

Untracked file

Line Code
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296
#!/usr/bin/env perl
#
# fast-update.pl [-h hours] [-m module] [-r branch]
#
# This command, fast-update.pl, does a (fast) cvs update of the current 
# directory. It is fast because the cvs up command is only run on those 
# directories / sub-directories where changes have occured since the 
# last fast-update.
#
# The last update time is stored in a ".fast-update" file in the current
# directory. Thus one can choose to only fast-update a branch of the tree 
# and then fast-update the whole tree later.
#
# The first time this command is run in a directory the last cvs update
# time is assumed to be the timestamp of the CVS/Entries file.
#
use Getopt::Long;

my $filename = ".fast-update";
my $start_time = time();

my $branch;
my $module="SeaMonkeyAll";
my $maxdirs=5;
my $rootdir = "";
my $hours = 0;
my $dir = '';

&GetOptions('d=s' => \$dir, 'h=s' => \$hours, 'm=s' => \$module, 'r=s' => \$branch);

#print "dir = ($dir), hours = ($hours), module = ($module), branch = ($branch)\n";
if ($dir) {
  chdir '..';
  chdir $dir;
}

if (!$hours) {
  $hours = get_hours_since_last_update();
}
if (!$hours) {
  $hours = 24;
}


# pull out the current directory
# if there is no such file, this will all just fail, which is ok
open REPOSITORY, "<CVS/Repository";
$rootdir = <REPOSITORY>;
chop $rootdir;
close REPOSITORY;

# try to guess the current branch by looking at all the
# files in CVS/Entries
if (!$branch) {
  my $foundbranch =0;
  
  open ENTRIES, "<CVS/Entries";
  while (<ENTRIES>) {
    chop;
    @entry = split(/\//);
    my ($type, $file, $ver, $date, $unknown, $tag) = @entry;
    
    # the tag usually starts with "T"
    $thisbranch = substr($tag, 1);
    
    # look for more than one branch
    if ($type eq "") {
      
      if ($foundbranch and ($lastbranch ne $thisbranch)) {
        die "Multiple branches in this directory, cannot determine branch\n";
      }
      $foundbranch = 1;
      $lastbranch = $thisbranch;
    }
    
  }
  
  $branch = $lastbranch if ($foundbranch);

  close ENTRIES;
}

# check for a static Tag
# (at least that is what I think this does)
# (bonsai does not report changes when the Tag starts with 'N')
# (I do not really understand all this)
if ($branch) {
  open TAG, "<CVS/Tag";
  my $line = <TAG>;
  if ($line =~ /^N/) { 
    print "static tag, ignore branch\n";
    $branch = '';
  }
  close TAG;
}


my $url = "http://bonsai.mozilla.org/cvsquery.cgi?module=${module}&branch=${branch}&branchtype=match&sortby=File&date=hours&hours=${hours}&cvsroot=%2Fcvsroot";

my $esc_dir = escape($dir);
if ($dir) {
  $url .= "&dir=$esc_dir";
}

print "Contacting bonsai for updates to ${module} ";
print "on the ${branch} branch " if ($branch);
print "in the last ${hours} hours ";
print "within the $rootdir directory..\n" if ($rootdir);
#print "url = $url\n";

# first try wget, then try lynx, then try curl

# this is my lame way of checking if a command succeeded AND getting
# output from it. I'd love a better way. -alecf@netscape.com
my $have_checkins = 0;
open CHECKINS,"wget --quiet --output-document=- \"$url\"|" or
  die "Error opening wget: $!\n";

$header = <CHECKINS> and $have_checkins=1;

if (!$have_checkins) {

  open CHECKINS, "lynx -source '$url'|" or die "Error opening lynx: $!\n";

  $header = <CHECKINS> and $have_checkins = 1;
}

if (!$have_checkins) {

  open CHECKINS, "curl -s '$url'|" or die "Error opening curl $!\n";

  $header = <CHECKINS> and $have_checkins = 1;
}

$have_checkins || die "Couldn't get checkins\n";

open REALOUT, ">.fast-update.bonsai.html" || die "argh $!\n";
print "Processing checkins...";
while (<CHECKINS>) {
  print REALOUT $_;
  
  if (/js_file_menu\((.*),\s*\'(.*)\'\s*,\s*(.*),\s*(.*),\s*(.*),\s*(.*)\)/) {
    my ($repos, $dir, $file, $rev, $branch, $event) =
      ($1, $2, $3, $4, $5, $6);
    push @dirlist, $dir;
  }
}

print "done.\n";
close REALOUT;
unlink '.fast-update.bonsai.html';

my $lastdir = "";
my @uniquedirs;

foreach $dir (sort @dirlist) {
  next if ($lastdir eq $dir);

  my $strippeddir = "";
  $lastdir = $dir;

  # now strip out $rootdir
  if ($rootdir) {

    # only deal with directories that start with $rootdir
    if (substr($dir, 0, (length $rootdir)) eq $rootdir) {

      if ($dir eq $rootdir) {
        $strippeddir = ".";
      } else {
        $strippeddir = substr($dir,(length $rootdir) + 1 );
      }

    }
  } else {
    $strippeddir = $dir;
  }

  if ($strippeddir) {
    push @uniquedirs, $strippeddir;
  }
}

my $status = 0;
if (scalar(@uniquedirs)) {
  print "Updating tree..($#uniquedirs directories)\n";
  my $i=0;
  my $dirlist = "";
  foreach $dir (sort @uniquedirs) {
    if (!-d $dir) {
      cvs_up_parent($dir);
    }
    $dirlist .= "\"$dir\" ";
    $i++;
    if ($i == 5) {
      $status |= spawn("cvs -z3 -q -f up -l -d $dirlist\n");
      $dirlist = "";
      $i=0;
    }
  }
  if ($i) {
    $status |= spawn("cvs -z3 -q -f up -l -d $dirlist\n");
  }
}
else {
  print "No directories to update.\n";
}

close CHECKINS;
if ($status == 0) {
  set_last_update_time($filename, $start_time);
  print "successfully updated $module/$dir\n";
}
else {
  print "error while updating $module/$dir\n";
}

exit $status;

sub cvs_up_parent {
  my ($dir) = @_;
  my $pdir = $dir;
  $pdir =~ s|/*[^/]*/*$||;
  #$pdir =~ s|/$||;
  #$pdir =~ s|[^/]*$||;
  #$pdir =~ s|/$||;
  if (!$pdir) {
    $pdir = '.';
  }
  if (!-d $pdir) {
    cvs_up_parent($pdir);
  }
  $status |= system "cvs -z3 -q -f up -d -l $pdir\n";
}

sub get_hours_since_last_update {
  # get the last time this command was run
  my $last_time = get_last_update_time($filename);
  if (!defined($last_time)) {
    #
    # This must be the first use of fast-update.pl so use the timestamp 
    # of a file that: 
    #  1) is managed by cvs
    #  2) the user should not be tampering with
    #  3) that gets updated fairly frequently.
    #
    $last_time = (stat "CVS/Entries")[9];
    if (defined($last_time)) {
      $last_time -= 3600*24; # for safety go back a bit
      print "use fallback time of ".localtime($last_time)."\n";
    }
  }
  if(!defined($last_time)) {
    print "last_time not defined\n";
  }

  # figure the hours (rounded up) since the last fast-update
  my $hours = int(($start_time - $last_time + 3600)/3600);
  print "last updated $hours hour(s) ago at ".localtime($last_time)."\n";
  return $hours;
}

# returns time of last update if known
sub get_last_update_time {
  my ($filename) = @_;
  if (!-r $filename) {
    return undef;
  }
  open FILE, "<$filename";
  my $line = <FILE>;
  if (!defined(line)) {
    return undef;
  }
#  print "line = $line";
  $line =~ /^(\d+):/;
  return $1;
}

sub set_last_update_time {
  my ($filename, $time) = @_;
  my $time_str = localtime($time);
  open FILE, ">$filename";
  print FILE "$time: last fast-update.pl at ".localtime($time)."\n";
}

# URL-encode data
sub escape {
  my ($toencode) = @_;
  $toencode=~s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",ord($1))/eg;
  return $toencode;
}

sub spawn {
  my ($procname) = @_;
  return system "$procname";
}