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

Rev	Author	Line No.	Line
227	dpurdie	1	`########################################################################`
281	dpurdie	2	`# Copyright ( C ) 2008-2009 ERG Limited, 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';`
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
		287	`#`
		288	`# Unlink any OLD output file`
		289	`#`
323	dpurdie	290	`unlink $opt_work_file;`
227	dpurdie	291
		292	`#`
		293	`# Open the input and output files`
		294	`#`
323	dpurdie	295	`open ( INFILE, "<$opt_infile" ) \|\| Error( "Cannot read from $opt_infile", $! );`
		296	`open ( OUTFILE, ">$opt_work_file" ) \|\| Error( "Cannot create $opt_work_file", $! );`
227	dpurdie	297
		298	`my $build_info;`
		299
		300	`my $release_name;`
		301	`my $release_version;`
		302
		303	`while ( <INFILE> )`
		304	`{`
263	dpurdie	305	`next if ( $opt_noconfig ); # Nothing to do`
227	dpurdie	306	`next if ( m~^\s*#~ ); # Skip comments`
		307	`#`
		308	`# Process BuildName`
		309	`#`
323	dpurdie	310	`if ( m~\s*BuildName[\s\(]~ )`
227	dpurdie	311	`{`
		312	`# Build names come in many flavours`
		313	`# Must support a number of different formats`
		314	`# "name nn.nn.nn prj"`
		315	`# "name nn.nn.nn.prj"`
		316	`#`
		317	`# "name nn.nn.nn prj", "nn.nn.nn"`
		318	`# "name nn.nn.nn.prj", "nn.nn.nn"`
		319	`#`
		320	`# "name", "nn.nn.nn.prj"`
		321	`#`
		322	`m~$\s(.?)\s*$~;`
		323	`my @args = split /\s,\s/, $1;`
		324	`$build_info = parseBuildName( @args );`
323	dpurdie	325	`my $new_ver;`
227	dpurdie	326
323	dpurdie	327	`#`
		328	`# In Special Mode, don't change the version of this package`
		329	`# Assume that the user has fiddled with it.`
		330	`#`
		331	`if ( $opt_mode ) {`
		332	`$new_ver = $build_info->{BUILDVERSION};`
		333	`} else {`
		334	`$new_ver = get_package ( $build_info->{BUILDNAME_PACKAGE}, $build_info->{BUILDVERSION} );`
		335	`}`
227	dpurdie	336	`my $build_args = genBuildName( $build_info, $new_ver );`
		337
		338	`#`
		339	`# Rewrite the body of the directive`
		340	`#`
		341	`s~$\s(.?)\s*$~( $build_args )~;`
323	dpurdie	342	`print_update( 'Name', $build_info->{BUILDNAME_PACKAGE}, $build_info->{BUILDVERSION}, $new_ver );`
227	dpurdie	343
		344	`}`
		345
		346	`#`
		347	`# Process BuildPreviousVersion`
		348	`# Save the current version information in this directive`
		349	`#`
323	dpurdie	350	`if ( m/^\s*BuildPreviousVersion/ && ! $opt_mode )`
227	dpurdie	351	`{`
		352	`Error ("BuildPreviousVersion directive before BuildName") unless ( $build_info );`
		353	`m/['"](.*?)['"]/;`
		354	`my $prev = $1;`
281	dpurdie	355	`my $new_ver = $opt_validate ? $prev : $build_info->{BUILDVERSION};`
227	dpurdie	356
		357	`s/['"](.*?)['"]/'$build_info->{BUILDVERSION}'/;`
281	dpurdie	358	`print_update( 'PrevVer', '', $prev, $new_ver );`
227	dpurdie	359	`}`
		360
		361	`#`
		362	`# Process BuildPkgArchive and LinkPkgArchive`
		363	`if ( m/^\sLinkPkgArchive/ or m/^\sBuildPkgArchive/ )`
		364	`{`
		365	`m/['"](.?)['"][^'"]['"](.*?)['"]/;`
		366
		367	`my $comp = $1;`
		368	`my $ver = $2;`
		369	`my $new_ver = get_package ( $comp, $ver );`
		370	`s/['"](.?)['"]([^'"])['"](.*?)['"]/'$comp'$2'$new_ver'/;`
		371	`print_update ('', $comp ,$ver, $new_ver );`
		372	`}`
		373
		374
		375	`} continue`
		376	`{`
		377	`#`
		378	`# Always output the resultant line`
		379	`#`
		380	`print OUTFILE $_;`
		381	`}`
		382
		383	`#`
		384	`# Cleanup`
		385	`#`
		386	`close INFILE;`
		387	`close OUTFILE;`
