WebSVN – DevTools – Blame – /core_devl/trunk/TOOLS/jats_rewrite.pl

Rev	Author	Line No.	Line
227	dpurdie	1	`########################################################################`
6177	dpurdie	2	`# COPYRIGHT - VIX IP PTY LTD ("VIX"). ALL RIGHTS RESERVED.`
227	dpurdie	3	`#`
263	dpurdie	4	`# Module name : jats_rewrite.pl`
		5	`# Module type : JATS Utility`
		6	`# Compiler(s) : Perl`
227	dpurdie	7	`# Environment(s): jats`
		8	`#`
		9	`# Description : Rewrite a build.pl file`
		10	`# Use an external configuration file to provide a common`
		11	`# source of configuration information`
		12	`#`
263	dpurdie	13	`# Usage : See POD`
227	dpurdie	14	`#`
		15	`#......................................................................#`
		16
255	dpurdie	17	`require 5.006_001;`
227	dpurdie	18	`use strict;`
		19	`use warnings;`
		20
		21	`use JatsError;`
		22	`use BuildName;`
		23	`use Getopt::Long;`
		24	`use Pod::Usage; # required for help support`
		25
		26
		27	`################################################################################`
		28	`# Option variables`
		29	`#`
		30
281	dpurdie	31	`my $VERSION = "1.4.0"; # Update this`
227	dpurdie	32	`my $opt_verbose = 0;`
		33	`my $opt_datafile = "";`
		34	`my $opt_ofile = "auto.pl";`
		35	`my $opt_infile = "build.pl";`
		36	`my $opt_help = 0;`
		37	`my $opt_errors = 0;`
		38	`my $opt_xml;`
		39	`my $opt_oldproject;`
		40	`my $opt_newproject;`
263	dpurdie	41	`my $opt_noconfig;`
281	dpurdie	42	`my $opt_validate;`
323	dpurdie	43	`my $opt_mode = 0;`
		44	`my $opt_work_file = 'auto.new';`
6619	dpurdie	45	`my $opt_zero;`
227	dpurdie	46
		47	`#`
		48	`# Globals`
		49	`#`
		50	`my %component = ();`
		51	`my %component_use = ();`
		52	`my $suffix_count = 0;`
281	dpurdie	53	`my @pkg_errors;`
		54	`my @pkg_errors_val;`
		55	`my $max_pkglen = 10;`
6619	dpurdie	56	`my $max_verlen = 15;`
227	dpurdie	57
247	dpurdie	58	`#`
		59	`# Known extended fields`
		60	`# Only these values may be configured with the value=tag syntax`
		61	`# These may not be used as package names`
		62	`#`
		63	`my %fields = (`
		64	`'releasemanager.releasename' => undef,`
		65	`'releasemanager.projectname' => undef,`
		66	`);`
227	dpurdie	67
		68	`my $result = GetOptions (`
281	dpurdie	69	`"help:+" => \$opt_help, # flag, multiple use allowed`
		70	`"manual:3" => \$opt_help, # flag`
		71	`"verbose:+" => \$opt_verbose, # flag`
		72	`"config=s" => \$opt_datafile, # string`
		73	`"noconfig" => \$opt_noconfig, # flag`
		74	`"outfile=s" => \$opt_ofile, # string`
		75	`"infile=s" => \$opt_infile, # string`
		76	`"errors" => \$opt_errors, # flag`
		77	`"xml!" => \$opt_xml, # flag`
		78	`"oldproject=s" => \$opt_oldproject, # string`
		79	`"newproject=s" => \$opt_newproject, # string`
		80	`"validate" => \$opt_validate, # flag`
6619	dpurdie	81	`"zero!" => \$opt_zero, # flag`
323	dpurdie	82	`"mode=s" => \$opt_mode, # Flag`
227	dpurdie	83	`);`
		84
		85	`#`
		86	`# Process help and manual options`
		87	`#`
		88	`pod2usage(-verbose => 0, -message => "Version: $VERSION") if ($opt_help == 1 \|\| ! $result);`
		89	`pod2usage(-verbose => 1) if ($opt_help == 2 );`
263	dpurdie	90	`pod2usage(-verbose => 2) if ($opt_help > 2);`
227	dpurdie	91
		92	`#`
		93	`# Configure the error reporting process now that we have the user options`
		94	`#`
		95	`ErrorConfig( 'name' =>'REWRITE',`
		96	`'verbose' => $opt_verbose );`
		97
		98	`Error ("Must specify both Old and New project tags")`
		99	`if ( $opt_newproject xor $opt_oldproject );`
		100
263	dpurdie	101	`Error ("Conflicting options -config=file and -noconfig")`
		102	`if ( $opt_datafile && $opt_noconfig );`
		103
227	dpurdie	104	`Error ("No configuration file specified")`
6619	dpurdie	105	`unless ( $opt_datafile \|\| $opt_newproject \|\| $opt_noconfig \|\| $opt_zero );`
227	dpurdie	106
323	dpurdie	107	`Warning ("Input and output file are the same" )`
6619	dpurdie	108	`if ( !$opt_zero && !$opt_mode && $opt_infile eq $opt_ofile );`
227	dpurdie	109
		110	`#`
		111	`# Auto detect XML files`
		112	`#`
		113	`$opt_xml = 1`
		114	`if ( $opt_infile =~ m~\.xml$~i );`
		115
		116	`#`
323	dpurdie	117	`# When opt_mode is invoked, allow reuse auto.xxx files`
		118	`# if they are present. The user may be changing the file`
		119	`#`
		120	`if ( $opt_mode )`
		121	`{`
		122	`#`
341	dpurdie	123	`# Use later of build.pl or auto.pl for input`
323	dpurdie	124	`#`
		125	`my $bstamp = -M "build.pl";`
		126	`my $astamp = -M "auto.pl";`
		127	`$opt_infile = 'auto.pl'`
		128	`if ( $astamp && $astamp < $bstamp );`
		129
		130	`$opt_infile = 'auto.xml' if ( -f 'auto.xml' );`
		131	`}`
6619	dpurdie	132	`Message ("Rewrite : $opt_infile -> $opt_ofile");`
323	dpurdie	133
		134	`#`
