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



my $opt_newproject;
my $opt_noconfig;
my $opt_validate;
my $opt_mode = 0;
my $opt_work_file = 'auto.new';
my $opt_zero;
 
#
#   Globals
#
my %component =  ();
my %component_use =  ();
my $suffix_count = 0;
my @pkg_errors;
my @pkg_errors_val;
my $max_pkglen = 10;
my $max_verlen = 15;
 
#
#   Known extended fields
#   Only these values may be configured with the value=tag syntax
#   These may not be used as package names

                "errors"        => \$opt_errors,        # flag
                "xml!"          => \$opt_xml,           # flag
                "oldproject=s"  => \$opt_oldproject,    # string
                "newproject=s"  => \$opt_newproject,    # string
                "validate"      => \$opt_validate,      # flag
                "zero!"         => \$opt_zero,          # flag
                "mode=s"        => \$opt_mode,          # Flag
                );
 
#
#   Process help and manual options

 
Error ("Conflicting options -config=file and -noconfig")
    if ( $opt_datafile && $opt_noconfig );
 
Error ("No configuration file specified")
    unless ( $opt_datafile || $opt_newproject || $opt_noconfig || $opt_zero );
 
Warning ("Input and output file are the same" )
    if ( !$opt_zero && !$opt_mode && $opt_infile eq $opt_ofile );
 
#
#   Auto detect XML files
#
$opt_xml = 1

    my $astamp = -M "auto.pl";
    $opt_infile = 'auto.pl'
        if ( $astamp && $astamp < $bstamp );
 
    $opt_infile = 'auto.xml' if ( -f 'auto.xml' );
 
}
Message ("Rewrite : $opt_infile -> $opt_ofile");
 
#
#   Process config and input files
#
read_config_file()          if $opt_datafile;

    #   Display all if verbose
    #
    if ( $diff || $opt_verbose || $opt_mode  )
    {
        $title = 'Package' unless ( $title );
        Message( sprintf("%-8s: %-${max_pkglen}s , Version: %-${max_verlen}s %1.1s-> %-${max_verlen}s\n", $title, $name ,$version, $diff, $new_version));
    }
}
 