323	dpurdie	388	`unlink $opt_ofile;`
		389	`rename $opt_work_file ,$opt_ofile;`
227	dpurdie	390	`display_unused();`
		391	`}`
		392
		393	`#-------------------------------------------------------------------------------`
		394	`# Function : process_xml_build_file`
		395	`#`
		396	`# Description : Rewrite one depends.xml file`
		397	`# depends.xml -> auto.xml`
		398	`#`
		399	`# A very cheap and nasty XML (not)parser`
		400	`# It assumes that entries are all on one line so that we can`
		401	`# do trivial substitutions`
		402	`#`
		403	`# Processes`
		404	`# <using ... >`
247	dpurdie	405	`# <property name="packagename" value="...">`
		406	`# <property name="packageversion" value="...">`
		407	`# <property name="releasemanager.releasename" value="...">`
		408	`# <property name="releasemanager.projectname" value="...">`
227	dpurdie	409	`# <import file=...>`
		410	`#`
247	dpurdie	411	`# Note: This function handles a wider scope of XML files`
		412	`# than it really needs to. All thats needed is`
249	dpurdie	413	`# the <property name= value=> fields.`
227	dpurdie	414	`#`
		415	`# Inputs :`
		416	`#`
		417	`# Returns :`
		418	`#`
		419	`sub process_xml_build_file`
		420	`{`
		421	`Verbose ("$opt_infile");`
		422
		423	`#`
		424	`# Unlink any OLD output file`
		425	`#`
323	dpurdie	426	`unlink $opt_work_file;`
227	dpurdie	427
		428	`#`
		429	`# Open the input and output files`
		430	`#`
323	dpurdie	431	`open ( INFILE, "<$opt_infile" ) \|\| Error( "Cannot read from $opt_infile", $! );`
		432	`open ( OUTFILE, ">$opt_work_file" ) \|\| Error( "Cannot create $opt_work_file", $! );`
227	dpurdie	433
		434	`my $release_name;`
		435	`my $release_version;`
		436
		437	`while ( <INFILE> )`
		438	`{`
263	dpurdie	439	`next if ( $opt_noconfig ); # Nothing to do`
227	dpurdie	440	`#`
		441	`# Process "project" statement`
		442	`#`
		443	`if ( m~<project~ )`
		444	`{`
		445	`# Extract the package name`
		446	`# this to determine the required version of the package`
		447	`#`
249	dpurdie	448	`if ( m~name="([^"]*)"~ )`
233	dpurdie	449	`{`
		450	`$release_name = $1;`
		451	`Error ("Empty 'name' attribute not found in 'project'") unless ( $release_name );`
		452	`Verbose2 ("Project: $release_name");`
		453	`}`
227	dpurdie	454	`}`
		455
		456	`#`
		457	`# Process "property" statements`
		458	`#`
		459	`elsif ( m~<property~ )`
		460	`{`
		461	`#`
247	dpurdie	462	`# Extract name and value`
		463	`# Both must exist`
227	dpurdie	464	`#`
247	dpurdie	465	`my $name;`
		466	`my $value;`
227	dpurdie	467
249	dpurdie	468	`if ( m~name="([^"]*)"~ )`
247	dpurdie	469	`{`
		470	`$name = $1;`
		471	`}`
		472	`else`
		473	`{`
		474	`Error ("Name attribute not found in 'property'");`
		475	`}`
		476
249	dpurdie	477	`if ( m~value="([^"]*)"~ )`
247	dpurdie	478	`{`
		479	`$value = $1;`
		480	`}`
		481	`else`
		482	`{`
		483	`Error ("Value attribute not found in $name 'property'");`
		484	`}`
		485	`Verbose2 ("Property: $name, Value: $value");`
		486
227	dpurdie	487	`#`
323	dpurdie	488	`# Examine the property name`
247	dpurdie	489	`# Some of the them are special, others will be package names`
227	dpurdie	490	`#`
		491	`if ( $name eq 'packagename' )`
		492	`{`
