perl/version.pl

   1 #!/usr/bin/env perl
   2
   3 =head1 NAME
   4
   5 version.pl - Parse the NASM version file and produce appropriate macros
   6
   7 =head1 SYNOPSIS
   8
   9   version.pl $format < $filename
  10
  11   echo 2.06rc10 | version.pl $format
  12
  13   version.pl $format $filename
  14
  15 Where $format is one of:
  16
  17   h mac sed make nsis id xid perl yaml json
  18
  19 =head1 DESCRIPTION
  20
  21 The NASM version number is assumed to consist of:
  22
  23 <major>.<minor>[.<subminor>][pl<patchlevel> | rc<number>]]<tail>
  24
  25 ... where <tail> is not necessarily numeric, but if it is of the form
  26 -<digits> it is assumed to be a snapshot release.
  27
  28 =over 4
  29
  30 =cut
  31
  32
  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 sub yaml;
 169 sub json;
 170 sub perl;
 171
 172
 173 # jump table to subroutines / variables
 174 my %jump = (
 175   id   => 'id',
 176   xid  => 'xid',
 177
 178   h    => \&h,
 179   mac  => \&mac,
 180   sed  => \&sed,
 181   make => \&make,
 182   nsis => \&nsis,
 183
 184   perl => \&perl,
 185   dump => \&perl,
 186   yaml => \&yaml,
 187   yml  => \&yaml,
 188   json => \&json,
 189   js   => \&json,
 190
 191   help => \&help,
 192   usage => sub{
 193     require Pod::Usage;
 194
 195     Pod::Usage::pod2usage();
 196   }
 197 );
 198
 199 =item id
 200
 201   print "$id\n"
 202
 203 =item xid
 204
 205   printf "0x%08x\n",$id
 206
 207 =item perl - returns a dump of internally used data
 208
 209   {
 210     'rc' => 10,
 211     'subminor' => 99,
 212     'minor' => 5,
 213     'mangled' => '2.05.99.100',
 214     'patchlevel' => 100,
 215     'id' => 33907556,
 216     'xid' => '0x02056364',
 217     'major' => 2
 218   }
 219
 220 =cut
 221
 222 sub perl{
 223   my($version)=@_;
 224   no warnings qw'once';
 225   require Data::Dumper;
 226   local $Data::Dumper::Terse = 1;
 227   local $Data::Dumper::Indent = 1;
 228
 229   my %ret = %$version;
 230   for( keys %ret ){
 231     # remove any "hidden" keys
 232     delete $ret{$_} if /^[_.]/;
 233   }
 234   return  Data::Dumper::Dumper(\%ret);
 235 }
 236
 237 =item yaml - returns the same thing as dump, but in YAML format
 238
 239   ---
 240   id: 33907556
 241   major: 2
 242   mangled: 2.05.99.100
 243   minor: 5
 244   patchlevel: 100
 245   rc: 10
 246   subminor: 99
 247   xid: 0x02056364
 248
 249 =cut
 250
 251 sub yaml{
 252   my($version)=@_;
 253   require YAML::XS;
 254   YAML::XS->import;
 255
 256   my %ret = %$version;
 257   for( keys %ret ){
 258     # remove any "hidden" keys
 259     delete $ret{$_} if /^[_.]/;
 260   }
 261   return Dump(\%ret);
 262 }
 263
 264 =item json - returns the same thing as dump, but in JSON format
 265
 266   {
 267     "rc" : 10,
 268     "subminor" : 99,
 269     "minor" : 5,
 270     "mangled" : "2.05.99.100",
 271     "patchlevel" : 100,
 272     "id" : 33907556,
 273     "xid" : "0x02056364",
 274     "major" : 2
 275   }
 276
 277 =cut
 278
 279 sub json{
 280   my($version)=@_;
 281   require JSON;
 282   #JSON->import;
 283
 284   my $json = new JSON;
 285
 286   my %ret = %$version;
 287   for( keys %ret ){
 288     # remove any "hidden" keys
 289     delete $ret{$_} if /^[_.]/;
 290   }
 291   return $json->pretty->encode(\%ret);
 292 }
 293
 294
 295 # Main Code Block
 296 {
 297   use Scalar::Util 'reftype';
 298
 299   my($cmd, $filename) = @ARGV;
 300
 301   if(
 302     not $cmd or $cmd =~ /^ -h | (?:--)?help $/xi
 303   ){
 304     # in this case $filename is actually output format
 305     # we want to know more about
 306     $jump{help}->($filename);
 307     last;
 308
 309   }elsif($cmd eq 'usage'){
 310     $jump{usage}->();
 311   }
 312
 313   my $jump = $jump{$cmd};
 314   unless( $jump ){
 315     $jump{usage}->(cmd=>$cmd);
 316   }
 317
 318   my $version = Load($filename);
 319
 320   if( ref $jump ){
 321     my $reftype = reftype $jump;
 322
 323     if($reftype eq 'CODE'){
 324       my $ret = $jump->($version);
 325       print "$ret\n" if defined $ret;
 326
 327     }else{
 328       # an un-used reference type
 329       die;
 330     }
 331   }else{
 332     print $version->{$jump}, "\n";
 333   }
 334 }
 335
 336
 337 # subroutine definitions
 338
 339
 340 =item h:
 341
 342   NASM_MAJOR_VER
 343   NASM_MINOR_VER
 344   NASM_SUBMINOR_VER   -- this is zero if no subminor
 345   NASM_PATCHLEVEL_VER -- this is zero is no patchlevel
 346   NASM_SNAPSHOT       -- if snapshot
 347   NASM_VERSION_ID     -- version number encoded
 348   NASM_VER            -- whole version number as a string
 349
 350 =cut
 351
 352 sub h{
 353   my($version) = @_;
 354   printf <<END, @$version{'major','minor','subminor','patchlevel'};
 355 #ifndef NASM_VERSION_H
 356 #define NASM_VERSION_H
 357 #define NASM_MAJOR_VER      %d
 358 #define NASM_MINOR_VER      %d
 359 #define NASM_SUBMINOR_VER   %d
 360 #define NASM_PATCHLEVEL_VER %d
 361 END
 362
 363   if ($version->{snapshot}) {
 364     printf "#define NASM_SNAPSHOT       %d\n", $version->{snapshot};
 365   }
 366
 367   printf <<END, @$version{'xid','_line'};
 368 #define NASM_VERSION_ID     %s
 369 #define NASM_VER            "%s"
 370 #endif /* NASM_VERSION_H */
 371 END
 372   return;
 373 }
 374
 375
 376
 377 =item mac:
 378
 379   __NASM_MAJOR__
 380   __NASM_MINOR__
 381   __NASM_SUBMINOR__
 382   __NASM_PATCHLEVEL__
 383   __NASM_SNAPSHOT__
 384   __NASM_VERSION_ID__
 385   __NASM_VER__
 386
 387 =cut
 388
 389 sub mac{
 390   my($version) = @_;
 391   printf <<'END', @$version{'major','minor','subminor','patchlevel'};
 392 %%define __NASM_MAJOR__ %d
 393 %%define __NASM_MINOR__ %d
 394 %%define __NASM_SUBMINOR__ %d
 395 %%define __NASM_PATCHLEVEL__ %d
 396 END
 397
 398   if ($version->{snapshot}) {
 399     printf "%%define __NASM_SNAPSHOT__ %d\n", $version->{snapshot};
 400   }
 401
 402 printf <<'END', @$version{'id','_line'};
 403 %%define __NASM_VERSION_ID__ 0%08Xh
 404 %%define __NASM_VER__ "%s"
 405 END
 406   return;
 407 }
 408
 409
 410
 411 =item sed:
 412
 413   s/@@NASM_MAJOR@@/$major/g
 414   s/@@NASM_MINOR@@/$minor/g
 415   s/@@NASM_SUBMINOR@@/$sub_minor/g
 416   s/@@NASM_PATCHLEVEL@@/$patchlevel/g
 417   s/@@NASM_SNAPSHOT@@/$snapshot/g
 418   s/@@NASM_VERSION_ID@@/$id/g
 419   s/@@NASM_VERSION_XID@@/$xid/g
 420   s/@@NASM_VER@@/$ver/g
 421   s/@@NASM_MANGLED_VER@@/$mangled/g
 422
 423 =cut
 424
 425 sub sed{
 426   my($version) = @_;
 427   my @rep = @$version{qw{
 428     major
 429     minor
 430     subminor
 431     patchlevel
 432     snapshot
 433     id
 434     xid
 435     _line
 436     mangled
 437   }};
 438   no warnings 'uninitialized';
 439 sprintf <<'END', @rep;
 440 s/@@NASM_MAJOR@@/%d/g
 441 s/@@NASM_MINOR@@/%d/g
 442 s/@@NASM_SUBMINOR@@/%d/g
 443 s/@@NASM_PATCHLEVEL@@/%d/g
 444 s/@@NASM_SNAPSHOT@@/%d/g
 445 s/@@NASM_VERSION_ID@@/%d/g
 446 s/@@NASM_VERSION_XID@@/%s/g
 447 s/@@NASM_VER@@/%s/g
 448 s/@@NASM_MANGLED_VER@@/%s/g
 449 END
 450 }
 451
 452
 453
 454 =item make:
 455
 456   NASM_VER=$ver
 457   NASM_MAJOR_VER=$major
 458   NASM_MINOR_VER=$minor
 459   NASM_SUBMINOR_VER=$subminor
 460   NASM_PATCHLEVEL_VER=$patchlevel
 461
 462 =cut
 463
 464 sub make{
 465   my($version) = @_;
 466  return sprintf <<END, @$version{'_line','major','minor','subminor','patchlevel'};
 467 NASM_VER=%s
 468 NASM_MAJOR_VER=%d
 469 NASM_MINOR_VER=%d
 470 NASM_SUBMINOR_VER=%d
 471 NASM_PATCHLEVEL_VER=%d
 472 END
 473 }
 474
 475
 476 =item nsis:
 477
 478   !define VERSION "$version"
 479   !define MAJOR_VER $major
 480   !define MINOR_VER $minor
 481   !define SUBMINOR_VER $subminor
 482   !define PATCHLEVEL_VER $patchlevel
 483
 484 =cut
 485
 486 sub nsis{
 487   my($version) = @_;
 488  return sprintf <<'END', @$version{'_line','major','minor','subminor','patchlevel'};
 489 !define VERSION "%s"
 490 !define MAJOR_VER %d
 491 !define MINOR_VER %d
 492 !define SUBMINOR_VER %d
 493 !define PATCHLEVEL_VER %d
 494 END
 495 }
 496
 497
 498
 499 sub help{
 500   my($cmd) = @_;
 501
 502   my %help = (
 503     sed  => 'strings for sed command',
 504     mac  => 'strings for nasm macros',
 505     h    => 'strings for headers',
 506     make => 'strings for makefiles',
 507     perl => 'dump of program data',
 508     nsis => 'what is nsis?',
 509     json => 'dump of program data in json format',
 510     yaml => 'dump of program data in yaml format'
 511   );
 512
 513   if( $cmd and $help{$cmd} ){
 514     print $help{$cmd},"\n";
 515   }else{
 516     print "$0 [help]? [ ".join(' | ',keys %help)." ]\n";
 517   }
 518   return;
 519 }
 520
 521 =back
 522
 523 =cut