lustre/scripts/version_tag.pl

   1 #!/usr/bin/perl
   2 # -*- Mode: perl; indent-tabs-mode: nil; cperl-indent-level: 4 -*-
   3
   4 use strict;
   5 use diagnostics;
   6 use IO::File;
   7 use Time::Local;
   8
   9 my $pristine = 1;
  10 my $kernver = "";
  11
  12 # Use the CVS tag first otherwise use the portals version
  13 sub get_tag()
  14 {
  15     my $tag;
  16     my $line;
  17
  18     my $tagfile = new IO::File;
  19     if (!$tagfile->open("lustre/CVS/Tag")) {
  20         # is there a good way to do this with git or should the git case just
  21         # fall through to use config.h?  it is always nice to know if we are
  22         # working on a tag or branch.
  23         my $verfile = new IO::File;
  24         if (!$verfile->open("config.h")) {
  25           return "UNKNOWN";
  26         }
  27         while(defined($line = <$verfile>)) {
  28             $line =~ /\#define VERSION "(.*)"/;
  29             if ($1) {
  30                 $tag = $1;
  31                 last;
  32             }
  33         }
  34         $verfile->close();
  35         return $tag
  36     } else {
  37         my $tmp = <$tagfile>;
  38         $tagfile->close();
  39
  40         $tmp =~ m/[TN](.*)/;
  41         return $1;
  42     }
  43 }
  44
  45 sub get_latest_mtime()
  46 {
  47     my %months=("Jan" => 0, "Feb" => 1, "Mar" => 2, "Apr" => 3, "May" => 4,
  48                 "Jun" => 5, "Jul" => 6, "Aug" => 7, "Sep" => 8, "Oct" => 9,
  49                 "Nov" => 10, "Dec" => 11);
  50
  51     my $last_mtime = 0;
  52
  53     # a CVS checkout
  54     if (-d "CVS") {
  55         # if we got here, we are operating in a CVS checkout
  56         my @entries = `find . -name Entries`;
  57         my $entry_file;
  58         foreach $entry_file (@entries) {
  59             chomp($entry_file);
  60             my $entry = new IO::File;
  61             if (!$entry->open($entry_file)) {
  62                 die "unable to open $entry_file: $!\n";
  63             }
  64             my $line;
  65             while (defined($line = <$entry>)) {
  66                 chomp($line);
  67                 #print "line: $line\n";
  68                 my ($junk, $file, $version, $date) = split(/\//, $line);
  69
  70                 #print "junk: $junk\nfile: $file\nver: $version\ndate: $date\n";
  71                 #print "last_mtime: " . localtime($last_mtime) . "\n";
  72
  73                 if ($junk eq "D" ||
  74                     $file eq "lustre.spec.in") {
  75                     # also used to skip: "$file !~ m/\.(c|h|am|in)$/" but I see
  76                     # no good reason why only the above file patterns should
  77                     # count towards pristine/changed.  it should be any file,
  78                     # surely.
  79                     next;
  80                 }
  81
  82                 my $cur_dir = $entry_file;
  83                 $cur_dir =~ s/\/CVS\/Entries$//;
  84                 my @statbuf = stat("$cur_dir/$file");
  85                 my $mtime = $statbuf[9];
  86                 if (!defined($mtime)) {
  87                     next;
  88                 }
  89                 my $local_date = gmtime($mtime);
  90                 if ($local_date ne $date &&
  91                     $file ne "lustre.spec.in") {
  92                     #print "$file : " . localtime($mtime) . "\n";
  93                     $pristine = 0;
  94                 }
  95
  96                 if ($mtime > $last_mtime) {
  97                     $last_mtime = $mtime;
  98                 }
  99
 100                 if ($date) {
 101                     my @t = split(/ +/, $date);
 102                     if (int(@t) != 5) {
 103                         #print "skipping: $date\n";
 104                         next;
 105                     }
 106                     my ($hours, $min, $sec) = split(/:/, $t[3]);
 107                     my ($mon, $mday, $year) = ($t[1], $t[2], $t[4]);
 108                     my $secs = 0;
 109                     $mon = $months{$mon};
 110                     $secs = timelocal($sec, $min, $hours, $mday, $mon, $year);
 111                     if ($secs > $last_mtime) {
 112                         $last_mtime = $secs;
 113                     }
 114                 }
 115             }
 116             $entry->close();
 117         }
 118     } elsif (-d ".git") {
 119         # a git checkout
 120         # TODO: figure out how to determine the most recently modified file
 121         #       in a git working copy.
 122         #       NOTE: this is not simply the newest file in the whole tree,
 123         #             but the newest file in the tree that is from the
 124         #             repository.
 125         $last_mtime = time();
 126     } else {
 127         my $tree_status = new IO::File;
 128         if (!$tree_status->open("tree_status")) {
 129             die "unable to open the tree_status file: $!\n";
 130         }
 131         my $line;
 132         while (defined($line = <$tree_status>)) {
 133             if ($line =~ /^PRISTINE\s*=\s*(\d)/) {
 134                 $pristine = $1;
 135             } elsif  ($line =~ /^MTIME\s*=\s*(\d+)/) {
 136                 $last_mtime = $1;
 137             }
 138         }
 139     }
 140     return $last_mtime;
 141
 142 }
 143
 144 sub get_linuxdir()
 145 {
 146     my $config = new IO::File;
 147     my ($line, $dir, $objdir);
 148     if (!$config->open("autoMakefile")) {
 149         die "Run ./configure first\n";
 150     }
 151     while (defined($line = <$config>)) {
 152         chomp($line);
 153         if ($line =~ /LINUX :?= (.*)/) {
 154             $dir = $1;
 155         } elsif ($line =~ /LINUX_OBJ :?= (.*)/) {
 156             $objdir = $1;
 157         } elsif ($line =~ /MODULES_TRUE = #/ ||
 158                  $line =~ /MODULE_TARGET = $/) {
 159             # nothing to do if modules are not being built
 160             return ""
 161         }
 162     }
 163     $config->close();
 164     my $ver = new IO::File;
 165     if (!$ver->open("$objdir/include/linux/utsrelease.h") &&
 166         !$ver->open("$objdir/include/linux/version.h") &&
 167         !$ver->open("$dir/include/linux/utsrelease.h") &&
 168         !$ver->open("$dir/include/linux/version.h")) {
 169             die "Run make dep on '$dir'\n";
 170         }
 171
 172     while(defined($line = <$ver>)) {
 173         $line =~ /\#define UTS_RELEASE "(.*)"/;
 174         if ($1) {
 175             $kernver = $1;
 176             last;
 177         }
 178     }
 179     $ver->close();
 180     chomp($kernver);
 181     $dir =~ s/\//\./g;
 182     return $dir;
 183 }
 184
 185 sub mtime2date($)
 186 {
 187     my $mtime = shift;
 188
 189     my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
 190       localtime($mtime);
 191     $year += 1900;
 192     $mon++;
 193     my $show_last = sprintf("%04d%02d%02d%02d%02d%02d", $year, $mon, $mday,
 194                             $hour, $min, $sec);
 195
 196     return $show_last;
 197 }
 198
 199 sub generate_ver($$$)
 200 {
 201     my $tag = shift;
 202     my $mtime = shift;
 203     my $linuxdir = shift;
 204
 205     # assume building without modules
 206     my $postfix = "";
 207
 208     if ($linuxdir ne "") {
 209         $postfix = "-$kernver";
 210     }
 211
 212     #print "localtime: " . localtime($mtime) . "\n";
 213
 214     my $lustre_vers = $ENV{LUSTRE_VERS};
 215
 216     print "#define BUILD_VERSION \"";
 217
 218     if ($lustre_vers) {
 219         print "$tag-$lustre_vers\"\n";
 220         return 0;
 221     }
 222
 223     my $show_last = mtime2date($mtime);
 224
 225     # if we want to get rid of the PRISTINE/CHANGED thing, get rid of these
 226     # lines.  maybe we only want to print -CHANGED when something is changed
 227     # and print nothing when it's pristine
 228     if ($pristine) {
 229         print "$tag-$show_last-PRISTINE$postfix\"\n";
 230     } else {
 231         print "$tag-$show_last-CHANGED$postfix\"\n";
 232     }
 233 }
 234
 235 my $progname = $0;
 236 $progname =~ s/.*\///;
 237
 238 if ($progname eq "tree_status.pl" && !-d "CVS" && !-d ".git") {
 239     die("a tree status can only be determined in an source code control system checkout\n");
 240 }
 241
 242 chomp(my $cwd = `pwd`);
 243
 244 # ARGV[0] = srcdir
 245 # ARGV[1] = builddir
 246
 247 # for get_latest_mtime and get_tag you need to be in srcdir
 248
 249 if ($ARGV[0]) {
 250     chdir($ARGV[0]);
 251 }
 252 my $tag = get_tag();
 253 my $mtime = get_latest_mtime()
 254     if (!defined($ENV{LUSTRE_VERS}));
 255
 256 if ($progname eq "version_tag.pl") {
 257     my $linuxdir = get_linuxdir();
 258     $linuxdir =~ s/\//\./g;
 259     generate_ver($tag, $mtime, $linuxdir);
 260 } elsif ($progname eq "tree_status.pl") {
 261     print "PRISTINE = $pristine\n";
 262     print "MTIME = $mtime\n";
 263 }
 264
 265 exit(0);