247	dpurdie	493	`$release_name = $value;`
227	dpurdie	494	`Error ("Value attribute not found in packagename 'property'") unless ( $release_name );`
		495	`}`
		496	`elsif ( $name eq 'packageversion' )`
		497	`{`
247	dpurdie	498	`$release_version = $value;`
227	dpurdie	499
		500	`#`
		501	`# Ensure that we already have the package name`
		502	`#`
		503	`Error ("packageversion before packagename") unless ( $release_name );`
		504
		505	`my $new_ver = get_package ( $release_name, $release_version );`
249	dpurdie	506	`s~(.)value="([^"])"~$1value=\"$new_ver\"~;`
323	dpurdie	507	`print_update( 'Name', $release_name ,$release_version, $new_ver );`
227	dpurdie	508	`}`
247	dpurdie	509	`elsif ( defined $fields{$name} )`
227	dpurdie	510	`{`
		511	`#`
247	dpurdie	512	`# Use tagged values in preference to packages`
		513	`# There are very few tagged values.`
227	dpurdie	514	`#`
247	dpurdie	515	`my $new_value = $fields{$name};`
		516	`Error ("Release attribute not found: $name") unless ( $new_value );`
		517
249	dpurdie	518	`s~(.)value="([^"])"~$1value=\"$new_value\"~;`
247	dpurdie	519	`print_update( 'Release', $name ,$value, $new_value );`
227	dpurdie	520	`}`
		521	`else`
		522	`{`
247	dpurdie	523	`my $new_ver = get_package ( $name, $value );`
249	dpurdie	524	`s~(.)value="([^"])"~$1value=\"$new_ver\"~;`
247	dpurdie	525	`print_update( '', $name ,$value, $new_ver );`
227	dpurdie	526	`}`
		527	`}`
		528
		529	`#`
		530	`# Process "using" statements`
		531	`#`
		532	`elsif ( m~<using~ )`
		533	`{`
		534	`#`
		535	`# Extract the package name and version`
		536	`# and use this to determine the required version of the package`
		537	`#`
249	dpurdie	538	`m~name="([^"]*)"~;`
227	dpurdie	539	`my $name = $1;`
		540	`Error ("Name attribute not found in 'using'") unless ( $name );`
		541	`Verbose2 ("Using: $name");`
		542
		543	`#`
		544	`# Extract the version`
		545	`#`
249	dpurdie	546	`m~version="([^"]*)"~;`
227	dpurdie	547	`$release_version = $1;`
		548	`Error ("Version attribute not found in package 'using' : $name") unless ( $release_version );`
		549
		550	`my $new_ver = get_package ( $name, $release_version );`
249	dpurdie	551	`s~(.)version="([^"])"~$1version=\"$new_ver\"~;`
227	dpurdie	552	`print_update( '', $name ,$release_version, $new_ver );`
		553	`}`
		554
		555	`#`
		556	`# Import File`
247	dpurdie	557	`# Only used to import ant-using`
227	dpurdie	558	`#`
		559	`elsif ( m~<import~ )`
		560	`{`
		561	`#`
		562	`# Extract the file`
		563	`#`
249	dpurdie	564	`m~file="([^"]*)"~;`
227	dpurdie	565	`my $file = $1;`
		566	`Error ("File attribute not found in 'import'") unless ( $file );`
		567
		568	`#`
		569	`# Extract the package name and version from the file`
		570	`# Will be of the form /package/version/filename`
		571	`#`
		572	`$file =~ m~(.*?)/([^/]+)/([^/]+)/([^/]+)$~;`
		573	`my $prefix = $1;`
		574	`my $pname = $2;`
		575	`my $pver = $3;`
		576	`my $fname = $4;`
		577	`Error ("Package details not found in import file") unless ( $fname );`
		578
		579	`my $new_ver = get_package ( $pname, $pver );`
		580
		581	`#`
		582	`# Rewrite the body of the directive`
		583	`#`
