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 E<lt>majorE<gt>.E<lt>minorE<gt>[.E<lt>subminorE<gt>][
  24 plE<lt>patchlevelE<gt> |
  25 rcE<lt>numberE<gt>
  26 ]]E<lt>tailE<gt>
  27
  28 ... where E<lt>tailE<gt> is not necessarily numeric, but if it is of the form
  29 -E<lt>digitsE<gt> it is assumed to be a snapshot release.
  30
  31 =head1 Output Formats
  32
  33 =head2 id
  34
  35   print "$id\n"
  36
  37 =head2 xid
  38
  39   printf "0x%08x\n",$id
  40
  41 =cut
  42
  43
  44 use warnings;
  45 use strict;
  46
  47
  48 # forward definition of subroutines
  49 sub Load;
  50 sub help;
  51 sub h;
  52 sub mac;
  53 sub sed;
  54 sub make;
  55 sub nsis;
  56 sub yaml;
  57 sub json;
  58 sub perl;
  59
  60
  61
  62 # jump table to subroutines / variables
  63 my %jump = (
  64   id     => 'id',
  65   xid    => 'xid',
  66   hex_id => 'xid',
  67
  68   h      => \&h,
  69   mac    => \&mac,
  70   sed    => \&sed,
  71   make   => \&make,
  72   nsis   => \&nsis,
  73
  74   perl   => \&perl,
  75   dump   => \&perl,
  76   yaml   => \&yaml,
  77   yml    => \&yaml,
  78   json   => \&json,
  79   js     => \&json,
  80
  81   help   => \&help,
  82   usage  => sub{
  83     require Pod::Usage;
  84
  85     Pod::Usage::pod2usage(
  86       "run perldoc $0 or pod2text $0 for more information"
  87     );
  88   }
  89 );
  90
  91
  92 {
  93   use Scalar::Util 'reftype';
  94
  95   my($cmd, $filename) = @ARGV;
  96
  97   if(
  98     not $cmd or $cmd =~ m{
  99       ^
 100         -h |
 101         (?:--)?help |
 102         /[?]
 103       $
 104     }xi
 105   ){
 106     # in this case $filename is actually output format
 107     # we want to know more about
 108     $jump{help}->($filename);
 109     last;
 110
 111   }elsif($cmd eq 'usage'){
 112     $jump{usage}->();
 113   }
 114
 115   my $jump = $jump{$cmd};
 116   unless( $jump ){
 117     $jump{usage}->(cmd=>$cmd);
 118   }
 119
 120   my $version = Load($filename);
 121
 122   if( ref $jump ){
 123     my $reftype = reftype $jump;
 124
 125     if($reftype eq 'CODE'){
 126       my $ret = $jump->($version);
 127       print "$ret\n" if defined $ret;
 128
 129     }else{
 130       # an un-used reference type
 131       die;
 132     }
 133   }else{
 134     print $version->{$jump}, "\n";
 135   }
 136 }
 137
 138 sub Load{
 139   my($filename) = @_;
 140   $filename ||= '-';
 141   my %version;
 142
 143   {
 144     # only really required for this first match
 145     # could probably rewrite the match for earlier Perls
 146     require 5.010;
 147     my $line;
 148
 149     if($filename and $filename ne '-'){
 150       open my $file, '<', $filename or die;
 151
 152       $line = <$file>;
 153       close $file;
 154     }else{
 155       $line = <STDIN>;
 156     }
 157     chomp $line;
 158     die unless length $line;
 159     $version{_line} = $line;
 160
 161     $line =~ m{ ^
 162       (?<major>\d+)[.](?<minor>\d+)
 163       (?:[.](?<subminor>\d+))?
 164       (?:
 165         pl(?<patchlevel>\d+) |
 166         rc(?<rc>\d+)
 167       )?
 168       (?:
 169         [-](?<snapshot>\d+) |
 170         (?<tail>.+)
 171       )?
 172       $
 173     }x;
 174
 175     for my $key(qw'major minor subminor patchlevel rc'){
 176       my $value = $+{$key} || 0;
 177
 178       # removes any leading zeros by forcing to a number
 179       $version{$key} = $value + 0;
 180     }
 181     for my $key(qw'snapshot tail'){
 182       if(exists $+{$key}){
 183         $version{$key} = $+{$key};
 184       }
 185     }
 186   }
 187
 188
 189
 190
 191   # modify %version if this is a release candidate
 192   if($version{rc}){
 193     $version{patchlevel} = $version{rc} + 90;
 194
 195     if($version{subminor}){
 196       $version{subminor}--;
 197     }else{
 198       $version{subminor} = 99;
 199
 200       if($version{minor}){
 201         $version{minor}--;
 202       }else{
 203         $version{minor} = 99;
 204         $version{major}--;
 205       }
 206     }
 207   }
 208
 209
 210
 211   # add 'id' and 'xid' to %version
 212   $version{id} =
 213     ($version{major}    << 24) +
 214     ($version{minor}    << 16) +
 215     ($version{subminor} <<  8) +
 216     $version{patchlevel};
 217   $version{xid} = sprintf('0x%08x',$version{id});
 218
 219
 220
 221   # add 'mangled' to %version
 222   {
 223     my $mangled = sprintf("%d.%02d",$version{major},$version{minor});
 224     if(
 225       $version{subminor}   or
 226       $version{patchlevel} or
 227       $version{snapshot}
 228     ){
 229       $mangled .= sprintf(".%02d",$version{subminor});
 230
 231       if(
 232         $version{patchlevel} or
 233         $version{snapshot}
 234       ){
 235         $mangled .= sprintf(".%01d",$version{patchlevel})
 236       }
 237     }
 238
 239     if($version{snapshot}){
 240       $mangled .= '.'.$version{snapshot}
 241     }elsif( $version{tail}){
 242       my $tail = $version{tail};
 243       $tail =~ s/-/./g;
 244       $mangled .= $tail;
 245     }
 246
 247     $version{mangled} = $mangled;
 248   }
 249
 250   return  %version if wantarray;
 251   return \%version;
 252 }
 253
 254
 255 =head2 perl - returns a dump of internally used data
 256
 257   {
 258     'rc' => 10,
 259     'subminor' => 99,
 260     'minor' => 5,
 261     'mangled' => '2.05.99.100',
 262     'patchlevel' => 100,
 263     'id' => 33907556,
 264     'xid' => '0x02056364',
 265     'major' => 2
 266   }
 267
 268 =cut
 269
 270 sub perl{
 271   my($version)=@_;
 272   no warnings qw'once';
 273   require Data::Dumper;
 274   local $Data::Dumper::Terse = 1;
 275   local $Data::Dumper::Indent = 1;
 276
 277   my %ret = %$version;
 278   for( keys %ret ){
 279     # remove any "hidden" keys
 280     delete $ret{$_} if /^[_.]/;
 281   }
 282   return  Data::Dumper::Dumper(\%ret);
 283 }
 284
 285 =head2 yaml - returns the same thing as perl, but in YAML format
 286
 287   ---
 288   id: 33907556
 289   major: 2
 290   mangled: 2.05.99.100
 291   minor: 5
 292   patchlevel: 100
 293   rc: 10
 294   subminor: 99
 295   xid: 0x02056364
 296
 297 =cut
 298
 299 sub yaml{
 300   my($version)=@_;
 301   require YAML::XS;
 302   YAML::XS->import;
 303
 304   my %ret = %$version;
 305   for( keys %ret ){
 306     # remove any "hidden" keys
 307     delete $ret{$_} if /^[_.]/;
 308   }
 309   return Dump(\%ret);
 310 }
 311
 312 =head2 json - returns the same thing as perl, but in JSON format
 313
 314   {
 315     "rc" : 10,
 316     "subminor" : 99,
 317     "minor" : 5,
 318     "mangled" : "2.05.99.100",
 319     "patchlevel" : 100,
 320     "id" : 33907556,
 321     "xid" : "0x02056364",
 322     "major" : 2
 323   }
 324
 325 =cut
 326
 327 sub json{
 328   my($version)=@_;
 329   require JSON;
 330   #JSON->import;
 331
 332   my $json = new JSON;
 333
 334   my %ret = %$version;
 335   for( keys %ret ){
 336     # remove any "hidden" keys
 337     delete $ret{$_} if /^[_.]/;
 338   }
 339   return $json->pretty->encode(\%ret);
 340 }
 341
 342
 343 =head2 h
 344
 345   #ifndef NASM_VERSION_H
 346   #define NASM_VERSION_H
 347   #define NASM_MAJOR_VER      $major
 348   #define NASM_MINOR_VER      $minor
 349   #define NASM_SUBMINOR_VER   {$subminor   || 0}
 350   #define NASM_PATCHLEVEL_VER {$patchlevel || 0}
 351   #define NASM_SNAPSHOT       $snapshot         -- if snapshot
 352   #define NASM_VERSION_ID     $hex_id
 353   #define NASM_VER            "$ver"
 354   #endif /* NASM_VERSION_H */
 355
 356 =cut
 357
 358
 359   #NASM_MAJOR_VER
 360   #NASM_MINOR_VER
 361   #NASM_SUBMINOR_VER   -- this is zero if no subminor
 362   #NASM_PATCHLEVEL_VER -- this is zero is no patchlevel
 363   #NASM_SNAPSHOT       -- if snapshot
 364   #NASM_VERSION_ID     -- version number encoded
 365   #NASM_VER            -- whole version number as a string
 366
 367
 368
 369 sub h{
 370   my($version) = @_;
 371   printf <<END, @$version{'major','minor','subminor','patchlevel'};
 372 #ifndef NASM_VERSION_H
 373 #define NASM_VERSION_H
 374 #define NASM_MAJOR_VER      %d
 375 #define NASM_MINOR_VER      %d
 376 #define NASM_SUBMINOR_VER   %d
 377 #define NASM_PATCHLEVEL_VER %d
 378 END
 379
 380   if ($version->{snapshot}) {
 381     printf "#define NASM_SNAPSHOT       %d\n", $version->{snapshot};
 382   }
 383
 384   printf <<END, @$version{'xid','_line'};
 385 #define NASM_VERSION_ID     %s
 386 #define NASM_VER            "%s"
 387 #endif /* NASM_VERSION_H */
 388 END
 389   return;
 390 }
 391
 392
 393
 394 =head2 mac
 395
 396   __NASM_MAJOR__ $major
 397   __NASM_MINOR__ $minor
 398   __NASM_SUBMINOR__ $subminor
 399   __NASM_PATCHLEVEL__ $patchlevel
 400   __NASM_SNAPSHOT__ $snapshot     -- if snapshot
 401   __NASM_VERSION_ID__ $hex_id
 402   __NASM_VER__ $ver
 403
 404 =cut
 405
 406 sub mac{
 407   my($version) = @_;
 408   printf <<'END', @$version{'major','minor','subminor','patchlevel'};
 409 %%define __NASM_MAJOR__ %d
 410 %%define __NASM_MINOR__ %d
 411 %%define __NASM_SUBMINOR__ %d
 412 %%define __NASM_PATCHLEVEL__ %d
 413 END
 414
 415   if ($version->{snapshot}) {
 416     printf "%%define __NASM_SNAPSHOT__ %d\n", $version->{snapshot};
 417   }
 418
 419 printf <<'END', @$version{'id','_line'};
 420 %%define __NASM_VERSION_ID__ 0%08Xh
 421 %%define __NASM_VER__ "%s"
 422 END
 423   return;
 424 }
 425
 426
 427
 428 =head2 sed
 429
 430   s/@@NASM_MAJOR@@/$major/g
 431   s/@@NASM_MINOR@@/$minor/g
 432   s/@@NASM_SUBMINOR@@/$sub_minor/g
 433   s/@@NASM_PATCHLEVEL@@/$patchlevel/g
 434   s/@@NASM_SNAPSHOT@@/$snapshot/g
 435   s/@@NASM_VERSION_ID@@/$id/g
 436   s/@@NASM_VERSION_XID@@/$hex_id/g
 437   s/@@NASM_VER@@/$ver/g
 438   s/@@NASM_MANGLED_VER@@/$mangled/g
 439
 440 =cut
 441
 442 sub sed{
 443   my($version) = @_;
 444   my @rep = @$version{qw{
 445     major
 446     minor
 447     subminor
 448     patchlevel
 449     snapshot
 450     id
 451     xid
 452     _line
 453     mangled
 454   }};
 455   no warnings 'uninitialized';
 456 sprintf <<'END', @rep;
 457 s/@@NASM_MAJOR@@/%d/g
 458 s/@@NASM_MINOR@@/%d/g
 459 s/@@NASM_SUBMINOR@@/%d/g
 460 s/@@NASM_PATCHLEVEL@@/%d/g
 461 s/@@NASM_SNAPSHOT@@/%d/g
 462 s/@@NASM_VERSION_ID@@/%d/g
 463 s/@@NASM_VERSION_XID@@/%s/g
 464 s/@@NASM_VER@@/%s/g
 465 s/@@NASM_MANGLED_VER@@/%s/g
 466 END
 467 }
 468
 469
 470
 471 =head2 make
 472
 473   NASM_VER=$ver
 474   NASM_MAJOR_VER=$major
 475   NASM_MINOR_VER=$minor
 476   NASM_SUBMINOR_VER=$subminor
 477   NASM_PATCHLEVEL_VER=$patchlevel
 478
 479 =cut
 480
 481 sub make{
 482   my($version) = @_;
 483  return sprintf <<END, @$version{'_line','major','minor','subminor','patchlevel'};
 484 NASM_VER=%s
 485 NASM_MAJOR_VER=%d
 486 NASM_MINOR_VER=%d
 487 NASM_SUBMINOR_VER=%d
 488 NASM_PATCHLEVEL_VER=%d
 489 END
 490 }
 491
 492
 493 =head2 nsis
 494
 495   !define VERSION "$version"
 496   !define MAJOR_VER $major
 497   !define MINOR_VER $minor
 498   !define SUBMINOR_VER $subminor
 499   !define PATCHLEVEL_VER $patchlevel
 500
 501 =cut
 502
 503 sub nsis{
 504   my($version) = @_;
 505  return sprintf <<'END', @$version{'_line','major','minor','subminor','patchlevel'};
 506 !define VERSION "%s"
 507 !define MAJOR_VER %d
 508 !define MINOR_VER %d
 509 !define SUBMINOR_VER %d
 510 !define PATCHLEVEL_VER %d
 511 END
 512 }
 513
 514
 515 sub help{
 516   my($cmd) = @_;
 517
 518   my %help = (
 519     sed  => 'strings for sed command',
 520     mac  => 'strings for nasm macros',
 521     h    => 'strings for headers',
 522     make => 'strings for makefiles',
 523     perl => 'dump of program data',
 524     nsis => 'what is nsis?',
 525     json => 'dump of program data in json format',
 526     yaml => 'dump of program data in yaml format'
 527   );
 528
 529   if( $cmd and $help{$cmd} ){
 530     print $help{$cmd},"\n";
 531   }else{
 532     print "$0 [help]? [ ".join(' | ',keys %help)." ]\n";
 533   }
 534   return;
 535 }