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

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

Subversion Repositories DevTools

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