249	dpurdie	584	`s~(.)file="([^"])"~$1file=\"$prefix/$pname/$new_ver/$fname\"~;`
227	dpurdie	585	`print_update( '', $pname ,$pver, $new_ver );`
		586	`}`
		587
		588	`} continue`
		589	`{`
		590	`#`
		591	`# Always output the resultant line`
		592	`#`
		593	`print OUTFILE $_;`
		594	`}`
		595
		596	`#`
		597	`# Cleanup`
		598	`#`
		599	`close INFILE;`
		600	`close OUTFILE;`
323	dpurdie	601	`unlink $opt_ofile;`
		602	`rename $opt_work_file ,$opt_ofile;`
227	dpurdie	603	`display_unused();`
		604	`}`
		605
		606	`#-------------------------------------------------------------------------------`
		607	`# Function : display_unused`
		608	`#`
		609	`# Description : Generate warnings about config items that were not used`
		610	`#`
		611	`# Inputs :`
		612	`#`
		613	`# Returns :`
		614	`#`
		615	`sub display_unused`
		616	`{`
323	dpurdie	617	`return`
		618	`if ( $opt_mode );`
		619
227	dpurdie	620	`foreach my $comp ( sort keys %component_use )`
		621	`{`
		622	`foreach my $suf ( keys %{$component_use{$comp}} )`
		623	`{`
		624	`my $ver = get_version( $comp, $suf );`
		625	`Warning("Unused package: ${comp}_${ver}");`
		626	`$not_use_count++;`
		627	`}`
		628	`}`
		629	`}`
		630
		631	`#-------------------------------------------------------------------------------`
		632	`# Function : save_package`
		633	`#`
		634	`# Description : Save the package name and version`
		635	`#`
		636	`# Inputs : $package`
		637	`# $version`
		638	`#`
		639	`# Returns : Nothing`
		640	`#`
		641	`sub save_package`
		642	`{`
		643	`my ($package, $version) = @_;`
		644
		645	`#`
281	dpurdie	646	`# Determine longest package name`
		647	`#`
		648	`my $len = length $package;`
		649	`$max_pkglen = $len`
		650	`if ( $len > $max_pkglen );`
		651
		652	`#`
227	dpurdie	653	`# Split the suffix off the version`
		654	`#`
		655	`my ($rel, $suf ) = extract_version( $package, $version);`
		656
		657	`Error ("Multiple definitions for $package $version" )`
		658	`if ( $component{$package}{$suf} );`
		659
247	dpurdie	660	`Error ("Package Name is a reserved key field: $package" )`
		661	`if ( exists $fields{$package} );`
		662
227	dpurdie	663	`$component{$package}{$suf} = $rel;`
		664	`$component_use{$package}{$suf} = $rel;`
		665
		666	`Verbose2 ("Package: $package, $version, $rel, $suf");`
		667
		668	`}`
		669
		670	`#-------------------------------------------------------------------------------`
		671	`# Function : get_package`
		672	`#`
281	dpurdie	673	`# Description : Get the package version`
		674	`# Validates package-version if required`
227	dpurdie	675	`#`
281	dpurdie	676	`# Does not generate errors, but will generate error information`
		677	`# to be reported later.`
		678	`#`
227	dpurdie	679	`# Inputs : $package`
		680	`# $version ( suffix is used only )`
		681	`#`
		682	`# Returns : Replacement version`
		683	`#`
		684
		685	`sub get_package`
		686	`{`
		687	`my ($package, $version) = @_;`
		688
		689	`#`
		690	`# Split the suffix off the version`
		691	`# Suffixes are not numeric`
		692	`# Must allow for`
		693	`# 9.9.9`
		694	`# 9.9.cots`
		695	`# 9.9.9.cots`
		696	`#`
		697	`my ($rel, $suf ) = extract_version( $package, $version);`
		698
		699	`Verbose2 ("Get Package: $package, $version, $rel, $suf");`
		700
		701	`#`
		702	`# If the CFG file has 'new' project extensions then we`
		703	`# must transform them before attempting to look up the versions`
		704	`#`
		705	`if ( $opt_oldproject && $suf eq $opt_oldproject )`
		706	`{`
		707	`$suf = $opt_newproject;`
		708	`$suffix_count++;`
		709	`}`
		710
		711	`#`
		712	`# If a datafile was provided, then the packages MUST be present`
		713	`#`
		714	`if ( $opt_datafile )`
		715	`{`
281	dpurdie	716	`unless ( exists $component{$package} )`
		717	`{`
		718	`push @pkg_errors, "No definitions for package '$package'";`
		719	`return $version;`
		720	`}`