227	dpurdie	135	`# Process config and input files`
		136	`#`
		137	`read_config_file() if $opt_datafile;`
		138	`process_build_file() unless( $opt_xml);`
		139	`process_xml_build_file() if ( $opt_xml);`
		140
		141	`Verbose ("Number of project extensions changed: $suffix_count")`
		142	`if ( $ opt_newproject );`
		143
		144	`Warning("No project extensions changed")`
		145	`if ( !$suffix_count && $opt_newproject);`
		146
323	dpurdie	147	`#`
		148	`# Report errors or warnings for packages that are not in the configuration`
		149	`# File. These will not have been updated inthe output file.`
		150	`#`
281	dpurdie	151	`if ( @pkg_errors \|\| @pkg_errors_val)`
		152	`{`
323	dpurdie	153	`my $report = $opt_mode ? \&Warning : \&ReportError;`
		154	`$report->("Errors encountered in the following packages:");`
		155	`$report->( @pkg_errors );`
		156	`$report->( @pkg_errors_val );`
		157	`$report->( "Package Names and Versions in build files may not match Release Manager");`
281	dpurdie	158	`}`
		159
		160	`ErrorDoExit();`
227	dpurdie	161	`exit 0;`
		162
		163	`#-------------------------------------------------------------------------------`
		164	`# Function : read_config_file`
		165	`#`
		166	`# Description : Read and store config file information`
		167	`#`
		168	`# Inputs :`
		169	`#`
		170	`# Returns :`
		171	`#`
		172
		173	`sub read_config_file`
		174	`{`
		175	`open ( FILE, "<$opt_datafile" ) or Error ("Config file ($opt_datafile) not found" );`
		176	`while ( <FILE> )`
		177	`{`
		178	`#`
		179	`# Clean up lines`
		180	`# Skip comments and blank lines`
		181	`# Remove leading and training white space`
		182	`#`
		183	`chomp;`
		184	`s~^\s*~~;`
		185	`s~#.*$~~;`
		186	`s~\s*$~~;`
		187	`next if ( length( $_) <= 0 );`
		188
		189	`# Verbose ($_);`
		190
		191	`#`
247	dpurdie	192	`# Extract special fields`
		193	`# These are not dependent packages and are not mandatory`
		194	`# These are of the form tag = name`
359	dpurdie	195	`# Note: Must allow for package-versions like: "SUNWj6rt 1.6.0,REV=2006.11.29.05.03"`
		196	`# Solution: tag must not conatin whitespace`
247	dpurdie	197	`#`
359	dpurdie	198	`if ( m{^\s(\S+)\s=\s*(.+)} )`
247	dpurdie	199	`{`
359	dpurdie	200	`Error ("Unsupported named field: $1") unless ( exists $fields{$1} );`
247	dpurdie	201	`$fields{$1} = $2;`
		202	`Verbose ("Field: $1, \"$2\"");`
		203	`next;`
		204	`}`
		205
		206	`#`
227	dpurdie	207	`# Process LinkPkgArchive and BuildPkgArchive statements`
		208	`# These allow simple updating of the config file from Release manager`
		209	`#`
		210	`if ( m/LinkPkgArchive/ or m/BuildPkgArchive/ )`
		211	`{`
		212	`m/'(.)'[^']'(.*)'/;`
		213
		214	`my $comp = $1;`
		215	`my $ver = $2;`
		216
		217	`#print "Got Archive stuff: $_ : $comp, $ver\n";`
		218
		219	`Error "Version not specified for: $comp" unless ( $ver );`
347	dpurdie	220	`Warning "Suspect version format for: $comp ($ver)" unless ( $opt_mode \|\| $ver =~ m~^\w+\.\w+\.\w+.\w+$~ \|\| $ver =~ m~^\w+\.\w+\.\w+$~ \|\| $ver =~ m~\.cots$~);`
227	dpurdie	221
		222	`save_package( $comp, $ver );`
		223	`next;`
		224	`}`
		225
		226
		227
		228	`#`
		229	`# Process line as`
		230	`# component version`
		231	`#`
		232	`my ( $comp, $ver, $opt ) = split( /[\s,]+/, $_, 3);`
		233	`Error "Version not specified for: $comp" unless ( $ver );`
347	dpurdie	234	`Warning "Suspect version format for: $comp ($ver)" unless ( $opt_mode \|\| $ver =~ m~^\w+\.\w+\.\w+.\w+$~ \|\| $ver =~ m~^\w+\.\w+\.\w+$~ \|\| $ver =~ m~\.cots$~);`
227	dpurdie	235	`save_package( $comp, $ver );`
		236	`}`
		237	`close FILE;`
		238
		239	`# DebugDumpData ("component", \%component );`
		240	`}`
		241
		242	`#-------------------------------------------------------------------------------`
		243	`# Function : print_update`
		244	`#`
		245	`# Description : Generate a display line tracking the changes made`
		246	`#`
		247	`# Inputs :`
		248	`# $title - Update Type`
		249	`# $name - Package name`
		250	`# $version - Original version of package`
		251	`# $new_version - New version`
		252	`#`
		253	`# Returns :`
		254	`#`
		255	`sub print_update`
		256	`{`
		257	`my ($title, $name, $version, $new_version ) = @_;`
		258	`my $diff = ( $version ne $new_version ) ? '*' : '';`
		259
		260	`#`
		261	`# Always display diffs`
		262	`# Display all if verbose`
		263	`#`
323	dpurdie	264	`if ( $diff \|\| $opt_verbose \|\| $opt_mode )`
227	dpurdie	265	`{`
		266	`$title = 'Package' unless ( $title );`
6619	dpurdie	267	`Message( sprintf("%-8s: %-${max_pkglen}s , Version: %-${max_verlen}s %1.1s-> %-${max_verlen}s\n", $title, $name ,$version, $diff, $new_version));`
227	dpurdie	268	`}`
		269	`}`
		270
		271	`#-------------------------------------------------------------------------------`
		272	`# Function : process_build_file`
		273	`#`
		274	`# Description : Rewrite one file`
323	dpurdie	275	`# build.pl -> auto.pl`
227	dpurdie	276	`#`
		277	`# Inputs :`
		278	`#`
		279	`# Returns :`
		280	`#`
		281	`sub process_build_file`
		282	`{`
		283	`Verbose ("Processing build file: $opt_infile");`
		284
3559	dpurdie	285	`my $build_info;`
		286	`my $release_name;`
		287	`my $release_version;`
6619	dpurdie	288	`my @inputLines;`
3559	dpurdie	289
227	dpurdie	290	`#`
		291	`# Unlink any OLD output file`
		292	`#`
