Whamcloud - gitweb
b=19086
[fs/lustre-release.git] / 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             last;
158         }
159     }
160     $config->close();
161     my $ver = new IO::File;
162     if (!$ver->open("$objdir/include/linux/utsrelease.h") &&
163         !$ver->open("$objdir/include/linux/version.h") &&
164         !$ver->open("$dir/include/linux/utsrelease.h") &&
165         !$ver->open("$dir/include/linux/version.h")) {
166             die "Run make dep on $dir\n";
167         }
168     while(defined($line = <$ver>)) {
169         $line =~ /\#define UTS_RELEASE "(.*)"/;
170         if ($1) {
171             $kernver = $1;
172             last;
173         }
174     }
175     $ver->close();
176     chomp($kernver);
177     $dir =~ s/\//\./g;
178     return $dir;
179 }
180
181 sub mtime2date($)
182 {
183     my $mtime = shift;
184
185     my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) =
186       localtime($mtime);
187     $year += 1900;
188     $mon++;
189     my $show_last = sprintf("%04d%02d%02d%02d%02d%02d", $year, $mon, $mday,
190                             $hour, $min, $sec);
191
192     return $show_last;
193 }
194
195 sub generate_ver($$$)
196 {
197     my $tag = shift;
198     my $mtime = shift;
199     my $linuxdir = shift;
200
201     #print "localtime: " . localtime($mtime) . "\n";
202
203     my $show_last = mtime2date($mtime);
204
205     print "#define BUILD_VERSION \"";
206
207     my $lustre_vers = $ENV{LUSTRE_VERS};
208
209     if ($lustre_vers) {
210         print "$tag-$lustre_vers\"\n";
211     # if we want to get rid of the PRISTINE/CHANGED thing, get rid of these
212     # lines.  maybe we only want to print -CHANGED when something is changed
213     # and print nothing when it's pristine
214     } elsif ($pristine) {
215         print "$tag-$show_last-PRISTINE-$linuxdir-$kernver\"\n";
216     } else {
217         print "$tag-$show_last-CHANGED-$linuxdir-$kernver\"\n";
218     }
219 }
220
221 my $progname = $0;
222 $progname =~ s/.*\///;
223
224 if ($progname eq "tree_status.pl" && !-d "CVS" && !-d ".git") {
225     die("a tree status can only be determined in an source code control system checkout\n");
226 }
227
228 chomp(my $cwd = `pwd`);
229
230 # ARGV[0] = srcdir
231 # ARGV[1] = builddir
232
233 # for get_latest_mtime and get_tag you need to be in srcdir
234
235 if ($ARGV[0]) {
236     chdir($ARGV[0]);
237 }
238 my $tag = get_tag();
239 my $mtime = get_latest_mtime();
240
241 if ($progname eq "version_tag.pl") {
242     my $linuxdir = get_linuxdir();
243     $linuxdir =~ s/\//\./g;
244     generate_ver($tag, $mtime, $linuxdir);
245 } elsif ($progname eq "tree_status.pl") {
246     print "PRISTINE = $pristine\n";
247     print "MTIME = $mtime\n";
248 }
249
250 exit(0);