227	dpurdie	721
		722	`# print Data::Dumper->Dump ( [\%component], ["Component" ]);`
		723
281	dpurdie	724	`unless ( exists $component{$package}{$suf} )`
		725	`{`
		726	`push @pkg_errors, "No definitions for '$package' '$version' '$suf'";`
		727	`return $version;`
		728	`}`
227	dpurdie	729	`}`
		730
		731	`#`
		732	`# remove used packages from the "use" hash`
		733	`#`
		734	`delete $component_use{$package}{$suf};`
		735	`delete $component_use{$package} unless ( keys %{$component_use{$package}} );`
		736
		737	`#`
		738	`# Was the suffix real`
		739	`#`
281	dpurdie	740	`my $new_version = get_version( $package, $suf, $rel );`
		741	`if ( $opt_validate )`
		742	`{`
		743	`if ( $new_version ne $version )`
		744	`{`
		745	`push @pkg_errors_val, sprintf("Validation mismatch: %-${max_pkglen}s, %-15s != %-15s", $package ,$version, $new_version);`
		746	`return $version;`
		747	`}`
		748	`}`
		749	`return $new_version;`
227	dpurdie	750	`}`
		751
		752	`#-------------------------------------------------------------------------------`
		753	`# Function : extract_version`
		754	`#`
		755	`# Description : Extracts a version and project suffix from a string`
		756	`#`
		757	`# Inputs : $1 - Package name`
		758	`# $2 - Package Version Input string`
		759	`#`
		760	`# Returns : $1 - Vesrion part`
		761	`# $2 - Suffix (project) part`
		762	`#`
		763	`sub extract_version`
		764	`{`
		765	`my ($package, $version) = @_;`
		766
		767	`my $rel;`
		768	`my $suf;`
		769
347	dpurdie	770	`#`
		771	`# Cots packages are special. They end in '.cots'`
		772	`#`
		773	`if ( $version =~ m~(.*)[\.\s](cots)$~ )`
227	dpurdie	774	`{`
		775	`$rel = $1;`
347	dpurdie	776	`$suf = $2`
		777	`}`
		778	`elsif ( $version =~ m~^(.*?)([\.\s]([^0-9]+))$~ )`
		779	`{`
		780	`$rel = $1;`
227	dpurdie	781	`$suf = $3;`
		782	`$suf = '' unless ( $suf );`
		783	`}`
		784	`else`
		785	`{`
		786	`$rel = $version;`
		787	`$suf = '';`
		788	`}`
		789	`return ( $rel, $suf );`
		790	`}`
		791
		792	`#-------------------------------------------------------------------------------`
		793	`# Function : get_version`
		794	`#`
		795	`# Description : Create a nice package version`
		796	`#`
		797	`# Inputs : $package`
		798	`# $suf`
		799	`#`
		800	`# Returns :`
		801	`#`
		802	`sub get_version`
		803	`{`
		804	`my ($package,$suf, $version) = @_;`
		805
		806	`if ( exists( $component{$package}{$suf} ) )`
		807	`{`
		808	`$version = $component{$package}{$suf};`
		809	`}`
		810
		811	`if ( $opt_oldproject && $suf eq $opt_oldproject )`
		812	`{`
		813	`$suf = $opt_newproject;`
		814	`$suffix_count++;`
		815	`}`
		816
		817	`$version .= '.' . $suf if ( length( $suf) );`
		818	`return $version;`
		819
		820	`}`
		821
		822	`#-------------------------------------------------------------------------------`
		823	`# Function : genBuildName`
		824	`#`
		825	`# Description : Generate a BuildName argument string`
		826	`#`
		827	`# Inputs : build_info - Hash of buildname arguments`
		828	`# new_ver - New version`
		829	`#`
		830	`# Returns : A string of quoted BuildName arguemnts`
		831	`#`
		832	`sub genBuildName`
		833	`{`
		834	`my ( $build_info, $new_ver ) = @_;`
		835	`my @args;`
		836
		837	`#`
		838	`# Remove the project part from the new version name`
		839	`#`
		840	`my $prj = $build_info->{BUILDNAME_PROJECT};`
		841
		842	`$prj = $opt_newproject`
		843	`if ( $opt_oldproject && $prj eq $opt_oldproject );`
		844
		845	`$new_ver =~ s~\.$prj$~~ if ( $prj );`
		846
		847	`#`
		848	`# Determine the format of the BuildName`
		849	`#`
		850	`if ( $build_info->{RELAXED_VERSION} )`
		851	`{`
		852	`#`
		853	`# Relaxed format`
		854	`#`
		855	`push @args, $build_info->{BUILDNAME_PACKAGE};`
		856	`push @args, $new_ver;`
		857	`push @args, $prj if ( $prj );`
		858	`push @args, '--RelaxedVersion';`
		859	`}`
		860	`else`
		861	`{`
		862	`#`
		863	`# Generate two field version as some of the deployment scripts`
		864	`# need this format.`
		865	`#`
		866	`push @args, "$build_info->{BUILDNAME_PACKAGE} $new_ver $prj";`
		867	`}`
		868
		869	`#`
		870	`# Common arguments`
		871	`#`
		872	`push @args, "--PatchNum=$build_info->{DEPLOY_PATCH}"`
		873	`if ( $build_info->{DEPLOY_PATCH} );`
		874
		875	`push @args, @{$build_info->{EXTRA_ARGS}} if exists ($build_info->{EXTRA_ARGS});`
		876
		877
		878	`#`
		879	`# Format the arguments`
		880	`#`
		881	`return join ", ", map { "'$_'" } @args;`
		882	`}`
		883
		884	`#-------------------------------------------------------------------------------`
		885	`# Documentation`
		886	`#`
		887
		888	`=pod`
		889
