d6e260a41347130499705169978f7446a2256e45
[nasm/perl-rewrite.git] / 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 }