323	dpurdie	293	`unlink $opt_work_file;`
227	dpurdie	294
		295	`#`
3559	dpurdie	296	`# Open the output file`
227	dpurdie	297	`#`
323	dpurdie	298	`open ( OUTFILE, ">$opt_work_file" ) \|\| Error( "Cannot create $opt_work_file", $! );`
4898	dpurdie	299	`binmode(OUTFILE);`
227	dpurdie	300
3559	dpurdie	301	`#`
		302	`# Read input file and process as an array of lines`
		303	`#`
6619	dpurdie	304	`@inputLines = getInputLines($opt_infile);`
		305
		306	`#`
		307	`# Scan the input file and do a quick examine`
		308	`# of the package names. All we are doing is determining the max package name lenght`
		309	`# so that we can generate a pretty display.`
		310	`#`
		311	`$max_pkglen = $max_verlen = 0;`
		312	`foreach ( @inputLines )`
227	dpurdie	313	`{`
263	dpurdie	314	`next if ( $opt_noconfig ); # Nothing to do`
227	dpurdie	315	`next if ( m~^\s*#~ ); # Skip comments`
6619	dpurdie	316	`#`
		317	`# Process BuildPkgArchive and LinkPkgArchive`
		318	`if ( m/^\sLinkPkgArchive/ or m/^\sBuildPkgArchive/ )`
		319	`{`
		320	`m/['"](.?)['"][^'"]['"](.*?)['"]/;`
3559	dpurdie	321
6619	dpurdie	322	`my $comp = $1;`
		323	`my $ver = $2;`
		324
		325	`my $len = length $comp;`
		326	`$max_pkglen = $len if ( $len > $max_pkglen );`
		327	`$len = length $ver;`
		328	`$max_verlen = $len if ( $len > $max_verlen );`
		329	`}`
		330	`}`
		331
		332	`#`
		333	`# Process the input lines and re-write the version numbers`
		334	`#`
		335	`foreach ( @inputLines )`
		336	`{`
		337	`next if ( $opt_noconfig ); # Nothing to do`
		338	`next if ( m~^\s*#~ ); # Skip comments`
		339
227	dpurdie	340	`#`
		341	`# Process BuildName`
		342	`#`
323	dpurdie	343	`if ( m~\s*BuildName[\s\(]~ )`
227	dpurdie	344	`{`
		345	`# Build names come in many flavours`
		346	`# Must support a number of different formats`
		347	`# "name nn.nn.nn prj"`
		348	`# "name nn.nn.nn.prj"`
		349	`#`
		350	`# "name nn.nn.nn prj", "nn.nn.nn"`
		351	`# "name nn.nn.nn.prj", "nn.nn.nn"`
		352	`#`
		353	`# "name", "nn.nn.nn.prj"`
		354	`#`
		355	`m~$\s(.?)\s*$~;`
		356	`my @args = split /\s,\s/, $1;`
		357	`$build_info = parseBuildName( @args );`
323	dpurdie	358	`my $new_ver;`
227	dpurdie	359
323	dpurdie	360	`#`
		361	`# In Special Mode, don't change the version of this package`
		362	`# Assume that the user has fiddled with it.`
		363	`#`
6619	dpurdie	364	`if ( $opt_mode && !$opt_zero ) {`
323	dpurdie	365	`$new_ver = $build_info->{BUILDVERSION};`
		366	`} else {`
		367	`$new_ver = get_package ( $build_info->{BUILDNAME_PACKAGE}, $build_info->{BUILDVERSION} );`
		368	`}`
227	dpurdie	369	`my $build_args = genBuildName( $build_info, $new_ver );`
		370
		371	`#`
		372	`# Rewrite the body of the directive`
		373	`#`
		374	`s~$\s(.?)\s*$~( $build_args )~;`
323	dpurdie	375	`print_update( 'Name', $build_info->{BUILDNAME_PACKAGE}, $build_info->{BUILDVERSION}, $new_ver );`
227	dpurdie	376
		377	`}`
		378
		379	`#`
		380	`# Process BuildPreviousVersion`
		381	`# Save the current version information in this directive`
		382	`#`
323	dpurdie	383	`if ( m/^\s*BuildPreviousVersion/ && ! $opt_mode )`
227	dpurdie	384	`{`
		385	`Error ("BuildPreviousVersion directive before BuildName") unless ( $build_info );`
		386	`m/['"](.*?)['"]/;`
		387	`my $prev = $1;`
281	dpurdie	388	`my $new_ver = $opt_validate ? $prev : $build_info->{BUILDVERSION};`
227	dpurdie	389
		390	`s/['"](.*?)['"]/'$build_info->{BUILDVERSION}'/;`
281	dpurdie	391	`print_update( 'PrevVer', '', $prev, $new_ver );`
227	dpurdie	392	`}`
		393
		394	`#`
		395	`# Process BuildPkgArchive and LinkPkgArchive`
		396	`if ( m/^\sLinkPkgArchive/ or m/^\sBuildPkgArchive/ )`
		397	`{`
		398	`m/['"](.?)['"][^'"]['"](.*?)['"]/;`
		399
		400	`my $comp = $1;`
		401	`my $ver = $2;`
		402	`my $new_ver = get_package ( $comp, $ver );`
		403	`s/['"](.?)['"]([^'"])['"](.*?)['"]/'$comp'$2'$new_ver'/;`
		404	`print_update ('', $comp ,$ver, $new_ver );`
		405	`}`
		406
		407
		408	`} continue`
		409	`{`
		410	`#`
		411	`# Always output the resultant line`
		412	`#`
		413	`print OUTFILE $_;`
		414	`}`
		415
		416	`#`
		417	`# Cleanup`
		418	`#`
		419	`close OUTFILE;`
3967	dpurdie	420	`unlink( $opt_ofile);`
		421	`rename ($opt_work_file ,$opt_ofile);`
227	dpurdie	422	`display_unused();`
		423	`}`
		424
		425	`#-------------------------------------------------------------------------------`
		426	`# Function : process_xml_build_file`
		427	`#`
		428	`# Description : Rewrite one depends.xml file`
		429	`# depends.xml -> auto.xml`
		430	`#`
		431	`# A very cheap and nasty XML (not)parser`
		432	`# It assumes that entries are all on one line so that we can`
		433	`# do trivial substitutions`
		434	`#`
		435	`# Processes`
		436	`# <using ... >`
