# 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: imagename [options]
#   -newmajor|-newminor
#   -mapfile <file>
#   -formfile <file>
#   -verfile <file>
#   -var <variable>
#   -test
#   -debug
#   -query

my($dir,@vars,%envmap);
my $minmajor=0;
my $minminor=0;
$var='Build$ImageName';
$datevar='Build$Date';

my $x;
foreach $x (keys %ENV) {
  $envmap{uc $x}=$x;
};

# Option parsing
while($ARGV[0]=~/^-./) {
  my $arg=shift@ARGV;
  if($arg=~/^--$/) {
    last;
  } elsif($arg=~/^-(newmajor|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);

$mapfile="$dir.SysMap" unless defined($mapfile);
$formfile="$dir.Format" unless defined($formfile);
$verfile="$dir.Version" unless defined($verfile);

# Read in the files.  Order is important.
read_mapfile($mapfile);
read_format($formfile);
read_version($verfile,$newmajor,$newminor);

# String it all together
$version='';
foreach $x (@format) {
  if(ref($x)) {
    $version.=&{$x};
  } else {
    $version.=$x;
  };
};

# 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 in map file into %map
#   ${var:}=1		if section var defined
#   ${var:val}=char	if val appears in section var
sub read_mapfile {
  my ($mapfile)=@_;
  my $var=undef;
  local *MAP;
  %map=();
  open(MAP,"< $mapfile\0")||failed("open($mapfile)");
  while(<MAP>) {
    s/\#.*//;
    if(/^\s*([^\s:]+):([^\s:]+)\s*$/) {
      die("$0: No variable name at top of map file: $mapfile\n")
        unless defined($var);
      $map{uc $var,uc $2}=$1;
    } elsif(/^\s*([^\s:]+)\s*$/) {
      $var=$1;
      $map{uc $var}=$var;
    } elsif(/\S/) {
      die("$0: Line not recongnised in map file: $mapfile\n  $_\n");
    };
  };
  close(MAP);
};

# Reads format file into @format, and the id string into $id

sub read_format {
  my ($formfile)=@_;
  local *FORMAT;
  $id='';
  @format=();
  my $fatal=0;
  open(FORMAT,"< $formfile\0")||failed("open($formfile)");
  while(<FORMAT>) {
    s/\#.*//;
    if(/^\s*\$(\w+):(\d+)\s*$/) { # $var
      my $var=lc $1;
      my $width=$2;
      if($var =~ /^(major|minor|unique)$/) {
        push @format,sub {
          print "Getting $var:$width from '${$var}'\n" if($debug);
          return substr(${$var},-$width,$width);
        };
        if($width>$minwidth{$var}) {
          print "Setting minwidth of $var to $width\n" if($debug);
          $minwidth{$var}=$width;
        };
      } else {
        die("$0: Unknown variable \$$x in $formfile\n");
      };
    } elsif(/^\s*<([^\s:]*)>\s*(!)?\s*$/) { # <var>
      print "Lookup for $1\n" if($debug);
      push @vars,$1; # For test mode
      die("$0: Unknown variable <$1> in $formfile\n")
        unless defined($map{uc $1});
      my $val=$ENV{$envmap{uc $1}};
      die("$0: Environment variable $1 not defined\n")
        unless defined($val);
      my $x=$map{uc $1,uc $val};
      unless($x) {
        warn("$0: Cannot map variable $1=$val\n");
        $fatal=1;
        next;
      }
      $id.=$x unless $2;
      push @format,$x;
    } elsif(/^\s*(['"])((?:(?!\1)[^\\]|\\.)*)\1\s*$/) { # 'string'
      my $x=$2;
      my %quoted=(n=>'\n',r=>'\r',f=>'\f',b=>'\b',t=>'\t',e=>'\e');
      $x=~s/\\(.)/$quoted{$1}||$1/ge;
      push @format,$x;
    } elsif(/\S/) {
      die("$0: Line not recongnised in format file: $formfile\n  $_\n");
    };
  };
  exit(1) if $fatal;
};

# Reads version file into $unique, $major and $minor, based on $id.

sub read_version {
  my ($file,$newmajor,$newminor)=@_;
  local *VERSION,*OUT;
  my $notthere;
  undef $unique;
  undef $major;
  undef $minor;
  open(VERSION,"< $file\0")||($notthere=1);
  open(OUT,"> ${file}+")||failed("open(${file}+)");
  while(<VERSION>) {
    chomp;
    if(/^\s*(\w+)\s*$/) {
      if(defined($unique)) {
        close(OUT);
        unlink("${file}+");
        die("$0: Duplicate unique identifier in $file\n");
      };
      update_var('unique',$1,1,'a');
      $_=$unique;
    } elsif(/^\s*([^\s:]*):(\d+):(\d+)\s*$/) {
      if(uc $1 eq uc $id) {
        if(defined($major)) {
          die("$0: Duplicate version number for $id in $file\n");
        };
        update_var('minor',$newmajor?$minminor:$3,(!$newmajor)&&$newminor,'0');
        update_var('major',$2,$3>$minor||$newmajor,'0');
        $_="$id:$major:$minor";
      };
    } elsif(/\S/) {
      die("$0: Line not recongnised in version file: $file\n  $_\n");
    };
    print OUT "$_\n"||failed("write(${file}+)\n");
  };
  if(!defined($unique)) {
    update_var('unique','',undef,'a');
    print OUT "$unique\n";
  };
  if(!defined($major)) {
    update_var('major',$minmajor,undef,'0');
    update_var('minor',$minminor,undef,'0');
    print OUT "$id:$major:$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)");
  };
};

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);
  $val++ if($toupdate);
#  print "Minwidth=$minwidth{$var}, len=$len\n";
  if($len<$minwidth{$var}) {
    $len=$minwidth{$var};
  };
  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";
};

#sub id {
#  my ($x,$str);
#  foreach $x (@_) {
#    $str.=length($x).":".$x;
#  };
#  $str;
#};