# Copyright 2008 Castle Technology Ltd # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # # Usage: newimname [options] # NewImName # This script generates new names for images according to the new naming # scheme. It is a hack of the old 'ImageName' script held in BuildSys.Perl # in the source repository. # The new image name format is as follows: # # Project identifier (4 chars), eg. Laz1 # Country variant (2 chars), eg. uk # Release number (2 hex chars), eg. 01 # Minor build number (2 hex chars), eg. 00 # # Hence the 4th build of the 2 release of the UK variant of the Laz1 project # would be Laz1uk0204 # Versions: # 0.01 (DCotton): # Initial version # Current version : $scriptversion = '0.01'; my($dir,@vars,%envmap); my $minreleasenum=0; my $minminor=0; $var='Build$ImageName'; $datevar='Build$Date'; $envname='AutoBuild$EnvName'; $releasenvname='AutoBuild$ReleaseNumber'; my $x; foreach $x (keys %ENV) { $envmap{uc $x}=$x; }; # Option parsing while($ARGV[0]=~/^-./) { my $arg=shift@ARGV; if($arg=~/^--$/) { last; } elsif($arg=~/^-(newreleasenum|newminor|debug|test|query|hack_round_silly_riscosism)$/) { ${$1}=1; print "Option $1\n" if($debug); } elsif($arg=~/^-(mapfile|formfile|verfile|var)$/) { unless (defined(${$1}=shift@ARGV)) { die("$0: No value for $1\n"); }; print "Option $1=${$1}\n" if($debug); } else { die("$0: Option not recognised: $arg\n"); }; }; if(@ARGV) { die("$0: Too many arguments\n"); }; if($test) { ($dir=$0)=~s/\.[^.]*$//; # The directory containing the script unless(-d "$dir.logs") { mkdir($dir.".logs",-1)||failed("mkdir $dir.logs"); }; system("filer_opendir $dir.logs"); } else { $dir="$ENV{$envmap{uc 'Build$Dir'}}.BuildSys.ImageName"; }; print "Directory: $dir\n" if($debug); print "Version file: $verfile\n" if($debug); # Ensure that the version file exists. If it does not, create a blank one ;*) if (not(-e $verfile)) { create_initial_version_file($verfile); } # Read in the files. Order is important. read_version($verfile,$newreleasenum,$newminor); # String it all together $version = $ENV{$envname}.$releasenum.$minor; # Set the variable $ENV{$var}=$version if length($var); if($test&&!$query) { # Create a test log file open(LOG,"> ${dir}.logs.$version\0") ||failed("open(${dir}.logs.$version"); foreach $x (@vars) { print LOG "$x=$ENV{$envmap{uc $x}}\n"; }; close(LOG); }; # Set the date variable ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time); $date = substr (('00' . $mday), -2); $date .= ' '; $date .= (qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec))[$mon]; $date .= ' '; $date .= 1900 + $year; $ENV{$datevar}=$date; exit 0; # # Reads version file into $unique, $releasenum and $minor, based on $id. sub read_version { my ($file,$newreleasenum,$newminor)=@_; local *VERSION,*OUT; my $notthere; undef $unique; undef $releasenum; undef $minor; open(VERSION,"< $file\0")||($notthere=1); open(OUT,"> ${file}+")||failed("open(${file}+)"); while(<VERSION>) { chomp; if(/^\s*(\w+)\s*$/) { } elsif(/^:(\w+):(\w+)\s*$/) { # If relasenum was passed, in increment releasenum and set minor back to 00 if ($newreleasenum) { update_var('minor', 00, $newminor,'0'); } else { update_var('minor',$2, $newminor,'0'); } update_var('releasenum',$1, $newreleasenum,'0'); $_=":$releasenum:$minor"; $ENV{$releasenvname}=$releasenum; } elsif(/\S/) { die("$0: Line not recongnised in version file: $file\n $_\n"); }; print OUT "$_\n"||failed("write(${file}+)\n"); }; if(!defined($releasenum)) { update_var('releasenum',$minreleasenum,undef,'0'); update_var('minor',$minminor,undef,'0'); print OUT "$id:$releasenum:$minor\n"; }; close(OUT)||failed("Close(${file}+)\n"); close(VERSION); if($query) { unlink("${file}+")||failed("unlink(${file}+)"); } else { unless($notthere) { unlink($file)||failed("unlink($file)"); }; rename("${file}+",$file)||failed("rename(${file}+,$file)"); }; }; # Update the variable passed in by incrementing it. sub update_var { my ($var,$val,$toupdate,$pad)=@_; my $len=length($val); print "Updating $var to $val padded with $pad, toupdate=$toupdate\n" if($debug); # Convert the hex number to decimal and increment, then convert back. $decval = hex ($val); $decval++ if($toupdate); $val = sprintf("%x", $decval); # print "val is $val, decval is $decval.\n"; $minwidth{$var} = 2; # print "Minwidth=$minwidth{$var}, len=$len\n"; if($len<$minwidth{$var}) { $len=$minwidth{$var}; }; # print "length of $val is ".length($val).". $len is ".$len."\n"; if(length($val)<$len) { # print "Padding from ${\length($val)} to $len\n"; $val=($pad x ($len-length($val))).$val; } elsif(length($val)>$len) { $val=substr($val,-$len,$len); }; print "Result $val\n" if($debug); ${$var}=$val; }; sub failed { die "$0: $_[0] failed\n"; }; # This routine creates a blank version file. It attempts to create the # directory up to the file is present. sub create_initial_version_file { my ($verfile)=@_; print "Creating a Version file at $verfile\n"; $pathname = $verfile; $pathname =~ s/.[a-zA-Z0-9!]+$//; # print "Pathname is $pathname\n"; mkdir ($pathname, 0777); # Public read/write access open(OUT,">"."$verfile"); # Create the file. print OUT ":00:00\n"; # Output an initial version number of 00:00 close(OUT); };