247	dpurdie	437	`# <property name="packagename" value="...">`
		438	`# <property name="packageversion" value="...">`
		439	`# <property name="releasemanager.releasename" value="...">`
		440	`# <property name="releasemanager.projectname" value="...">`
227	dpurdie	441	`# <import file=...>`
		442	`#`
247	dpurdie	443	`# Note: This function handles a wider scope of XML files`
		444	`# than it really needs to. All thats needed is`
249	dpurdie	445	`# the <property name= value=> fields.`
227	dpurdie	446	`#`
		447	`# Inputs :`
		448	`#`
		449	`# Returns :`
		450	`#`
		451	`sub process_xml_build_file`
		452	`{`
7326	dpurdie	453	`Verbose ("Processing: " . "$opt_infile");`
227	dpurdie	454
3559	dpurdie	455	`my $release_name;`
		456	`my $release_version;`
		457
227	dpurdie	458	`#`
		459	`# Unlink any OLD output file`
		460	`#`
323	dpurdie	461	`unlink $opt_work_file;`
227	dpurdie	462
		463	`#`
3559	dpurdie	464	`# Open the output file`
227	dpurdie	465	`#`
323	dpurdie	466	`open ( OUTFILE, ">$opt_work_file" ) \|\| Error( "Cannot create $opt_work_file", $! );`
4898	dpurdie	467	`binmode(OUTFILE);`
227	dpurdie	468
3559	dpurdie	469	`#`
		470	`# Read input file and process as an array of lines`
		471	`#`
		472	`foreach ( getInputLines($opt_infile) )`
227	dpurdie	473	`{`
263	dpurdie	474	`next if ( $opt_noconfig ); # Nothing to do`
227	dpurdie	475	`#`
		476	`# Process "project" statement`
		477	`#`
		478	`if ( m~<project~ )`
		479	`{`
		480	`# Extract the package name`
		481	`# this to determine the required version of the package`
		482	`#`
249	dpurdie	483	`if ( m~name="([^"]*)"~ )`
233	dpurdie	484	`{`
		485	`$release_name = $1;`
		486	`Error ("Empty 'name' attribute not found in 'project'") unless ( $release_name );`
		487	`Verbose2 ("Project: $release_name");`
		488	`}`
227	dpurdie	489	`}`
		490
		491	`#`
		492	`# Process "property" statements`
		493	`#`
		494	`elsif ( m~<property~ )`
		495	`{`
		496	`#`
247	dpurdie	497	`# Extract name and value`
		498	`# Both must exist`
227	dpurdie	499	`#`
247	dpurdie	500	`my $name;`
		501	`my $value;`
227	dpurdie	502
249	dpurdie	503	`if ( m~name="([^"]*)"~ )`
247	dpurdie	504	`{`
		505	`$name = $1;`
		506	`}`
		507	`else`
		508	`{`
		509	`Error ("Name attribute not found in 'property'");`
		510	`}`
		511
249	dpurdie	512	`if ( m~value="([^"]*)"~ )`
247	dpurdie	513	`{`
		514	`$value = $1;`
		515	`}`
		516	`else`
		517	`{`
		518	`Error ("Value attribute not found in $name 'property'");`
		519	`}`
		520	`Verbose2 ("Property: $name, Value: $value");`
		521
227	dpurdie	522	`#`
323	dpurdie	523	`# Examine the property name`
247	dpurdie	524	`# Some of the them are special, others will be package names`
227	dpurdie	525	`#`
		526	`if ( $name eq 'packagename' )`
		527	`{`
247	dpurdie	528	`$release_name = $value;`
227	dpurdie	529	`Error ("Value attribute not found in packagename 'property'") unless ( $release_name );`
		530	`}`
		531	`elsif ( $name eq 'packageversion' )`
		532	`{`
247	dpurdie	533	`$release_version = $value;`
227	dpurdie	534
		535	`#`
		536	`# Ensure that we already have the package name`
		537	`#`
		538	`Error ("packageversion before packagename") unless ( $release_name );`
		539
		540	`my $new_ver = get_package ( $release_name, $release_version );`
249	dpurdie	541	`s~(.)value="([^"])"~$1value=\"$new_ver\"~;`
323	dpurdie	542	`print_update( 'Name', $release_name ,$release_version, $new_ver );`
227	dpurdie	543	`}`
247	dpurdie	544	`elsif ( defined $fields{$name} )`
227	dpurdie	545	`{`
		546	`#`
247	dpurdie	547	`# Use tagged values in preference to packages`
		548	`# There are very few tagged values.`
227	dpurdie	549	`#`
247	dpurdie	550	`my $new_value = $fields{$name};`
		551	`Error ("Release attribute not found: $name") unless ( $new_value );`
		552
249	dpurdie	553	`s~(.)value="([^"])"~$1value=\"$new_value\"~;`
247	dpurdie	554	`print_update( 'Release', $name ,$value, $new_value );`
227	dpurdie	555	`}`
		556	`else`
		557	`{`
247	dpurdie	558	`my $new_ver = get_package ( $name, $value );`
249	dpurdie	559	`s~(.)value="([^"])"~$1value=\"$new_ver\"~;`
247	dpurdie	560	`print_update( '', $name ,$value, $new_ver );`
227	dpurdie	561	`}`
		562	`}`
		563
		564	`#`
		565	`# Process "using" statements`
		566	`#`
		567	`elsif ( m~<using~ )`
		568	`{`
		569	`#`
		570	`# Extract the package name and version`
		571	`# and use this to determine the required version of the package`
		572	`#`
249	dpurdie	573	`m~name="([^"]*)"~;`
227	dpurdie	574	`my $name = $1;`
		575	`Error ("Name attribute not found in 'using'") unless ( $name );`
		576	`Verbose2 ("Using: $name");`
		577
		578	`#`
		579	`# Extract the version`
		580	`#`
249	dpurdie	581	`m~version="([^"]*)"~;`
227	dpurdie	582	`$release_version = $1;`
		583	`Error ("Version attribute not found in package 'using' : $name") unless ( $release_version );`
		584
		585	`my $new_ver = get_package ( $name, $release_version );`
249	dpurdie	586	`s~(.)version="([^"])"~$1version=\"$new_ver\"~;`
227	dpurdie	587	`print_update( '', $name ,$release_version, $new_ver );`
		588	`}`
		589
		590	`#`
		591	`# Import File`