361	dpurdie	890	`=for htmltoc SYSUTIL::`
		891
227	dpurdie	892	`=head1 NAME`
		893
		894	`jats_rewrite - Rewrite a build.pl file`
		895
		896	`=head1 SYNOPSIS`
		897
		898	`jats etool jats_rewrite [options]`
		899
		900	`Options:`
		901	`-help - brief help message`
		902	`-help -help - Detailed help message`
		903	`-man - Full documentation`
		904	`-verbose - Verbose operation`
		905	`-config xxx - Configuration file. Full file name`
263	dpurdie	906	`-noconfig - No configuration file`
227	dpurdie	907	`-oldproject - Old project extension (optional)`
		908	`-newproject - New project extension (optional)`
		909	`-infile xxx - Input file (build.pl)`
		910	`-outfile xxx - Output file (auto.pl)`
		911	`-errors - Generate errors for unused config items`
		912	`-xml - Process a build.xml file`
281	dpurdie	913	`-validate - Validate dependencies only`
323	dpurdie	914	`-mode=nn - Special operational modes`
227	dpurdie	915
		916	`=head1 OPTIONS`
		917
		918	`=over 8`
		919
		920	`=item B<-help>`
		921
		922	`Print a brief help message and exits.`
		923
		924	`=item B<-help -help>`
		925
		926	`Print a detailed help message with an explanation for each option.`
		927
		928	`=item B<-man>`
		929
		930	`Prints the manual page and exits.`
		931
		932	`=item B<-verbose>`
		933
247	dpurdie	934	`Increases program output. This option may be specified multiple times`
227	dpurdie	935
		936	`=item B<-config=xxx>`
		937
		938	`This option specifies the name of a configuration file that will provide the`
		939	`transformation between of version numbers. The format of the config file is`
		940	`described later.`
		941
		942	`The option is not required if -newproject and -oldproject are specified`
		943
263	dpurdie	944	`=item B<-noconfig>`
		945
281	dpurdie	946	`This option indicates that no config file is present and that the output file`
263	dpurdie	947	`is to be created without reference to the configuration.`
		948
227	dpurdie	949	`=item B<-oldproject=xxx>`
		950
		951	`This option, in conjunction with B<-oldproject=xxx> allows the project`
247	dpurdie	952	`extensions to be modified. ie: .syd projects can be converted into .bej`
227	dpurdie	953	`projects.`
		954
