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



#
my $USER            = $ENV{'USER'};
my $UNIX            = $ENV{'GBE_UNIX'};
my $HOME            = $ENV{'HOME'};
my $GBE_SANDBOX     = $ENV{'GBE_SANDBOX'};
my $GBE_ABT         = $ENV{'GBE_ABT'} || '0';
 
#
#   Globals
#
my $MACHINENAME;

#
Verbose("Locate Source VOB");
if ( $opt_path )
{
    $opt_path =~ tr~\\/~/~s;
    $opt_path =~ s~/+$~~;
 
    Error( "Source Path needs leading '/'") unless ( $opt_path =~ m~^/~ );
    Error( "Source Path is a UNC" ) if ( $opt_path =~ m~^//~ );
    Error( "Source Path has drive specifier" ) if ( $opt_path =~ m~^[A-Za-z]\:~ );
 

{
    #
    #   Extend the list of ROOT_VOBS with all the known vobs
    #   The initial ROOT_VOBS are treated as a "hint" to assist searching
    #
        my $cmd = ClearToolCmd ('lsvob', '-short');
        open(CMD, "$cmd 2>&1 |") || Error( "can't run command: $!");
        while (<CMD>)
        {
            #
            #   Filter output from the user

        $vob = $UNIX_VOB_PREFIX . $vob if ( $UNIX );
        (my $vob_name = $vob) =~ s~/~$VOB_SEP~g;
 
        Verbose2 ("Examine label $spec in vob: $vob" );
 
        my $cmd = ClearToolCmd ('lstype', "lbtype:$spec\@$vob_name");
        open(CMD, "$cmd 2>&1 |") || Error( "can't run command: $!");
        while (<CMD>)
        {
            #
            #   Filter output from the user

        Message( "Locking labels" );
        foreach my $spec ( @label_not_locked )
        {
            Verbose ("Locking $spec");
            push @label_locked, $spec;
            ClearCmd ('lock', "lbtype:$spec$root_vob_spec" );
            push @still_not_locked, $spec if ( @error_list );
        }
        @label_not_locked = @still_not_locked;
 
        #

    #       2) Deleting the view could be a problem if the user had
    #          files open in the view.
    #       3) Documentation doesn't really like the use of -colocated
    #
 
    ClearTool( 'mkview', '-snapshot', '-tag', $VIEWTAG, $VIEWDIR);
    Error ("Cannot locate the created static view")
        unless ( -d $VIEWDIR );
 
    #   In order to operate in this view (ie set the config spec, we need to
    #   be in the directory of the view

    {
        $config_file = create_config_spec ('config_spec.txt');
    }
 
    Message( "Populating the view");
    ClearTool( 'setcs', '-tag', $VIEWTAG, $config_file );
}
 
#
#   Locate the JATS build files within the populated view
#

            if ( -d $file )
            {
                Verbose ("Examine $file for checked out files");
                chdir "$VIEWDIR/$file";
 
                my $cmd = ClearToolCmd('lsco', '-cview', '-rec' );
                open(CMD, "$cmd 2>&1 |") || Error( "can't run command: $!");
                while (<CMD>)
                {
                    #
                    #   Filter output from the user

        chdir ( $user_cwd );
 
        #
        #   Static views should be removed by dirname, not by tag
        #
        ClearTool( 'rmview', $VIEWDIR );
 
        #
        #   Now try to delete the directory
        #
        rmtree( $VIEWDIR );

    #
    #   If the view tag still exists then delete the view the hard way
    #   Use 'lsview' to locate the views uuid
    #
    Verbose("Look for View Tag");
    my $cmd = ClearToolCmd ('lsview', '-long', $VIEWTAG );
    open(CMD, "$cmd 2>&1 |") || Error( "can't run command: $!");
    while (<CMD>)
    {
        #
        #   Filter output from the user

    close(CMD);
 
    if ( $uuid )
    {
        Warning ("Deleting view - the hard way");
        ClearTool( '--Quiet', 'rmview', '-force', '-all', '-uuid', $uuid );
        ClearTool( '--Quiet', 'unregister', '-view', '-uuid', $uuid );
        ClearTool( '--Quiet', 'rmtag','-view', '-all', $VIEWTAG );
    }
 
 
    Error ("View was not deleted")
        if ( -d $VIEWDIR );

    {
        $quiet = 1;
        shift;
    }
 
    my $cmd = ClearToolCmd(@_);
 
 
    open(CMD, "$cmd 2>&1 |") || Error "can't run command: $!";
    while (<CMD>)
    {
        #
        #   Filter output from the user

#
# Description     : Execute a cleartool command
#                   Capture error messages only
#
# Inputs          : Command to execute
#                   Takes an array of command argumeents and will quote them
#
# Returns         : Exit code
#                   Also the global @error_list
#
sub ClearCmd
{
    @error_list = ();
 
 
    my $cmd = ClearToolCmd(@_);
    open(CMD, "$cmd  2>&1 |")    || Error "can't run command: $!";
    while (<CMD>)
    {
        chomp;
        Verbose ($_);
        push @error_list, $_ if ( m~Error:~ );
    }
    close(CMD);
 
    Verbose2 "Exit Status: $?";
    return $? / 256;
}
 
#-------------------------------------------------------------------------------
# Function        : ClearToolCmd
#
# Description     : Create a nice escaped cleartool command
#
# Inputs          : An array of cleartool command line arguments
#
# Returns         : A string that has been quoted
#
sub ClearToolCmd
{
    my $cmd = 'cleartool ' . QuoteCommand( @_);
    Verbose2 $cmd;
    return $cmd;
}
 
#-------------------------------------------------------------------------------
# Function        : unlock_on_error
#
# Description     : Error cleanup function.
#                   Called by the error processing
#                   Called to unlock all labels that have been locked by this

    my @still_locked;
    Message( "Releasing Locked labels" );
    foreach my $spec ( @label_locked )
    {
        Verbose ("Unlocking:$spec");
        ClearCmd ('unlock', "lbtype:$spec$root_vob_spec" );
        push @still_locked, $spec if ( @error_list );
    }
    Error ("Not all labels unlocked: @still_locked") if ( @still_locked  );
}
 

    }
 
    #
    #   Create the view and insert the config spec
    #
    ClearCmd ( 'rmview', '-tag', $VIEWTAG );
    ClearCmd ( 'mkview', '-tag', $VIEWTAG, '-stgloc', '-auto' );
    ClearCmd ( 'setcs',  '-tag', $VIEWTAG, $config );
 
    #
    #   Ensure that the base VOB has been 'mounted'
    #   Dynamic views require vobs to be mounted
    #
    ($vob_name = $ROOT_VOB) =~ s~/~$VOB_SEP~g;
    $vob_mounted = ClearCmd ('mount', $vob_name);
 
    #
    #   Calculate where the dynmaic view will be
    #   This differ between UNIX/WINDOWS
    #

    Message ("View files in: $VIEWDIR, Files: $copy_count" );
 
    #
    #   Remove the view
    #
    ClearCmd ( 'rmview', '-tag', $VIEWTAG );
 
    #
    #   Unmount the vob - if mounted
    #
    ClearCmd ('umount', $vob_name) unless $vob_mounted;
 
    Error ("Copy did not complete without error")
        if ( $rv );
 
}

Rev 241	Rev 243
Line 76...	Line 76...
76	`#`	76	`#`
77	`my $USER = $ENV{'USER'};`	77	`my $USER = $ENV{'USER'};`
78	`my $UNIX = $ENV{'GBE_UNIX'};`	78	`my $UNIX = $ENV{'GBE_UNIX'};`
79	`my $HOME = $ENV{'HOME'};`	79	`my $HOME = $ENV{'HOME'};`
80	`my $GBE_SANDBOX = $ENV{'GBE_SANDBOX'};`	80	`my $GBE_SANDBOX = $ENV{'GBE_SANDBOX'};`
-		81	`my $GBE_ABT = $ENV{'GBE_ABT'} \|\| '0';`
81		82
82	`#`	83	`#`
83	`# Globals`	84	`# Globals`
84	`#`	85	`#`
85	`my $MACHINENAME;`	86	`my $MACHINENAME;`
Line 347...	Line 348...
347	`#`	348	`#`
348	`Verbose("Locate Source VOB");`	349	`Verbose("Locate Source VOB");`
349	`if ( $opt_path )`	350	`if ( $opt_path )`
350	`{`	351	`{`
351	`$opt_path =~ tr~\\/~/~s;`	352	`$opt_path =~ tr~\\/~/~s;`
-		353	`$opt_path =~ s~/+$~~;`
352		354
353	`Error( "Source Path needs leading '/'") unless ( $opt_path =~ m~^/~ );`	355	`Error( "Source Path needs leading '/'") unless ( $opt_path =~ m~^/~ );`
354	`Error( "Source Path is a UNC" ) if ( $opt_path =~ m~^//~ );`	356	`Error( "Source Path is a UNC" ) if ( $opt_path =~ m~^//~ );`
355	`Error( "Source Path has drive specifier" ) if ( $opt_path =~ m~^[A-Za-z]\:~ );`	357	`Error( "Source Path has drive specifier" ) if ( $opt_path =~ m~^[A-Za-z]\:~ );`
356		358
Line 381...	Line 383...
381	`{`	383	`{`
382	`#`	384	`#`
383	`# Extend the list of ROOT_VOBS with all the known vobs`	385	`# Extend the list of ROOT_VOBS with all the known vobs`
384	`# The initial ROOT_VOBS are treated as a "hint" to assist searching`	386	`# The initial ROOT_VOBS are treated as a "hint" to assist searching`
385	`#`	387	`#`
386	`my $cmd = "cleartool lsvob -short";`	388	`my $cmd = ClearToolCmd ('lsvob', '-short');`
387	`open(CMD, "$cmd 2>&1 \|") \|\| Error( "can't run command: $!");`	389	`open(CMD, "$cmd 2>&1 \|") \|\| Error( "can't run command: $!");`
388	`while (<CMD>)`	390	`while (<CMD>)`
389	`{`	391	`{`
390	`#`	392	`#`
391	`# Filter output from the user`	393	`# Filter output from the user`
Line 413...	Line 415...
413	`$vob = $UNIX_VOB_PREFIX . $vob if ( $UNIX );`	415	`$vob = $UNIX_VOB_PREFIX . $vob if ( $UNIX );`
414	`(my $vob_name = $vob) =~ s~/~$VOB_SEP~g;`	416	`(my $vob_name = $vob) =~ s~/~$VOB_SEP~g;`
415		417
416	`Verbose2 ("Examine label $spec in vob: $vob" );`	418	`Verbose2 ("Examine label $spec in vob: $vob" );`
417		419
418	`my $cmd = "cleartool lstype lbtype:$spec\@$vob_name";`	420	`my $cmd = ClearToolCmd ('lstype', "lbtype:$spec\@$vob_name");`
419	`open(CMD, "$cmd 2>&1 \|") \|\| Error( "can't run command: $!");`	421	`open(CMD, "$cmd 2>&1 \|") \|\| Error( "can't run command: $!");`
420	`while (<CMD>)`	422	`while (<CMD>)`
421	`{`	423	`{`
422	`#`	424	`#`
423	`# Filter output from the user`	425	`# Filter output from the user`
Line 482...	Line 484...
482	`Message( "Locking labels" );`	484	`Message( "Locking labels" );`
483	`foreach my $spec ( @label_not_locked )`	485	`foreach my $spec ( @label_not_locked )`
484	`{`	486	`{`
485	`Verbose ("Locking $spec");`	487	`Verbose ("Locking $spec");`
486	`push @label_locked, $spec;`	488	`push @label_locked, $spec;`
487	`ClearCmd ("lock lbtype:$spec$root_vob_spec" );`	489	`ClearCmd ('lock', "lbtype:$spec$root_vob_spec" );`
488	`push @still_not_locked, $spec if ( @error_list );`	490	`push @still_not_locked, $spec if ( @error_list );`
489	`}`	491	`}`
490	`@label_not_locked = @still_not_locked;`	492	`@label_not_locked = @still_not_locked;`
491		493
492	`#`	494	`#`
Line 520...	Line 522...
520	`# 2) Deleting the view could be a problem if the user had`	522	`# 2) Deleting the view could be a problem if the user had`
521	`# files open in the view.`	523	`# files open in the view.`
522	`# 3) Documentation doesn't really like the use of -colocated`	524	`# 3) Documentation doesn't really like the use of -colocated`
523	`#`	525	`#`
524		526
525	`ClearTool( "mkview -snapshot -tag $VIEWTAG $VIEWDIR");`	527	`ClearTool( 'mkview', '-snapshot', '-tag', $VIEWTAG, $VIEWDIR);`
526	`Error ("Cannot locate the created static view")`	528	`Error ("Cannot locate the created static view")`
527	`unless ( -d $VIEWDIR );`	529	`unless ( -d $VIEWDIR );`
528		530
529	`# In order to operate in this view (ie set the config spec, we need to`	531	`# In order to operate in this view (ie set the config spec, we need to`
530	`# be in the directory of the view`	532	`# be in the directory of the view`
Line 544...	Line 546...
544	`{`	546	`{`
545	`$config_file = create_config_spec ('config_spec.txt');`	547	`$config_file = create_config_spec ('config_spec.txt');`
546	`}`	548	`}`
547		549
548	`Message( "Populating the view");`	550	`Message( "Populating the view");`
549	`ClearTool( "setcs -tag $VIEWTAG $config_file" );`	551	`ClearTool( 'setcs', '-tag', $VIEWTAG, $config_file );`
550	`}`	552	`}`
551		553
552	`#`	554	`#`
553	`# Locate the JATS build files within the populated view`	555	`# Locate the JATS build files within the populated view`
554	`#`	556	`#`
Line 784...	Line 786...
784	`if ( -d $file )`	786	`if ( -d $file )`
785	`{`	787	`{`
786	`Verbose ("Examine $file for checked out files");`	788	`Verbose ("Examine $file for checked out files");`
787	`chdir "$VIEWDIR/$file";`	789	`chdir "$VIEWDIR/$file";`
788		790
789	`my $cmd = "cleartool lsco -cview -rec";`	791	`my $cmd = ClearToolCmd('lsco', '-cview', '-rec' );`
790	`open(CMD, "$cmd 2>&1 \|") \|\| Error( "can't run command: $!");`	792	`open(CMD, "$cmd 2>&1 \|") \|\| Error( "can't run command: $!");`
791	`while (<CMD>)`	793	`while (<CMD>)`
792	`{`	794	`{`
793	`#`	795	`#`
794	`# Filter output from the user`	796	`# Filter output from the user`
Line 815...	Line 817...
815	`chdir ( $user_cwd );`	817	`chdir ( $user_cwd );`
816		818
817	`#`	819	`#`
818	`# Static views should be removed by dirname, not by tag`	820	`# Static views should be removed by dirname, not by tag`
819	`#`	821	`#`
820	`ClearTool( "rmview $VIEWDIR" );`	822	`ClearTool( 'rmview', $VIEWDIR );`
821		823
822	`#`	824	`#`
823	`# Now try to delete the directory`	825	`# Now try to delete the directory`
824	`#`	826	`#`
825	`rmtree( $VIEWDIR );`	827	`rmtree( $VIEWDIR );`
Line 828...	Line 830...
828	`#`	830	`#`
829	`# If the view tag still exists then delete the view the hard way`	831	`# If the view tag still exists then delete the view the hard way`
830	`# Use 'lsview' to locate the views uuid`	832	`# Use 'lsview' to locate the views uuid`
831	`#`	833	`#`
832	`Verbose("Look for View Tag");`	834	`Verbose("Look for View Tag");`
833	`my $cmd = "cleartool lsview -long $VIEWTAG";`	835	`my $cmd = ClearToolCmd ('lsview', '-long', $VIEWTAG );`
834	`open(CMD, "$cmd 2>&1 \|") \|\| Error( "can't run command: $!");`	836	`open(CMD, "$cmd 2>&1 \|") \|\| Error( "can't run command: $!");`
835	`while (<CMD>)`	837	`while (<CMD>)`
836	`{`	838	`{`
837	`#`	839	`#`
838	`# Filter output from the user`	840	`# Filter output from the user`
Line 844...	Line 846...
844	`close(CMD);`	846	`close(CMD);`
845		847
846	`if ( $uuid )`	848	`if ( $uuid )`
847	`{`	849	`{`
848	`Warning ("Deleting view - the hard way");`	850	`Warning ("Deleting view - the hard way");`
849	`ClearTool( "--Quiet", "rmview -force -all -uuid $uuid" );`	851	`ClearTool( '--Quiet', 'rmview', '-force', '-all', '-uuid', $uuid );`
850	`ClearTool( "--Quiet", "unregister -view -uuid $uuid" );`	852	`ClearTool( '--Quiet', 'unregister', '-view', '-uuid', $uuid );`
851	`ClearTool( "--Quiet", "rmtag -view -all $VIEWTAG" );`	853	`ClearTool( '--Quiet', 'rmtag','-view', '-all', $VIEWTAG );`
852	`}`	854	`}`
853		855
854		856
855	`Error ("View was not deleted")`	857	`Error ("View was not deleted")`
856	`if ( -d $VIEWDIR );`	858	`if ( -d $VIEWDIR );`
Line 1028...	Line 1030...
1028	`{`	1030	`{`
1029	`$quiet = 1;`	1031	`$quiet = 1;`
1030	`shift;`	1032	`shift;`
1031	`}`	1033	`}`
1032		1034
1033	`my $cmd = "cleartool @_";`	1035	`my $cmd = ClearToolCmd(@_);`
1034		-
1035	`Verbose ("ClearTool: $cmd");`	-
1036	`open(CMD, "$cmd 2>&1 \|") \|\| Error "can't run command: $!";`	1036	`open(CMD, "$cmd 2>&1 \|") \|\| Error "can't run command: $!";`
1037	`while (<CMD>)`	1037	`while (<CMD>)`
1038	`{`	1038	`{`
1039	`#`	1039	`#`
1040	`# Filter output from the user`	1040	`# Filter output from the user`
Line 1060...	Line 1060...
1060	`#`	1060	`#`
1061	`# Description : Execute a cleartool command`	1061	`# Description : Execute a cleartool command`
1062	`# Capture error messages only`	1062	`# Capture error messages only`
1063	`#`	1063	`#`
1064	`# Inputs : Command to execute`	1064	`# Inputs : Command to execute`
-		1065	`# Takes an array of command argumeents and will quote them`
1065	`#`	1066	`#`
1066	`# Returns : Exit code`	1067	`# Returns : Exit code`
1067	`# Also the global @error_list`	1068	`# Also the global @error_list`
1068	`#`	1069	`#`
1069	`sub ClearCmd`	1070	`sub ClearCmd`
1070	`{`	1071	`{`
1071	`my( $cmd ) = @_;`	1072	`@error_list = ();`
1072	`Verbose2 "cleartool $cmd";`	-
1073		1073
1074	`@error_list = ();`	1074	`my $cmd = ClearToolCmd(@_);`
1075	`open(CMD, "cleartool $cmd 2>&1 \|") \|\| Error "can't run command: $!";`	1075	`open(CMD, "$cmd 2>&1 \|") \|\| Error "can't run command: $!";`
1076	`while (<CMD>)`	1076	`while (<CMD>)`
1077	`{`	1077	`{`
1078	`chomp;`	1078	`chomp;`
1079	`Verbose ($_);`	1079	`Verbose ($_);`
1080	`push @error_list, $_ if ( m~Error:~ );`	1080	`push @error_list, $_ if ( m~Error:~ );`
1081	`}`	1081	`}`
1082	`close(CMD);`	1082	`close(CMD);`
1083		1083
1084	`Verbose2 "Exit Status: $?";`	1084	`Verbose2 "Exit Status: $?";`
1085	`return $? / 256;`	1085	`return $? / 256;`
1086	`}`	1086	`}`
1087		1087
1088	`#-------------------------------------------------------------------------------`	1088	`#-------------------------------------------------------------------------------`
-		1089	`# Function : ClearToolCmd`
-		1090	`#`
-		1091	`# Description : Create a nice escaped cleartool command`
-		1092	`#`
-		1093	`# Inputs : An array of cleartool command line arguments`
-		1094	`#`
-		1095	`# Returns : A string that has been quoted`
-		1096	`#`
-		1097	`sub ClearToolCmd`
-		1098	`{`
-		1099	`my $cmd = 'cleartool ' . QuoteCommand( @_);`
-		1100	`Verbose2 $cmd;`
-		1101	`return $cmd;`
-		1102	`}`
-		1103
-		1104	`#-------------------------------------------------------------------------------`
1089	`# Function : unlock_on_error`	1105	`# Function : unlock_on_error`
1090	`#`	1106	`#`
1091	`# Description : Error cleanup function.`	1107	`# Description : Error cleanup function.`
1092	`# Called by the error processing`	1108	`# Called by the error processing`
1093	`# Called to unlock all labels that have been locked by this`	1109	`# Called to unlock all labels that have been locked by this`
Line 1102...	Line 1118...
1102	`my @still_locked;`	1118	`my @still_locked;`
1103	`Message( "Releasing Locked labels" );`	1119	`Message( "Releasing Locked labels" );`
1104	`foreach my $spec ( @label_locked )`	1120	`foreach my $spec ( @label_locked )`
1105	`{`	1121	`{`
1106	`Verbose ("Unlocking:$spec");`	1122	`Verbose ("Unlocking:$spec");`
1107	`ClearCmd ("unlock lbtype:$spec$root_vob_spec" );`	1123	`ClearCmd ('unlock', "lbtype:$spec$root_vob_spec" );`
1108	`push @still_locked, $spec if ( @error_list );`	1124	`push @still_locked, $spec if ( @error_list );`
1109	`}`	1125	`}`
1110	`Error ("Not all labels unlocked: @still_locked") if ( @still_locked );`	1126	`Error ("Not all labels unlocked: @still_locked") if ( @still_locked );`
1111	`}`	1127	`}`
1112		1128
Line 1155...	Line 1171...
1155	`}`	1171	`}`
1156		1172
1157	`#`	1173	`#`
1158	`# Create the view and insert the config spec`	1174	`# Create the view and insert the config spec`
1159	`#`	1175	`#`
1160	`ClearCmd ( "rmview -tag $VIEWTAG" );`	1176	`ClearCmd ( 'rmview', '-tag', $VIEWTAG );`
1161	`ClearCmd ( "mkview -tag $VIEWTAG -stgloc -auto" );`	1177	`ClearCmd ( 'mkview', '-tag', $VIEWTAG, '-stgloc', '-auto' );`
1162	`ClearCmd ( "setcs -tag $VIEWTAG $config" );`	1178	`ClearCmd ( 'setcs', '-tag', $VIEWTAG, $config );`
1163		1179
1164	`#`	1180	`#`
1165	`# Ensure that the base VOB has been 'mounted'`	1181	`# Ensure that the base VOB has been 'mounted'`
1166	`# Dynamic views require vobs to be mounted`	1182	`# Dynamic views require vobs to be mounted`
1167	`#`	1183	`#`
1168	`($vob_name = $ROOT_VOB) =~ s~/~$VOB_SEP~g;`	1184	`($vob_name = $ROOT_VOB) =~ s~/~$VOB_SEP~g;`
1169	`$vob_mounted = ClearCmd ("mount $vob_name");`	1185	`$vob_mounted = ClearCmd ('mount', $vob_name);`
1170		1186
1171	`#`	1187	`#`
1172	`# Calculate where the dynmaic view will be`	1188	`# Calculate where the dynmaic view will be`
1173	`# This differ between UNIX/WINDOWS`	1189	`# This differ between UNIX/WINDOWS`
1174	`#`	1190	`#`
Line 1189...	Line 1205...
1189	`Message ("View files in: $VIEWDIR, Files: $copy_count" );`	1205	`Message ("View files in: $VIEWDIR, Files: $copy_count" );`
1190		1206
1191	`#`	1207	`#`
1192	`# Remove the view`	1208	`# Remove the view`
1193	`#`	1209	`#`
1194	`ClearCmd ( "rmview -tag $VIEWTAG" );`	1210	`ClearCmd ( 'rmview', '-tag', $VIEWTAG );`
1195		1211
1196	`#`	1212	`#`
1197	`# Unmount the vob - if mounted`	1213	`# Unmount the vob - if mounted`
1198	`#`	1214	`#`
1199	`ClearCmd ("umount $vob_name") unless $vob_mounted;`	1215	`ClearCmd ('umount', $vob_name) unless $vob_mounted;`
1200		1216
1201	`Error ("Copy did not complete without error")`	1217	`Error ("Copy did not complete without error")`
1202	`if ( $rv );`	1218	`if ( $rv );`
1203		1219
1204	`}`	1220	`}`

Subversion Repositories DevTools

(root)/core_devl/trunk/TOOLS/jats_cbuilder.pl @ 243 – Rev 241 → 243