247	dpurdie	592	`# Only used to import ant-using`
227	dpurdie	593	`#`
		594	`elsif ( m~<import~ )`
		595	`{`
		596	`#`
		597	`# Extract the file`
		598	`#`
249	dpurdie	599	`m~file="([^"]*)"~;`
227	dpurdie	600	`my $file = $1;`
		601	`Error ("File attribute not found in 'import'") unless ( $file );`
		602
		603	`#`
		604	`# Extract the package name and version from the file`
		605	`# Will be of the form /package/version/filename`
		606	`#`
		607	`$file =~ m~(.*?)/([^/]+)/([^/]+)/([^/]+)$~;`
		608	`my $prefix = $1;`
		609	`my $pname = $2;`
		610	`my $pver = $3;`
		611	`my $fname = $4;`
		612	`Error ("Package details not found in import file") unless ( $fname );`
		613
		614	`my $new_ver = get_package ( $pname, $pver );`
		615
		616	`#`
		617	`# Rewrite the body of the directive`
		618	`#`
249	dpurdie	619	`s~(.)file="([^"])"~$1file=\"$prefix/$pname/$new_ver/$fname\"~;`
227	dpurdie	620	`print_update( '', $pname ,$pver, $new_ver );`
		621	`}`
		622
		623	`} continue`
		624	`{`
		625	`#`
		626	`# Always output the resultant line`
		627	`#`
		628	`print OUTFILE $_;`
		629	`}`
		630
		631	`#`
		632	`# Cleanup`
		633	`#`
		634	`close OUTFILE;`
323	dpurdie	635	`unlink $opt_ofile;`
		636	`rename $opt_work_file ,$opt_ofile;`
227	dpurdie	637	`display_unused();`
		638	`}`
		639
		640	`#-------------------------------------------------------------------------------`
3559	dpurdie	641	`# Function : getInputLines`
		642	`#`
		643	`# Description : Slurp into the input file and create an array of lines`
		644	`# Must handle files with a mix of line endings`
		645	`#`
		646	`#`
		647	`# Inputs : File to slurp`
		648	`#`
		649	`# Returns : An array of lines`
		650	`# Line endings preserved`
		651	`#`
		652	`sub getInputLines`
		653	`{`
		654	`my ($infile) = @_;`
		655	`my @lines;`
		656
		657	`#`
		658	`# Open the input file`
		659	`#`
		660	`open ( INFILE, "<$infile" ) \|\| Error( "Cannot read from $infile", $! );`
4898	dpurdie	661	`binmode(INFILE);`
3559	dpurdie	662
		663	`# Read the entire file and break into lines`
		664	`# Need to handle files that are a mix of Unix and Windows line endings`
		665	`# Attempt to preserve the line style`
		666
		667	`while ( <INFILE> )`
		668	`{`
		669	`s~([\n\r]+)$~~;`
		670	`my $eol = $1;`
		671	`if ( my @line = split(/[\r\n]+/, $_) ) {`
		672	`push @lines, $_ . $eol foreach (@line );`
		673	`} else {`
		674	`push @lines, $eol;`
		675	`}`
		676	`}`
3967	dpurdie	677	`close INFILE;`
3559	dpurdie	678	`return @lines;`
		679	`}`
		680
		681	`#-------------------------------------------------------------------------------`
227	dpurdie	682	`# Function : display_unused`
		683	`#`
		684	`# Description : Generate warnings about config items that were not used`
5820	dpurdie	685	`# If we are in 'error' mode , then simply push the messages`
		686	`# onto the error list`
227	dpurdie	687	`#`
		688	`# Inputs :`
		689	`#`
		690	`# Returns :`
		691	`#`
		692	`sub display_unused`
		693	`{`
323	dpurdie	694	`return`
6619	dpurdie	695	`if ( $opt_mode \|\| $opt_zero );`
323	dpurdie	696
227	dpurdie	697	`foreach my $comp ( sort keys %component_use )`
		698	`{`
		699	`foreach my $suf ( keys %{$component_use{$comp}} )`
		700	`{`
		701	`my $ver = get_version( $comp, $suf );`
5820	dpurdie	702	`my $msg = "Unused package: '${comp}_${ver}'";`
		703	`if ($opt_errors)`
		704	`{`
		705	`push @pkg_errors, $msg;`
		706	`}`
		707	`else`
		708	`{`
		709	`Warning("Unused package: ${comp}_${ver}");`
		710	`}`
227	dpurdie	711	`}`
		712	`}`
		713	`}`
		714
		715	`#-------------------------------------------------------------------------------`
		716	`# Function : save_package`
		717	`#`
		718	`# Description : Save the package name and version`
		719	`#`
		720	`# Inputs : $package`
		721	`# $version`
		722	`#`
		723	`# Returns : Nothing`
		724	`#`
		725	`sub save_package`
		726	`{`
		727	`my ($package, $version) = @_;`
		728
		729	`#`
281	dpurdie	730	`# Determine longest package name`
		731	`#`
		732	`my $len = length $package;`
6619	dpurdie	733	`$max_pkglen = $len if ( $len > $max_pkglen );`
281	dpurdie	734
6619	dpurdie	735	`$len = length $version;`
		736	`$max_verlen = $len if ( $len > $max_verlen );`
		737
281	dpurdie	738	`#`
227	dpurdie	739	`# Split the suffix off the version`
		740	`#`
		741	`my ($rel, $suf ) = extract_version( $package, $version);`
		742
		743	`Error ("Multiple definitions for $package $version" )`
		744	`if ( $component{$package}{$suf} );`
		745
247	dpurdie	746	`Error ("Package Name is a reserved key field: $package" )`
		747	`if ( exists $fields{$package} );`
		748
227	dpurdie	749	`$component{$package}{$suf} = $rel;`
		750	`$component_use{$package}{$suf} = $rel;`
		751
		752	`Verbose2 ("Package: $package, $version, $rel, $suf");`
		753
		754	`}`
		755
		756	`#-------------------------------------------------------------------------------`
		757	`# Function : get_package`
		758	`#`
281	dpurdie	759	`# Description : Get the package version`
		760	`# Validates package-version if required`
227	dpurdie	761	`#`
281	dpurdie	762	`# Does not generate errors, but will generate error information`
		763	`# to be reported later.`
		764	`#`