247	dpurdie	955	`If this option is present then the config data file is not required, although`
227	dpurdie	956	`it will be sued if it is present.`
		957
		958	`=item B<-newproject=xxx>`
		959
		960	`See B<-oldproject=xxx>`
		961
		962
		963	`=item B<-infile=xxx>`
		964
		965	`The name of the input file. The default file is build.pl`
		966
		967	`=item B<-outfile=xxx>`
		968
		969	`The name of the output file. The default is auto.pl, even if an XML file is`
		970	`being processed.`
		971
		972	`=item B<-errors>`
		973
		974	`This option will force the program to generate an error message if there are`
		975	`packages in the config file that were not used by the re-write process.`
		976
		977	`=item B<-xml>`
		978
		979	`Process a build.xml file instead of a build.pl file.`
247	dpurdie	980	`This option will be set internally if the infile extension is '.xml'`
227	dpurdie	981
281	dpurdie	982	`=item B<-validate>`
		983
		984	`This option will validate the build files against the configuration file. This`
		985	`option is used by build tools to validate dependency information.`
		986
323	dpurdie	987	`=item B<-mode=n>`
		988
		989	`This option is used internally, by JATS, to indicate that the utility is being`
		990	`used to perform controlled rewrite operations. Currently only a value of 1 is`
		991	`supported. This will:`
		992
361	dpurdie	993	`=over 4`
323	dpurdie	994
361	dpurdie	995	`=item *`
323	dpurdie	996
361	dpurdie	997	`Suppress warnings about unused packages. The config file may is expected to`
		998	`contain many more packages than required by the rewrite.`
323	dpurdie	999
361	dpurdie	1000	`=item *`
323	dpurdie	1001
361	dpurdie	1002	`Suppress warnings about badly formatted config entries.`
323	dpurdie	1003
361	dpurdie	1004	`=item *`
		1005
		1006	`Will reuse an auto.pl or auto.xml file if its present. Allows user changes to be`
		1007	`made to made to working copies of the build files.`
		1008
		1009	`=item *`
		1010
		1011	`Will use build.pl as a template if it is newer than auto.pl. Allows user changes`
		1012	`to be made to build.pl.`
		1013
		1014	`=item *`
		1015
		1016	`Will not modify the packages own version number, or the previous version number.`
323	dpurdie	1017	`Only the package dependencies will be modified.`
		1018
361	dpurdie	1019	`=item *`
323	dpurdie	1020
361	dpurdie	1021	`Package-Version that are not in the Release will not be treated as an error.`
331	dpurdie	1022
361	dpurdie	1023	`=item *`
		1024
		1025	`Package-Versions that are in dpkg_archive will generate a warning`
		1026
227	dpurdie	1027	`=back`
		1028
323	dpurdie	1029	`=back`
		1030
227	dpurdie	1031	`=head1 DESCRIPTION`
		1032
247	dpurdie	1033	`This utility is used within the automated build system to rewrite build files`
		1034	`so that they contain suitable version numbers.`
227	dpurdie	1035
247	dpurdie	1036	`The program takes a configuration file, described below, that contains package`
		1037	`and version information for the build.`
		1038
		1039	`The program takes a JATS build.pl file, or an ANT style dependency file, and`
		1040	`will create a file that is similar, but contains modified package-version`
		1041	`information.`
		1042
		1043	`The build tools are designed to use this I<auto> file, in preference to the`
		1044	`original build file.`
		1045
		1046	`=head2 Format of the Configuration File`
		1047
227	dpurdie	1048	`The format of the configuration file is defined below.`
		1049
247	dpurdie	1050	`The file is a line oriented text file.`
227	dpurdie	1051
247	dpurdie	1052	`Comments begin with a # and go the end of the line.`
227	dpurdie	1053
247	dpurdie	1054	`There are three types of configuration line:`
227	dpurdie	1055
247	dpurdie	1056	`=over 8`
		1057
		1058	`=item Assigned Items`
		1059
		1060	`These are of the form: B<tag = value> and are used to specify the value of`
361	dpurdie	1061	`the following special properties:`
247	dpurdie	1062
		1063	`=over 8`
		1064
		1065	`=item releasemanager.projectname`
		1066
		1067	`The name of the Release Manager project used for the build.`
		1068
		1069	`=item releasemanager.releasename`
		1070
		1071	`The name of the Release Manager release, within the project, used for the build.`
		1072
		1073	`=back`
		1074
		1075	`These may be used to brand installer programs with Release Information.`
		1076	`Currently the use of these tags is only supported by the XML build files.`
		1077
		1078	`=item Package Version`
		1079
		1080	`Specifies the version of a package to use as two, space separated words of the`
		1081	`form C<package_name package_version> where package version is of the form:`
		1082
		1083	`=over 8`
		1084