#-------------------------------------------------------------------------------
# Function        : process_build_file

    Verbose ("Processing build file: $opt_infile");
 
    my $build_info;
    my $release_name;
    my $release_version;
    my @inputLines;
 
    #
    #   Unlink any OLD output file
    #
    unlink $opt_work_file;

    binmode(OUTFILE);
 
    #
    #   Read input file and process as an array of lines
    #
    @inputLines = getInputLines($opt_infile);
 
    #
    #   Scan the input file and do a quick examine
    #   of the package names. All we are doing is determining the max package name lenght
    #   so that we can generate a pretty display.
    #
    $max_pkglen = $max_verlen = 0;
    foreach ( @inputLines )
    {
        next if ( $opt_noconfig );       # Nothing to do
        next if ( m~^\s*#~ );            # Skip comments
        #
        #   Process BuildPkgArchive and LinkPkgArchive
        if ( m/^\s*LinkPkgArchive/ or m/^\s*BuildPkgArchive/ )
        {
            m/['"](.*?)['"][^'"]*['"](.*?)['"]/;
 
            my $comp = $1;
            my $ver = $2;
 
            my $len = length $comp;
            $max_pkglen = $len if ( $len > $max_pkglen );
            $len = length $ver;
            $max_verlen = $len if ( $len > $max_verlen );
        }
    }
 
    #
    #   Process the input lines and re-write the version numbers
    #
    foreach ( @inputLines )
    {
        next if ( $opt_noconfig );       # Nothing to do
        next if ( m~^\s*#~ );            # Skip comments
 
        #

 
            #
            #   In Special Mode, don't change the version of this package
            #   Assume that the user has fiddled with it.
            #
            if ( $opt_mode && !$opt_zero ) {
                $new_ver = $build_info->{BUILDVERSION};
            } else {
                $new_ver = get_package ( $build_info->{BUILDNAME_PACKAGE}, $build_info->{BUILDVERSION} );
            }
            my $build_args = genBuildName( $build_info, $new_ver );

# Returns         :
#
sub display_unused
{
    return
        if ( $opt_mode || $opt_zero );
 
    foreach my $comp ( sort keys %component_use )
    {
        foreach my $suf ( keys %{$component_use{$comp}} )
        {

 
    #
    #   Determine longest package name
    #
    my $len = length $package;
    $max_pkglen = $len if ( $len > $max_pkglen );
 
    $len = length $version;
    $max_verlen = $len if ( $len > $max_verlen );
 
    #
    #   Split the suffix off the version
    #
    my ($rel, $suf ) = extract_version( $package, $version);

    if ( $opt_datafile )
    {
        unless ( exists $component{$package} )
        {
            push @pkg_errors, "No definitions for package '$package'";
            $version = get_version( $package, $suf, $rel ) if $opt_zero;
            return $version;
        }
 
    #    print Data::Dumper->Dump ( [\%component], ["Component" ]);
 
        unless ( exists $component{$package}{$suf} )
        {
            push @pkg_errors, "No definitions for '$package' '$version' '$suf'";
            $version = get_version( $package, $suf, $rel ) if $opt_zero;
            return $version;
        }
    }
 
    #

    my $new_version = get_version( $package, $suf, $rel );
    if ( $opt_validate )
    {
        if ( $new_version ne $version )
        {
            push @pkg_errors_val, sprintf("Validation mismatch: %-${max_pkglen}s , %-${max_verlen}s != %-${max_verlen}s", $package ,$version,  $new_version);
            return $version;
        }
    }
    return $new_version;
}

#
sub get_version
{
    my ($package,$suf, $version) = @_;
 
    if ($opt_zero) {
 
        $version = '0.0.0000';
 
 
    } else {
        if ( exists( $component{$package}{$suf} ) ) {
            $version = $component{$package}{$suf};
        }
 
        if ( $opt_oldproject && $suf eq $opt_oldproject ) {
            $suf = $opt_newproject;
            $suffix_count++;
        }
    }
    
    $version .= '.' . $suf if ( length( $suf) );
    return  $version;
 

    -outfile xxx        - Output file (auto.pl)
    -errors             - Generate errors for unused config items
    -xml                - Process a build.xml file
    -validate           - Validate dependencies only
    -mode=nn            - Special operational modes
    -zero               - Zero the version numbers
 
=head1 OPTIONS
 
=over 8
 

 
Package-Versions that are in dpkg_archive will generate a warning
 
=back
 
=item B<-[no]zero>
 
This option will force the version numbers to 0.0.0000.
 
=back
 
=head1 DESCRIPTION
 
This utility is used within the automated build system to rewrite build files

Rev 6192	Rev 6619
Line 40...	Line 40...
40	`my $opt_newproject;`	40	`my $opt_newproject;`
41	`my $opt_noconfig;`	41	`my $opt_noconfig;`
42	`my $opt_validate;`	42	`my $opt_validate;`
43	`my $opt_mode = 0;`	43	`my $opt_mode = 0;`
44	`my $opt_work_file = 'auto.new';`	44	`my $opt_work_file = 'auto.new';`
-		45	`my $opt_zero;`
45		46
46	`#`	47	`#`
47	`# Globals`	48	`# Globals`
48	`#`	49	`#`
49	`my %component = ();`	50	`my %component = ();`
50	`my %component_use = ();`	51	`my %component_use = ();`
51	`my $suffix_count = 0;`	52	`my $suffix_count = 0;`
52	`my @pkg_errors;`	53	`my @pkg_errors;`
53	`my @pkg_errors_val;`	54	`my @pkg_errors_val;`
54	`my $max_pkglen = 10;`	55	`my $max_pkglen = 10;`
-		56	`my $max_verlen = 15;`
55		57
56	`#`	58	`#`
57	`# Known extended fields`	59	`# Known extended fields`
58	`# Only these values may be configured with the value=tag syntax`	60	`# Only these values may be configured with the value=tag syntax`
59	`# These may not be used as package names`	61	`# These may not be used as package names`
Line 74...	Line 76...
74	`"errors" => \$opt_errors, # flag`	76	`"errors" => \$opt_errors, # flag`
75	`"xml!" => \$opt_xml, # flag`	77	`"xml!" => \$opt_xml, # flag`
76	`"oldproject=s" => \$opt_oldproject, # string`	78	`"oldproject=s" => \$opt_oldproject, # string`
77	`"newproject=s" => \$opt_newproject, # string`	79	`"newproject=s" => \$opt_newproject, # string`
78	`"validate" => \$opt_validate, # flag`	80	`"validate" => \$opt_validate, # flag`
-		81	`"zero!" => \$opt_zero, # flag`
79	`"mode=s" => \$opt_mode, # Flag`	82	`"mode=s" => \$opt_mode, # Flag`
80	`);`	83	`);`
81		84
82	`#`	85	`#`
83	`# Process help and manual options`	86	`# Process help and manual options`
Line 97...	Line 100...
97		100
98	`Error ("Conflicting options -config=file and -noconfig")`	101	`Error ("Conflicting options -config=file and -noconfig")`
99	`if ( $opt_datafile && $opt_noconfig );`	102	`if ( $opt_datafile && $opt_noconfig );`
100		103
101	`Error ("No configuration file specified")`	104	`Error ("No configuration file specified")`
102	`unless ( $opt_datafile \|\| $opt_newproject \|\| $opt_noconfig );`	105	`unless ( $opt_datafile \|\| $opt_newproject \|\| $opt_noconfig \|\| $opt_zero );`
103		106
104	`Warning ("Input and output file are the same" )`	107	`Warning ("Input and output file are the same" )`
105	`if ( ! $opt_mode && $opt_infile eq $opt_ofile );`	108	`if ( !$opt_zero && !$opt_mode && $opt_infile eq $opt_ofile );`
106		109
107	`#`	110	`#`
108	`# Auto detect XML files`	111	`# Auto detect XML files`
109	`#`	112	`#`
110	`$opt_xml = 1`	113	`$opt_xml = 1`
Line 123...	Line 126...
123	`my $astamp = -M "auto.pl";`	126	`my $astamp = -M "auto.pl";`
124	`$opt_infile = 'auto.pl'`	127	`$opt_infile = 'auto.pl'`
125	`if ( $astamp && $astamp < $bstamp );`	128	`if ( $astamp && $astamp < $bstamp );`
126		129
127	`$opt_infile = 'auto.xml' if ( -f 'auto.xml' );`	130	`$opt_infile = 'auto.xml' if ( -f 'auto.xml' );`
128	`Message ("Using: $opt_infile");`	-
129	`}`	131	`}`
-		132	`Message ("Rewrite : $opt_infile -> $opt_ofile");`
130		133
131	`#`	134	`#`
132	`# Process config and input files`	135	`# Process config and input files`
133	`#`	136	`#`
134	`read_config_file() if $opt_datafile;`	137	`read_config_file() if $opt_datafile;`
Line 259...	Line 262...
259	`# Display all if verbose`	262	`# Display all if verbose`
260	`#`	263	`#`
261	`if ( $diff \|\| $opt_verbose \|\| $opt_mode )`	264	`if ( $diff \|\| $opt_verbose \|\| $opt_mode )`
262	`{`	265	`{`
263	`$title = 'Package' unless ( $title );`	266	`$title = 'Package' unless ( $title );`
264	`Message( sprintf("%-8s: %-${max_pkglen}s, Version: %-15s %1.1s-> %-15s\n", $title, $name ,$version, $diff, $new_version));`	267	`Message( sprintf("%-8s: %-${max_pkglen}s , Version: %-${max_verlen}s %1.1s-> %-${max_verlen}s\n", $title, $name ,$version, $diff, $new_version));`
265	`}`	268	`}`
266	`}`	269	`}`
267		270
268	`#-------------------------------------------------------------------------------`	271	`#-------------------------------------------------------------------------------`
269	`# Function : process_build_file`	272	`# Function : process_build_file`
Line 280...	Line 283...
280	`Verbose ("Processing build file: $opt_infile");`	283	`Verbose ("Processing build file: $opt_infile");`
281		284
282	`my $build_info;`	285	`my $build_info;`
283	`my $release_name;`	286	`my $release_name;`
284	`my $release_version;`	287	`my $release_version;`
-		288	`my @inputLines;`
285		289
286	`#`	290	`#`
287	`# Unlink any OLD output file`	291	`# Unlink any OLD output file`
288	`#`	292	`#`
289	`unlink $opt_work_file;`	293	`unlink $opt_work_file;`
Line 295...	Line 299...
295	`binmode(OUTFILE);`	299	`binmode(OUTFILE);`
296		300
297	`#`	301	`#`
298	`# Read input file and process as an array of lines`	302	`# Read input file and process as an array of lines`
299	`#`	303	`#`
300	`foreach ( getInputLines($opt_infile) )`	304	`@inputLines = getInputLines($opt_infile);`
-		305
-		306	`#`
-		307	`# Scan the input file and do a quick examine`
-		308	`# of the package names. All we are doing is determining the max package name lenght`
-		309	`# so that we can generate a pretty display.`
-		310	`#`
-		311	`$max_pkglen = $max_verlen = 0;`
-		312	`foreach ( @inputLines )`
-		313	`{`
-		314	`next if ( $opt_noconfig ); # Nothing to do`
-		315	`next if ( m~^\s*#~ ); # Skip comments`
-		316	`#`
-		317	`# Process BuildPkgArchive and LinkPkgArchive`
-		318	`if ( m/^\sLinkPkgArchive/ or m/^\sBuildPkgArchive/ )`
-		319	`{`
-		320	`m/['"](.?)['"][^'"]['"](.*?)['"]/;`
-		321
-		322	`my $comp = $1;`
-		323	`my $ver = $2;`
-		324
-		325	`my $len = length $comp;`
-		326	`$max_pkglen = $len if ( $len > $max_pkglen );`
-		327	`$len = length $ver;`
-		328	`$max_verlen = $len if ( $len > $max_verlen );`
-		329	`}`
-		330	`}`
-		331
-		332	`#`
-		333	`# Process the input lines and re-write the version numbers`
-		334	`#`
-		335	`foreach ( @inputLines )`
301	`{`	336	`{`
302	`next if ( $opt_noconfig ); # Nothing to do`	337	`next if ( $opt_noconfig ); # Nothing to do`
303	`next if ( m~^\s*#~ ); # Skip comments`	338	`next if ( m~^\s*#~ ); # Skip comments`
304		339
305	`#`	340	`#`
Line 324...	Line 359...
324		359
325	`#`	360	`#`
326	`# In Special Mode, don't change the version of this package`	361	`# In Special Mode, don't change the version of this package`
327	`# Assume that the user has fiddled with it.`	362	`# Assume that the user has fiddled with it.`
328	`#`	363	`#`
329	`if ( $opt_mode ) {`	364	`if ( $opt_mode && !$opt_zero ) {`
330	`$new_ver = $build_info->{BUILDVERSION};`	365	`$new_ver = $build_info->{BUILDVERSION};`
331	`} else {`	366	`} else {`
332	`$new_ver = get_package ( $build_info->{BUILDNAME_PACKAGE}, $build_info->{BUILDVERSION} );`	367	`$new_ver = get_package ( $build_info->{BUILDNAME_PACKAGE}, $build_info->{BUILDVERSION} );`
333	`}`	368	`}`
334	`my $build_args = genBuildName( $build_info, $new_ver );`	369	`my $build_args = genBuildName( $build_info, $new_ver );`
Line 655...	Line 690...
655	`# Returns :`	690	`# Returns :`
656	`#`	691	`#`
657	`sub display_unused`	692	`sub display_unused`
658	`{`	693	`{`
659	`return`	694	`return`
660	`if ( $opt_mode );`	695	`if ( $opt_mode \|\| $opt_zero );`
661		696
662	`foreach my $comp ( sort keys %component_use )`	697	`foreach my $comp ( sort keys %component_use )`
663	`{`	698	`{`
664	`foreach my $suf ( keys %{$component_use{$comp}} )`	699	`foreach my $suf ( keys %{$component_use{$comp}} )`
665	`{`	700	`{`
Line 693...	Line 728...
693		728
694	`#`	729	`#`
695	`# Determine longest package name`	730	`# Determine longest package name`
696	`#`	731	`#`
697	`my $len = length $package;`	732	`my $len = length $package;`
-		733	`$max_pkglen = $len if ( $len > $max_pkglen );`
-		734
698	`$max_pkglen = $len`	735	`$len = length $version;`
699	`if ( $len > $max_pkglen );`	736	`$max_verlen = $len if ( $len > $max_verlen );`
700		737
701	`#`	738	`#`
702	`# Split the suffix off the version`	739	`# Split the suffix off the version`
703	`#`	740	`#`
704	`my ($rel, $suf ) = extract_version( $package, $version);`	741	`my ($rel, $suf ) = extract_version( $package, $version);`
Line 763...	Line 800...
763	`if ( $opt_datafile )`	800	`if ( $opt_datafile )`
764	`{`	801	`{`
765	`unless ( exists $component{$package} )`	802	`unless ( exists $component{$package} )`
766	`{`	803	`{`
767	`push @pkg_errors, "No definitions for package '$package'";`	804	`push @pkg_errors, "No definitions for package '$package'";`
-		805	`$version = get_version( $package, $suf, $rel ) if $opt_zero;`
768	`return $version;`	806	`return $version;`
769	`}`	807	`}`
770		808
771	`# print Data::Dumper->Dump ( [\%component], ["Component" ]);`	809	`# print Data::Dumper->Dump ( [\%component], ["Component" ]);`
772		810
773	`unless ( exists $component{$package}{$suf} )`	811	`unless ( exists $component{$package}{$suf} )`
774	`{`	812	`{`
775	`push @pkg_errors, "No definitions for '$package' '$version' '$suf'";`	813	`push @pkg_errors, "No definitions for '$package' '$version' '$suf'";`
-		814	`$version = get_version( $package, $suf, $rel ) if $opt_zero;`
776	`return $version;`	815	`return $version;`
777	`}`	816	`}`
778	`}`	817	`}`
779		818
780	`#`	819	`#`
Line 789...	Line 828...
789	`my $new_version = get_version( $package, $suf, $rel );`	828	`my $new_version = get_version( $package, $suf, $rel );`
790	`if ( $opt_validate )`	829	`if ( $opt_validate )`
791	`{`	830	`{`
792	`if ( $new_version ne $version )`	831	`if ( $new_version ne $version )`
793	`{`	832	`{`
794	`push @pkg_errors_val, sprintf("Validation mismatch: %-${max_pkglen}s, %-15s != %-15s", $package ,$version, $new_version);`	833	`push @pkg_errors_val, sprintf("Validation mismatch: %-${max_pkglen}s , %-${max_verlen}s != %-${max_verlen}s", $package ,$version, $new_version);`
795	`return $version;`	834	`return $version;`
796	`}`	835	`}`
797	`}`	836	`}`
798	`return $new_version;`	837	`return $new_version;`
799	`}`	838	`}`
Line 850...	Line 889...
850	`#`	889	`#`
851	`sub get_version`	890	`sub get_version`
852	`{`	891	`{`
853	`my ($package,$suf, $version) = @_;`	892	`my ($package,$suf, $version) = @_;`
854		893
855	`if ( exists( $component{$package}{$suf} ) )`	894	`if ($opt_zero) {`
856	`{`	-
857	`$version = $component{$package}{$suf};`	895	`$version = '0.0.0000';`
858	`}`	-
859		896
-		897	`} else {`
860	`if ( $opt_oldproject && $suf eq $opt_oldproject )`	898	`if ( exists( $component{$package}{$suf} ) ) {`
-		899	`$version = $component{$package}{$suf};`
861	`{`	900	`}`
-		901
-		902	`if ( $opt_oldproject && $suf eq $opt_oldproject ) {`
862	`$suf = $opt_newproject;`	903	`$suf = $opt_newproject;`
863	`$suffix_count++;`	904	`$suffix_count++;`
-		905	`}`
864	`}`	906	`}`
865		907
866	`$version .= '.' . $suf if ( length( $suf) );`	908	`$version .= '.' . $suf if ( length( $suf) );`
867	`return $version;`	909	`return $version;`
868		910
Line 959...	Line 1001...
959	`-outfile xxx - Output file (auto.pl)`	1001	`-outfile xxx - Output file (auto.pl)`
960	`-errors - Generate errors for unused config items`	1002	`-errors - Generate errors for unused config items`
961	`-xml - Process a build.xml file`	1003	`-xml - Process a build.xml file`
962	`-validate - Validate dependencies only`	1004	`-validate - Validate dependencies only`
963	`-mode=nn - Special operational modes`	1005	`-mode=nn - Special operational modes`
-		1006	`-zero - Zero the version numbers`
964		1007
965	`=head1 OPTIONS`	1008	`=head1 OPTIONS`
966		1009
967	`=over 8`	1010	`=over 8`
968		1011
Line 1073...	Line 1116...
1073		1116
1074	`Package-Versions that are in dpkg_archive will generate a warning`	1117	`Package-Versions that are in dpkg_archive will generate a warning`
1075		1118
1076	`=back`	1119	`=back`
1077		1120
-		1121	`=item B<-[no]zero>`
-		1122
-		1123	`This option will force the version numbers to 0.0.0000.`
-		1124
1078	`=back`	1125	`=back`
1079		1126
1080	`=head1 DESCRIPTION`	1127	`=head1 DESCRIPTION`
1081		1128
1082	`This utility is used within the automated build system to rewrite build files`	1129	`This utility is used within the automated build system to rewrite build files`

Subversion Repositories DevTools

(root)/core_devl/trunk/TOOLS/jats_rewrite.pl – Rev 6192 → 6619