227	dpurdie	765	`# Inputs : $package`
		766	`# $version ( suffix is used only )`
		767	`#`
		768	`# Returns : Replacement version`
		769	`#`
		770
		771	`sub get_package`
		772	`{`
		773	`my ($package, $version) = @_;`
		774
		775	`#`
		776	`# Split the suffix off the version`
		777	`# Suffixes are not numeric`
		778	`# Must allow for`
		779	`# 9.9.9`
		780	`# 9.9.cots`
		781	`# 9.9.9.cots`
		782	`#`
		783	`my ($rel, $suf ) = extract_version( $package, $version);`
		784
		785	`Verbose2 ("Get Package: $package, $version, $rel, $suf");`
		786
		787	`#`
		788	`# If the CFG file has 'new' project extensions then we`
		789	`# must transform them before attempting to look up the versions`
		790	`#`
		791	`if ( $opt_oldproject && $suf eq $opt_oldproject )`
		792	`{`
		793	`$suf = $opt_newproject;`
		794	`$suffix_count++;`
		795	`}`
		796
		797	`#`
		798	`# If a datafile was provided, then the packages MUST be present`
		799	`#`
		800	`if ( $opt_datafile )`
		801	`{`
281	dpurdie	802	`unless ( exists $component{$package} )`
		803	`{`
		804	`push @pkg_errors, "No definitions for package '$package'";`
6619	dpurdie	805	`$version = get_version( $package, $suf, $rel ) if $opt_zero;`
281	dpurdie	806	`return $version;`
		807	`}`
227	dpurdie	808
		809	`# print Data::Dumper->Dump ( [\%component], ["Component" ]);`
		810
281	dpurdie	811	`unless ( exists $component{$package}{$suf} )`
		812	`{`
		813	`push @pkg_errors, "No definitions for '$package' '$version' '$suf'";`
6619	dpurdie	814	`$version = get_version( $package, $suf, $rel ) if $opt_zero;`
281	dpurdie	815	`return $version;`
		816	`}`
227	dpurdie	817	`}`
		818
		819	`#`
		820	`# remove used packages from the "use" hash`
		821	`#`
		822	`delete $component_use{$package}{$suf};`
		823	`delete $component_use{$package} unless ( keys %{$component_use{$package}} );`
		824
		825	`#`
		826	`# Was the suffix real`
		827	`#`
281	dpurdie	828	`my $new_version = get_version( $package, $suf, $rel );`
		829	`if ( $opt_validate )`
		830	`{`
		831	`if ( $new_version ne $version )`
		832	`{`
6619	dpurdie	833	`push @pkg_errors_val, sprintf("Validation mismatch: %-${max_pkglen}s , %-${max_verlen}s != %-${max_verlen}s", $package ,$version, $new_version);`
281	dpurdie	834	`return $version;`
		835	`}`
		836	`}`
		837	`return $new_version;`
227	dpurdie	838	`}`
		839
		840	`#-------------------------------------------------------------------------------`
		841	`# Function : extract_version`
		842	`#`
		843	`# Description : Extracts a version and project suffix from a string`
		844	`#`
		845	`# Inputs : $1 - Package name`
		846	`# $2 - Package Version Input string`
		847	`#`
		848	`# Returns : $1 - Vesrion part`
		849	`# $2 - Suffix (project) part`
		850	`#`
		851	`sub extract_version`
		852	`{`
		853	`my ($package, $version) = @_;`
		854
		855	`my $rel;`
		856	`my $suf;`
		857
347	dpurdie	858	`#`
		859	`# Cots packages are special. They end in '.cots'`
		860	`#`
		861	`if ( $version =~ m~(.*)[\.\s](cots)$~ )`
227	dpurdie	862	`{`
		863	`$rel = $1;`
347	dpurdie	864	`$suf = $2`
		865	`}`
		866	`elsif ( $version =~ m~^(.*?)([\.\s]([^0-9]+))$~ )`
		867	`{`
		868	`$rel = $1;`
227	dpurdie	869	`$suf = $3;`
		870	`$suf = '' unless ( $suf );`
		871	`}`
		872	`else`
		873	`{`
		874	`$rel = $version;`
		875	`$suf = '';`
		876	`}`
		877	`return ( $rel, $suf );`
		878	`}`
		879
		880	`#-------------------------------------------------------------------------------`
		881	`# Function : get_version`
		882	`#`
		883	`# Description : Create a nice package version`
		884	`#`
		885	`# Inputs : $package`
		886	`# $suf`
		887	`#`
		888	`# Returns :`
		889	`#`
		890	`sub get_version`
		891	`{`
		892	`my ($package,$suf, $version) = @_;`
		893
6619	dpurdie	894	`if ($opt_zero) {`
		895	`$version = '0.0.0000';`
227	dpurdie	896
6619	dpurdie	897	`} else {`
		898	`if ( exists( $component{$package}{$suf} ) ) {`
		899	`$version = $component{$package}{$suf};`
		900	`}`
		901
		902	`if ( $opt_oldproject && $suf eq $opt_oldproject ) {`
		903	`$suf = $opt_newproject;`
		904	`$suffix_count++;`
		905	`}`
227	dpurdie	906	`}`
		907
		908	`$version .= '.' . $suf if ( length( $suf) );`
		909	`return $version;`
		910
		911	`}`
		912
		913	`#-------------------------------------------------------------------------------`
		914	`# Function : genBuildName`
		915	`#`
		916	`# Description : Generate a BuildName argument string`
		917	`#`
		918	`# Inputs : build_info - Hash of buildname arguments`
		919	`# new_ver - New version`
		920	`#`
		921	`# Returns : A string of quoted BuildName arguemnts`
		922	`#`
		923	`sub genBuildName`
		924	`{`
		925	`my ( $build_info, $new_ver ) = @_;`
		926	`my @args;`
		927
		928	`#`
		929	`# Remove the project part from the new version name`
		930	`#`
		931	`my $prj = $build_info->{BUILDNAME_PROJECT};`
		932
		933	`$prj = $opt_newproject`
		934	`if ( $opt_oldproject && $prj eq $opt_oldproject );`
		935
		936	`$new_ver =~ s~\.$prj$~~ if ( $prj );`
		937
		938	`#`
		939	`# Determine the format of the BuildName`
		940	`#`
		941	`if ( $build_info->{RELAXED_VERSION} )`
		942	`{`
		943	`#`
		944	`# Relaxed format`
		945	`#`
		946	`push @args, $build_info->{BUILDNAME_PACKAGE};`
		947	`push @args, $new_ver;`
		948	`push @args, $prj if ( $prj );`
		949	`push @args, '--RelaxedVersion';`
		950	`}`
		951	`else`
		952	`{`
		953	`#`
		954	`# Generate two field version as some of the deployment scripts`
		955	`# need this format.`
		956	`#`
		957	`push @args, "$build_info->{BUILDNAME_PACKAGE} $new_ver $prj";`
		958	`}`
		959
		960	`#`
		961	`# Common arguments`
		962	`#`
		963	`push @args, "--PatchNum=$build_info->{DEPLOY_PATCH}"`
		964	`if ( $build_info->{DEPLOY_PATCH} );`
		965
		966	`push @args, @{$build_info->{EXTRA_ARGS}} if exists ($build_info->{EXTRA_ARGS});`
		967
		968
		969	`#`
		970	`# Format the arguments`
		971	`#`
		972	`return join ", ", map { "'$_'" } @args;`
		973	`}`
		974
		975	`#-------------------------------------------------------------------------------`
		976	`# Documentation`
		977	`#`
		978
		979	`=pod`
		980
