NewImName,102

# 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);
};