361	dpurdie	1085	`=item *`
247	dpurdie	1086
361	dpurdie	1087	`nn.nn.nnnn.aaa`
247	dpurdie	1088
361	dpurdie	1089	`=item *`
247	dpurdie	1090
361	dpurdie	1091	`nn.nn.nnnn`
		1092
		1093	`=item *`
		1094
		1095	`Other`
		1096
247	dpurdie	1097	`=back`
		1098
		1099	`=item LinkPkgArchive or BuildPkgArchive`
		1100
		1101	`These are standard JATS LinkPkgArchive or BuildPkgArchive statements.`
		1102
		1103	`=back`
		1104
		1105	`=head2 XML File Rewrite`
		1106
		1107	`This program will process an ERG style ANT build dependency definition file`
		1108	`and replace the values of the properties seen within the file.`
		1109
		1110	`The following properties are special within the rewrite process:`
		1111
		1112	`=over 8`
		1113
		1114	`=item packagename`
		1115
		1116	`This is the name of the package. It is not modified, but it`
		1117	`is used in conjunction with the C<packageversion> to identify the package, such`
		1118	`that the packageversion can be updated. This property is mandatory and must`
		1119	`appear before the C<packageversion>.`
		1120
		1121	`=item packageversion`
		1122
		1123	`This is the version of the package. It can be rewritten by this program. This`
		1124	`property is mandatory.`
		1125
		1126	`=item releasemanager.projectname`
		1127
361	dpurdie	1128	`If this property is found the value will be replaced with an`
		1129	`L<assigned item\|Assigned_Items> of the same name.`
247	dpurdie	1130
		1131	`=item releasemanager.releasename`
		1132
361	dpurdie	1133	`If this property is found the value will be replaced with an`
		1134	`L<assigned item\|Assigned_Items> of the same name.`
247	dpurdie	1135
		1136	`=back`
		1137
361	dpurdie	1138	`Properties that are not special will be treated as the name of a package and`
247	dpurdie	1139	`the value will be updated to reflect the required version of the package.`
		1140
		1141	`The XML rewrite process does not, and cannot handle, instances of packages`
		1142	`that have the same name, but different project suffixes. This is a limitation of`
		1143	`the ERG ANT build system and not a limitation of this utility.`
		1144
		1145	`=head2 JATS Build File Rewrite`
		1146
		1147	`This program will process a JATS style build.pl file and modify some`
		1148	`directives to update the file.`
		1149
		1150	`The following directives will be processed:`
		1151
		1152	`=over 8`
		1153
		1154	`=item BuildName`
		1155
		1156	`The existing version in the BuildName directive will be retained and may be used`
		1157	`in any BuildPreviousVersion directive that is seen.`
		1158
		1159	`=item BuildPreviousVersion`
		1160
		1161	`This will be updated to contain the version from the BuildName. This is`
		1162	`intended to be used by deployment scripts.`
		1163
		1164	`=item LinkPkgArchive`
		1165
		1166	`The version will be updated to reflect the configured package versions. The`
		1167	`project suffix, if present, will be used to identify the correct package.`
		1168
		1169	`=item BuildPkgArchive`
		1170
		1171	`The version will be updated to reflect the configured package versions. The`
		1172	`project suffix, if present, will be used to identify the correct package.`
		1173
		1174	`=back`
		1175
		1176	`The JATS build file rewrite process, unlike the ANT process, does handle, instances of packages`
		1177	`that have the same name, but different project suffixes. This allows the use`
		1178	`of packages such as C<sysbasetypes.cr> and C<sysbasetypes.prj> within the one`
		1179	`package.`
		1180
		1181	`Currently the JATS build file rewrite process does pass the`
		1182	`releasemanager.projectname and the releasemanager.releasename items through to`
		1183	`the underlying system. If present in the config file they will be unused. This`
		1184	`is not an error.`
		1185
227	dpurdie	1186	`=cut`
		1187

Subversion Repositories DevTools

(root)/core_devl/branches/dpurdie_devl/TOOLS/jats_rewrite.pl – Rev 391