perl/version.pl

   1 #!/usr/bin/env perl
   2 #
   3 # version.pl
   4 #
   5 # Parse the NASM version file and produce appropriate macros
   6 #
   7 # The NASM version number is assumed to consist of:
   8 #
   9 # <major>.<minor>[.<subminor>][pl<patchlevel> | rc<number>]]<tail>
  10 #
  11 # ... where <tail> is not necessarily numeric, but if it is of the form
  12 # -<digits> it is assumed to be a snapshot release.
  13 #
  14 # This defines the following macros:
  15 #
  16 # version.h:
  17 # NASM_MAJOR_VER
  18 # NASM_MINOR_VER
  19 # NASM_SUBMINOR_VER     -- this is zero if no subminor
  20 # NASM_PATCHLEVEL_VER   -- this is zero is no patchlevel
  21 # NASM_SNAPSHOT         -- if snapshot
  22 # NASM_VERSION_ID       -- version number encoded
  23 # NASM_VER              -- whole version number as a string
  24 #
  25 # version.mac:
  26 # __NASM_MAJOR__
  27 # __NASM_MINOR__
  28 # __NASM_SUBMINOR__
  29 # __NASM_PATCHLEVEL__
  30 # __NASM_SNAPSHOT__
  31 # __NASM_VERSION_ID__
  32 # __NASM_VER__
  33 #
  34 use warnings;
  35 use strict;
  36
  37 # fill in %version;
  38 #our %version;
  39 my $version;
  40 sub Load{
  41   my($filename) = @_;
  42   $filename ||= '-';
  43   my %version;
  44
  45   return $version if $version;
  46
  47   {
  48     # only really required for this first match
  49     # could probably rewrite the match for earlier Perls
  50     require 5.010;
  51     my $line;
  52
  53     if($filename and $filename ne '-'){
  54       open my $file, '<', $filename or die;
  55
  56       $line = <$file>;
  57       close $file;
  58     }else{
  59       $line = <STDIN>;
  60     }
  61     chomp $line;
  62     die unless length $line;
  63     $version{_line} = $line;
  64
  65     $line =~ m{ ^
  66       (?<major>\d+)[.](?<minor>\d+)
  67       (?:[.](?<subminor>\d+))?
  68       (?:
  69         pl(?<patchlevel>\d+) |
  70         rc(?<rc>\d+)
  71       )?
  72       (?:
  73         [-](?<snapshot>\d+) |
  74         (?<tail>.+)
  75       )?
  76       $
  77     }x;
  78
  79     for my $key(qw'major minor subminor patchlevel rc'){
  80       my $value = $+{$key} || 0;
  81
  82       # removes any leading zeros by forcing to a number
  83       $version{$key} = $value + 0;
  84     }
  85     for my $key(qw'snapshot tail'){
  86       if(exists $+{$key}){
  87         $version{$key} = $+{$key};
  88       }
  89     }
  90   }
  91
  92
  93
  94
  95   # modify %version if this is a release candidate
  96   if($version{rc}){
  97     $version{patchlevel} = $version{rc} + 90;
  98
  99     if($version{subminor}){
 100       $version{subminor}--;
 101     }else{
 102       $version{subminor} = 99;
 103
 104       if($version{minor}){
 105         $version{minor}--;
 106       }else{
 107         $version{minor} = 99;
 108         $version{major}--;
 109       }
 110     }
 111   }
 112
 113
 114
 115   # add 'id' and 'xid' to %version
 116   $version{id} =
 117     ($version{major}    << 24) +
 118     ($version{minor}    << 16) +
 119     ($version{subminor} <<  8) +
 120     $version{patchlevel};
 121   $version{xid} = sprintf('0x%08x',$version{id});
 122
 123
 124
 125   # add 'mangled' to %version
 126   {
 127     my $mangled = sprintf("%d.%02d",$version{major},$version{minor});
 128     if(
 129       $version{subminor}   or
 130       $version{patchlevel} or
 131       $version{snapshot}
 132     ){
 133       $mangled .= sprintf(".%02d",$version{subminor});
 134
 135       if(
 136         $version{patchlevel} or
 137         $version{snapshot}
 138       ){
 139         $mangled .= sprintf(".%01d",$version{patchlevel})
 140       }
 141     }
 142
 143     if($version{snapshot}){
 144       $mangled .= '.'.$version{snapshot}
 145     }elsif( $version{tail}){
 146       my $tail = $version{tail};
 147       $tail =~ s/-/./g;
 148       $mangled .= $tail;
 149     }
 150
 151     $version{mangled} = $mangled;
 152   }
 153
 154   $version = \%version;
 155   return  %version if wantarray;
 156   return \%version;
 157 }
 158
 159
 160
 161 # forward definition of subroutines
 162 sub help;
 163 sub h;
 164 sub mac;
 165 sub sed;
 166 sub make;
 167 sub nsis;
 168
 169
 170 # jump table to subroutines / variables
 171 my %jump = (
 172   help => \&help,
 173   h    => \&h,
 174   mac  => \&mac,
 175   sed  => \&sed,
 176   make => \&make,
 177   nsis => \&nsis,
 178   id   => 'id',
 179   xid  => 'xid',
 180   dump => sub{
 181     my($version)=@_;
 182     no warnings qw'once';
 183     require Data::Dumper;
 184     local $Data::Dumper::Terse = 1;
 185
 186     my %ret = %$version;
 187     for( keys %ret ){
 188       # remove any "hidden" keys
 189       delete $ret{$_} if /^[_.]/;
 190     }
 191     return  Data::Dumper::Dumper(\%ret);
 192   },
 193   yaml => sub{
 194     my($version)=@_;
 195     require YAML::XS;
 196     YAML::XS->import;
 197
 198     my %ret = %$version;
 199     for( keys %ret ){
 200       # remove any "hidden" keys
 201       delete $ret{$_} if /^[_.]/;
 202     }
 203     return Dump(\%ret);
 204   },
 205   json => sub{
 206     my($version)=@_;
 207     require JSON;
 208     JSON->import;
 209
 210     my %ret = %$version;
 211     for( keys %ret ){
 212       # remove any "hidden" keys
 213       delete $ret{$_} if /^[_.]/;
 214     }
 215     return  to_json(\%ret);
 216   }
 217 );
 218
 219
 220 # Main Code Block
 221 {
 222   use Scalar::Util 'reftype';
 223
 224   my($cmd, $filename) = @ARGV;
 225
 226   if( not $cmd or $cmd eq 'help' ){
 227     # in this case $filename is actually output format
 228     help($filename);
 229     last;
 230   }
 231
 232   my $jump = $jump{$cmd} || $jump{help};
 233   my $version = Load($filename);
 234
 235   if( ref $jump ){
 236     my $reftype = reftype $jump;
 237
 238     if($reftype eq 'CODE'){
 239       my $ret = $jump->($version);
 240       print "$ret\n" if defined $ret;
 241
 242     }else{
 243       # an un-used reference
 244       die;
 245     }
 246   }else{
 247     print $version->{$jump},"\n";
 248   }
 249 }
 250
 251
 252 # subroutine definitions
 253
 254
 255 sub h{
 256   my($version) = @_;
 257   printf <<END, @$version{'major','minor','subminor','patchlevel'};
 258 #ifndef NASM_VERSION_H
 259 #define NASM_VERSION_H
 260 #define NASM_MAJOR_VER      %d
 261 #define NASM_MINOR_VER      %d
 262 #define NASM_SUBMINOR_VER   %d
 263 #define NASM_PATCHLEVEL_VER %d
 264 END
 265
 266   if ($version->{snapshot}) {
 267     printf "#define NASM_SNAPSHOT       %d\n", $version->{snapshot};
 268   }
 269
 270   printf <<END, @$version{'xid','_line'};
 271 #define NASM_VERSION_ID     %s
 272 #define NASM_VER            "%s"
 273 #endif /* NASM_VERSION_H */
 274 END
 275   return;
 276 }
 277
 278
 279
 280 sub mac{
 281   my($version) = @_;
 282   printf <<'END', @$version{'major','minor','subminor','patchlevel'};
 283 %%define __NASM_MAJOR__ %d
 284 %%define __NASM_MINOR__ %d
 285 %%define __NASM_SUBMINOR__ %d
 286 %%define __NASM_PATCHLEVEL__ %d
 287 END
 288
 289   if ($version->{snapshot}) {
 290     printf "%%define __NASM_SNAPSHOT__ %d\n", $version->{snapshot};
 291   }
 292
 293 printf <<'END', @$version{'id','_line'};
 294 %%define __NASM_VERSION_ID__ 0%08Xh
 295 %%define __NASM_VER__ "%s"
 296 END
 297   return;
 298 }
 299
 300
 301
 302 sub sed{
 303   my($version) = @_;
 304   my @rep = @$version{qw{
 305     major
 306     minor
 307     subminor
 308     patchlevel
 309     snapshot
 310     id
 311     xid
 312     _line
 313     mangled
 314   }};
 315   no warnings 'uninitialized';
 316 sprintf <<'END', @rep;
 317 s/@@NASM_MAJOR@@/%d/g
 318 s/@@NASM_MINOR@@/%d/g
 319 s/@@NASM_SUBMINOR@@/%d/g
 320 s/@@NASM_PATCHLEVEL@@/%d/g
 321 s/@@NASM_SNAPSHOT@@/%d/g
 322 s/@@NASM_VERSION_ID@@/%d/g
 323 s/@@NASM_VERSION_XID@@/%s/g
 324 s/@@NASM_VER@@/%s/g
 325 s/@@NASM_MANGLED_VER@@/%s/g
 326 END
 327 }
 328
 329
 330
 331
 332 sub make{
 333   my($version) = @_;
 334  return sprintf <<END, @$version{'_line','major','minor','subminor','patchlevel'};
 335 NASM_VER=%s
 336 NASM_MAJOR_VER=%d
 337 NASM_MINOR_VER=%d
 338 NASM_SUBMINOR_VER=%d
 339 NASM_PATCHLEVEL_VER=%d
 340 END
 341 }
 342
 343
 344
 345 sub nsis{
 346   my($version) = @_;
 347  return sprintf <<'END', @$version{'_line','major','minor','subminor','patchlevel'};
 348 !define VERSION "%s"
 349 !define MAJOR_VER %d
 350 !define MINOR_VER %d
 351 !define SUBMINOR_VER %d
 352 !define PATCHLEVEL_VER %d
 353 END
 354 }
 355
 356
 357
 358 sub help{
 359   my($cmd) = @_;
 360
 361   my %help = (
 362     sed  => 'strings for sed command',
 363     mac  => 'strings for nasm macros',
 364     h    => 'strings for headers',
 365     make => 'strings for makefiles',
 366     dump => 'dump of program data',
 367     nsis => 'what is nsis?',
 368     json => 'same output as dump in json format',
 369     yaml => 'same output as dump in yaml format'
 370   );
 371
 372   if( $cmd and $help{$cmd} ){
 373     print $help{$cmd},"\n";
 374   }else{
 375     print "$0 [help]? [ ".join(' | ',keys %help)." ]\n";
 376   }
 377   return;
 378 }