361	dpurdie	981	`=for htmltoc SYSUTIL::`
		982
227	dpurdie	983	`=head1 NAME`
		984
		985	`jats_rewrite - Rewrite a build.pl file`
		986
		987	`=head1 SYNOPSIS`
		988
		989	`jats etool jats_rewrite [options]`
		990
		991	`Options:`
		992	`-help - brief help message`
		993	`-help -help - Detailed help message`
		994	`-man - Full documentation`
		995	`-verbose - Verbose operation`
		996	`-config xxx - Configuration file. Full file name`
263	dpurdie	997	`-noconfig - No configuration file`
227	dpurdie	998	`-oldproject - Old project extension (optional)`
		999	`-newproject - New project extension (optional)`
		1000	`-infile xxx - Input file (build.pl)`
		1001	`-outfile xxx - Output file (auto.pl)`
		1002	`-errors - Generate errors for unused config items`
		1003	`-xml - Process a build.xml file`
281	dpurdie	1004	`-validate - Validate dependencies only`
323	dpurdie	1005	`-mode=nn - Special operational modes`
6619	dpurdie	1006	`-zero - Zero the version numbers`
227	dpurdie	1007
		1008	`=head1 OPTIONS`
		1009
		1010	`=over 8`
		1011
		1012	`=item B<-help>`
		1013
		1014	`Print a brief help message and exits.`
		1015
		1016	`=item B<-help -help>`
		1017
		1018	`Print a detailed help message with an explanation for each option.`
		1019
		1020	`=item B<-man>`
		1021
		1022	`Prints the manual page and exits.`
		1023
		1024	`=item B<-verbose>`
		1025
247	dpurdie	1026	`Increases program output. This option may be specified multiple times`
227	dpurdie	1027
		1028	`=item B<-config=xxx>`
		1029
		1030	`This option specifies the name of a configuration file that will provide the`
		1031	`transformation between of version numbers. The format of the config file is`
		1032	`described later.`
		1033
		1034	`The option is not required if -newproject and -oldproject are specified`
		1035
263	dpurdie	1036	`=item B<-noconfig>`
		1037
281	dpurdie	1038	`This option indicates that no config file is present and that the output file`
263	dpurdie	1039	`is to be created without reference to the configuration.`
		1040
227	dpurdie	1041	`=item B<-oldproject=xxx>`
		1042
		1043	`This option, in conjunction with B<-oldproject=xxx> allows the project`
247	dpurdie	1044	`extensions to be modified. ie: .syd projects can be converted into .bej`
227	dpurdie	1045	`projects.`
		1046
247	dpurdie	1047	`If this option is present then the config data file is not required, although`
227	dpurdie	1048	`it will be sued if it is present.`
		1049
		1050	`=item B<-newproject=xxx>`
		1051
		1052	`See B<-oldproject=xxx>`
		1053
		1054
		1055	`=item B<-infile=xxx>`
		1056
		1057	`The name of the input file. The default file is build.pl`
		1058
		1059	`=item B<-outfile=xxx>`
		1060
		1061	`The name of the output file. The default is auto.pl, even if an XML file is`
		1062	`being processed.`
		1063
		1064	`=item B<-errors>`
		1065
		1066	`This option will force the program to generate an error message if there are`
		1067	`packages in the config file that were not used by the re-write process.`
		1068
		1069	`=item B<-xml>`
		1070
		1071	`Process a build.xml file instead of a build.pl file.`
247	dpurdie	1072	`This option will be set internally if the infile extension is '.xml'`
227	dpurdie	1073
281	dpurdie	1074	`=item B<-validate>`
		1075
		1076	`This option will validate the build files against the configuration file. This`
		1077	`option is used by build tools to validate dependency information.`
		1078
323	dpurdie	1079	`=item B<-mode=n>`
		1080
		1081	`This option is used internally, by JATS, to indicate that the utility is being`
		1082	`used to perform controlled rewrite operations. Currently only a value of 1 is`
		1083	`supported. This will:`
		1084
361	dpurdie	1085	`=over 4`
323	dpurdie	1086
361	dpurdie	1087	`=item *`
323	dpurdie	1088
6192	dpurdie	1089	`Suppress warnings about unused packages. The config file is expected to`
361	dpurdie	1090	`contain many more packages than required by the rewrite.`
323	dpurdie	1091
361	dpurdie	1092	`=item *`
323	dpurdie	1093
361	dpurdie	1094	`Suppress warnings about badly formatted config entries.`
323	dpurdie	1095
361	dpurdie	1096	`=item *`
		1097
		1098	`Will reuse an auto.pl or auto.xml file if its present. Allows user changes to be`
		1099	`made to made to working copies of the build files.`
		1100
		1101	`=item *`
		1102
		1103	`Will use build.pl as a template if it is newer than auto.pl. Allows user changes`
		1104	`to be made to build.pl.`
		1105
		1106	`=item *`
		1107
		1108	`Will not modify the packages own version number, or the previous version number.`
323	dpurdie	1109	`Only the package dependencies will be modified.`
		1110
361	dpurdie	1111	`=item *`
323	dpurdie	1112
361	dpurdie	1113	`Package-Version that are not in the Release will not be treated as an error.`
331	dpurdie	1114
361	dpurdie	1115	`=item *`
		1116
		1117	`Package-Versions that are in dpkg_archive will generate a warning`
		1118
