WebSVN – DevTools – Blame – /core_devl/branches/gitBuilder/TOOLS/jats_rewrite.pl

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

Subversion Repositories DevTools

(root)/core_devl/branches/gitBuilder/TOOLS/jats_rewrite.pl – Rev 5710