227	dpurdie	1119	`=back`
		1120
6619	dpurdie	1121	`=item B<-[no]zero>`
		1122
		1123	`This option will force the version numbers to 0.0.0000.`
		1124
323	dpurdie	1125	`=back`
		1126
227	dpurdie	1127	`=head1 DESCRIPTION`
		1128
247	dpurdie	1129	`This utility is used within the automated build system to rewrite build files`
		1130	`so that they contain suitable version numbers.`
227	dpurdie	1131
247	dpurdie	1132	`The program takes a configuration file, described below, that contains package`
		1133	`and version information for the build.`
		1134
		1135	`The program takes a JATS build.pl file, or an ANT style dependency file, and`
		1136	`will create a file that is similar, but contains modified package-version`
		1137	`information.`
		1138
		1139	`The build tools are designed to use this I<auto> file, in preference to the`
		1140	`original build file.`
		1141
		1142	`=head2 Format of the Configuration File`
		1143
227	dpurdie	1144	`The format of the configuration file is defined below.`
		1145
247	dpurdie	1146	`The file is a line oriented text file.`
227	dpurdie	1147
247	dpurdie	1148	`Comments begin with a # and go the end of the line.`
227	dpurdie	1149
247	dpurdie	1150	`There are three types of configuration line:`
227	dpurdie	1151
247	dpurdie	1152	`=over 8`
		1153
		1154	`=item Assigned Items`
		1155
		1156	`These are of the form: B<tag = value> and are used to specify the value of`
361	dpurdie	1157	`the following special properties:`
247	dpurdie	1158
		1159	`=over 8`
		1160
		1161	`=item releasemanager.projectname`
		1162
		1163	`The name of the Release Manager project used for the build.`
		1164
		1165	`=item releasemanager.releasename`
		1166
		1167	`The name of the Release Manager release, within the project, used for the build.`
		1168
		1169	`=back`
		1170
		1171	`These may be used to brand installer programs with Release Information.`
		1172	`Currently the use of these tags is only supported by the XML build files.`
		1173
		1174	`=item Package Version`
		1175
		1176	`Specifies the version of a package to use as two, space separated words of the`
		1177	`form C<package_name package_version> where package version is of the form:`
		1178
		1179	`=over 8`
		1180
361	dpurdie	1181	`=item *`
247	dpurdie	1182
361	dpurdie	1183	`nn.nn.nnnn.aaa`
247	dpurdie	1184
361	dpurdie	1185	`=item *`
247	dpurdie	1186
361	dpurdie	1187	`nn.nn.nnnn`
		1188
		1189	`=item *`
		1190
		1191	`Other`
		1192
247	dpurdie	1193	`=back`
		1194
		1195	`=item LinkPkgArchive or BuildPkgArchive`
		1196
		1197	`These are standard JATS LinkPkgArchive or BuildPkgArchive statements.`
		1198
		1199	`=back`
		1200
		1201	`=head2 XML File Rewrite`
		1202
5710	dpurdie	1203	`This program will process an VIX style ANT build dependency definition file`
247	dpurdie	1204	`and replace the values of the properties seen within the file.`
		1205
		1206	`The following properties are special within the rewrite process:`
		1207
		1208	`=over 8`
		1209
		1210	`=item packagename`
		1211
		1212	`This is the name of the package. It is not modified, but it`
		1213	`is used in conjunction with the C<packageversion> to identify the package, such`
		1214	`that the packageversion can be updated. This property is mandatory and must`
		1215	`appear before the C<packageversion>.`
		1216
		1217	`=item packageversion`
		1218
		1219	`This is the version of the package. It can be rewritten by this program. This`
		1220	`property is mandatory.`
		1221
		1222	`=item releasemanager.projectname`
		1223
361	dpurdie	1224	`If this property is found the value will be replaced with an`
		1225	`L<assigned item\|Assigned_Items> of the same name.`
247	dpurdie	1226
		1227	`=item releasemanager.releasename`
		1228
361	dpurdie	1229	`If this property is found the value will be replaced with an`
		1230	`L<assigned item\|Assigned_Items> of the same name.`
247	dpurdie	1231
		1232	`=back`
		1233
361	dpurdie	1234	`Properties that are not special will be treated as the name of a package and`
247	dpurdie	1235	`the value will be updated to reflect the required version of the package.`
		1236
		1237	`The XML rewrite process does not, and cannot handle, instances of packages`
		1238	`that have the same name, but different project suffixes. This is a limitation of`
5710	dpurdie	1239	`the VIX ANT build system and not a limitation of this utility.`
247	dpurdie	1240
		1241	`=head2 JATS Build File Rewrite`
		1242
		1243	`This program will process a JATS style build.pl file and modify some`
		1244	`directives to update the file.`
		1245
		1246	`The following directives will be processed:`
		1247
		1248	`=over 8`
		1249
		1250	`=item BuildName`
		1251
		1252	`The existing version in the BuildName directive will be retained and may be used`
		1253	`in any BuildPreviousVersion directive that is seen.`
		1254
		1255	`=item BuildPreviousVersion`
		1256
		1257	`This will be updated to contain the version from the BuildName. This is`
		1258	`intended to be used by deployment scripts.`
		1259
		1260	`=item LinkPkgArchive`
		1261
		1262	`The version will be updated to reflect the configured package versions. The`
		1263	`project suffix, if present, will be used to identify the correct package.`
		1264
		1265	`=item BuildPkgArchive`
		1266
		1267	`The version will be updated to reflect the configured package versions. The`
		1268	`project suffix, if present, will be used to identify the correct package.`
		1269
		1270	`=back`
		1271
		1272	`The JATS build file rewrite process, unlike the ANT process, does handle, instances of packages`
		1273	`that have the same name, but different project suffixes. This allows the use`
		1274	`of packages such as C<sysbasetypes.cr> and C<sysbasetypes.prj> within the one`
		1275	`package.`
		1276
		1277	`Currently the JATS build file rewrite process does pass the`
		1278	`releasemanager.projectname and the releasemanager.releasename items through to`
		1279	`the underlying system. If present in the config file they will be unused. This`
		1280	`is not an error.`
		1281
227	dpurdie	1282	`=cut`
		1283

Subversion Repositories DevTools

(root)/core_devl/trunk/TOOLS/jats_rewrite.pl – Rev 7326