WebSVN – DevTools – Diff – /core_devl/branches/dpurdie_devl/TOOLS/jats_svnrelease.pl



#   but it may not be the same if the user is changing the branch
#
if ( $tagLabel )
{
    my $btData;
    my $labelBranch = $svnSession->backTrackSvnLabel(
                            join ('@', $tagLabel, $tagPeg)
                          , 'data' => \$btData
                          , 'onlysimple' => 0,
                          , 'printdata' => 0 );
    $svnSession->{SavedBackTrack} = $btData;
    unless ( $btData->{isaBranch} )
    {
        Warning("Cannot trace package label back to a development branch");
    }
    else
    {
        Error ("INTERNAL: Cannot parse result of backTrackSvnLabel: $labelBranch")
            unless ($btData->{devBranch} =~ m~^(.*)@(\d+)$~);
        $tagLabelBranch = $1;
        $tagLabelBranchPeg = $2;
 
        #
        #   Verify that the Development Branch matches that provided by the user
        #
        if ( $devBranch && ($devBranch ne $tagLabelBranch) )
        {
            # If the user is creating a branch, then allow this mismatch
            #

 
        #   Ensure that the TAG has not been modified since it was taken
        #   The extraction algorithm assumes that the tag directory is
        #   immutable.
        #
        #   The build daemon will actually modify the build file during
        #   a ripple - this is catered for.
        #
        #   If other files have been modifed then it should be an error
        #
        if ( $btData->{changeSets} > 1 )
        {
            Error ("Tag has been modified since created") if ( $GBE_ABT );
            Warning ("Tag has been modified since created");
            $noReleaseWs = 1;
        }
    }
}
#debugDumpRefInfo('BackTrack Label');
 

    Message ("Not all labels are pegged") if ( @label_not_pegged  );
    Message ("All labels are pegged") unless ( @label_not_pegged  );
    Message ("Badly formed label name" ) if ( $bad_label_name );
    Message ("Development Mode: $opt_devModeStr") if ( $opt_devModeStr );
    Message ("Development Sandbox") if ( $GBE_SANDBOX );
    Message ("Cannot release from this workspace") if ($noReleaseWs);
 
    exit 0;
}
 
Error ("No build files found")  if ( $#build_list < 0 );

# Returns         : Error code
#
sub importTagChanges
{
    return unless ( $tagLabel );
    my $data = $svnSession->{SavedBackTrack};
    Error ("Internal: importTagChanges expects backtracking to have been performed")
        unless (defined $data);
 
#    DebugDumpData("importTagChanges", $svnSession );
#    DebugDumpData("Data", $data );
 
    #
    #   Process the data from the backtrack log and determine the files
    #   that we need to transfer.
    #       Should only be one - but if the users have been bad
    #       then there may be more.
    #
    foreach my $srcFile ( reverse @{$data->{files}} )
    {
        Verbose("importTagChanges: $srcFile");
        my $sfile = $svnSession->FullPath() . '/' . $srcFile;
        if ( $opt_branch )
        {
            $srcFile =~ m~tags/.*?(/.*)@\d+~;
            my $tfile = $1;
            $svnSession->SvnSwitch ($sfile, $workSpace . $tfile);
        }
        else
        {
 
 
 
 
 
 
 
 
 
 
 
 
 
            $svnSession->SvnCo ($sfile, $workSpace, '--Export', '--Force', '--PreText=Replacing ' );
 
        }
    }
}
 
#-------------------------------------------------------------------------------

    Verbose0 ('devBranch         :', $devBranch);
    Verbose0 ('devBranchPeg      :', $devBranchPeg);
    Verbose0 ('devBranchHead     :', $devBranchHead);
    Verbose0 ('tagLabel          :', $tagLabel);
    Verbose0 ('tagPeg            :', $tagPeg);
??    Verbose0 ('tagLabelDistance  :', $tagLabelDistance);
    Verbose0 ('tagLabelBranch    :', $tagLabelBranch);
    Verbose0 ('tagLabelBranchPeg :', $tagLabelBranchPeg);
}
 
#-------------------------------------------------------------------------------

Rev 1348	Rev 1349
Line 486...	Line 486...
486	`# but it may not be the same if the user is changing the branch`	486	`# but it may not be the same if the user is changing the branch`
487	`#`	487	`#`
488	`if ( $tagLabel )`	488	`if ( $tagLabel )`
489	`{`	489	`{`
490	`my $btData;`	490	`my $btData;`
491	`my $labelBranch = $svnSession->backTrackSvnLabel( join ('@', $tagLabel, $tagPeg), \$btData );`	491	`my $labelBranch = $svnSession->backTrackSvnLabel(`
-		492	`join ('@', $tagLabel, $tagPeg)`
-		493	`, 'data' => \$btData`
-		494	`, 'onlysimple' => 0,`
-		495	`, 'printdata' => 0 );`
492	`$tagLabelDistance = $btData->{entryCount};`	496	`$svnSession->{SavedBackTrack} = $btData;`
493	`if ( $tagLabelDistance <= 0 )`	497	`unless ( $btData->{isaBranch} )`
494	`{`	498	`{`
495	`Warning("Cannot trace package label back to a development branch");`	499	`Warning("Cannot trace package label back to a development branch");`
496	`}`	500	`}`
497	`else`	501	`else`
498	`{`	502	`{`
499	`Error ("INTERNAL: Cannot parse result of backTrackSvnLabel: $labelBranch")`	503	`Error ("INTERNAL: Cannot parse result of backTrackSvnLabel: $labelBranch")`
500	`unless ($labelBranch =~ m~^(.*)@(\d+)$~);`	504	`unless ($btData->{devBranch} =~ m~^(.*)@(\d+)$~);`
501	`$tagLabelBranch = $1;`	505	`$tagLabelBranch = $1;`
502	`$tagLabelBranchPeg = $2;`	506	`$tagLabelBranchPeg = $2;`
503		507
504	`#`	508	`#`
505	`# Verify that the Development Barnch matches that provided by the user`	509	`# Verify that the Development Branch matches that provided by the user`
506	`#`	510	`#`
507	`if ( $devBranch && ($devBranch ne $tagLabelBranch) )`	511	`if ( $devBranch && ($devBranch ne $tagLabelBranch) )`
508	`{`	512	`{`
509	`# If the user is creating a branch, then allow this mismatch`	513	`# If the user is creating a branch, then allow this mismatch`
510	`#`	514	`#`
Line 519...	Line 523...
519		523
520	`# Ensure that the TAG has not been modified since it was taken`	524	`# Ensure that the TAG has not been modified since it was taken`
521	`# The extraction algorithm assumes that the tag directory is`	525	`# The extraction algorithm assumes that the tag directory is`
522	`# immutable.`	526	`# immutable.`
523	`#`	527	`#`
-		528	`# The build daemon will actually modify the build file during`
-		529	`# a ripple - this is catered for.`
-		530	`#`
-		531	`# If other files have been modifed then it should be an error`
-		532	`#`
524	`if ( $btData->{entryCount} > 1 )`	533	`if ( $btData->{changeSets} > 1 )`
525	`{`	534	`{`
526	`Error ("Tag has been modified since created") if ( $GBE_ABT );`	535	`Error ("Tag has been modified since created") if ( $GBE_ABT );`
527	`Warning ("Tag has been modified since created");`	536	`Warning ("Tag has been modified since created");`
-		537	`$noReleaseWs = 1;`
528	`}`	538	`}`
529	`}`	539	`}`
530	`}`	540	`}`
531	`#debugDumpRefInfo('BackTrack Label');`	541	`#debugDumpRefInfo('BackTrack Label');`
532		542
Line 720...	Line 730...
720	`Message ("Not all labels are pegged") if ( @label_not_pegged );`	730	`Message ("Not all labels are pegged") if ( @label_not_pegged );`
721	`Message ("All labels are pegged") unless ( @label_not_pegged );`	731	`Message ("All labels are pegged") unless ( @label_not_pegged );`
722	`Message ("Badly formed label name" ) if ( $bad_label_name );`	732	`Message ("Badly formed label name" ) if ( $bad_label_name );`
723	`Message ("Development Mode: $opt_devModeStr") if ( $opt_devModeStr );`	733	`Message ("Development Mode: $opt_devModeStr") if ( $opt_devModeStr );`
724	`Message ("Development Sandbox") if ( $GBE_SANDBOX );`	734	`Message ("Development Sandbox") if ( $GBE_SANDBOX );`
-		735	`Message ("Cannot release from this workspace") if ($noReleaseWs);`
725		736
726	`exit 0;`	737	`exit 0;`
727	`}`	738	`}`
728		739
729	`Error ("No build files found") if ( $#build_list < 0 );`	740	`Error ("No build files found") if ( $#build_list < 0 );`
Line 1163...	Line 1174...
1163	`# Returns : Error code`	1174	`# Returns : Error code`
1164	`#`	1175	`#`
1165	`sub importTagChanges`	1176	`sub importTagChanges`
1166	`{`	1177	`{`
1167	`return unless ( $tagLabel );`	1178	`return unless ( $tagLabel );`
1168	`my $data;`	1179	`my $data = $svnSession->{SavedBackTrack};`
1169	`my $labelBranch = $svnSession->backTrackSvnLabel( join ('@', $tagLabel, $tagPeg ), \$data);`	1180	`Error ("Internal: importTagChanges expects backtracking to have been performed")`
-		1181	`unless (defined $data);`
-		1182
1170	`# DebugDumpData("importTagChanges", $svnSession );`	1183	`# DebugDumpData("importTagChanges", $svnSession );`
1171	`# DebugDumpData("Data", $data );`	1184	`# DebugDumpData("Data", $data );`
1172		1185
1173	`#`	1186	`#`
1174	`# Process the data from the backtrack log and determine the files`	1187	`# Process the data from the backtrack log and determine the files`
1175	`# that we need to transfer.`	1188	`# that we need to transfer.`
-		1189	`# Should only be one - but if the users have been bad`
1176	`# Only expect files to be changed`	1190	`# then there may be more.`
1177	`#`	1191	`#`
1178	`foreach my $entry ( @{$data->{data}} )`	1192	`foreach my $srcFile ( reverse @{$data->{files}} )`
1179	`{`	1193	`{`
-		1194	`Verbose("importTagChanges: $srcFile");`
-		1195	`my $sfile = $svnSession->FullPath() . '/' . $srcFile;`
1180	`if ( $entry->{kind} eq 'file' )`	1196	`if ( $opt_branch )`
-		1197	`{`
-		1198	`$srcFile =~ m~tags/.?(/.)@\d+~;`
-		1199	`my $tfile = $1;`
-		1200	`$svnSession->SvnSwitch ($sfile, $workSpace . $tfile);`
-		1201	`}`
-		1202	`else`
1181	`{`	1203	`{`
1182	`$entry->{target} =~ m~(/tags/.*)$~;`	-
1183	`my $srcFile = $1 .'@' . $tagPeg;`	-
1184	`Verbose("importTagChanges: $srcFile");`	-
1185	`if ( $opt_branch )`	-
1186	`{`	-
1187	`$srcFile =~ m~/tags/.?(/.)@\d+~;`	-
1188	`my $tfile = $1;`	-
1189	`$svnSession->SvnSwitch ($svnSession->FullPath() . $srcFile,`	-
1190	`$workSpace . $tfile);`	-
1191	`}`	-
1192	`else`	-
1193	`{`	-
1194	`$svnSession->SvnCo ($svnSession->FullPath() . $srcFile,`	-
1195	`$workSpace, '--Export', '--Force', '--PreText=Replacing ' );`	1204	`$svnSession->SvnCo ($sfile, $workSpace, '--Export', '--Force', '--PreText=Replacing ' );`
1196	`}`	-
1197	`}`	1205	`}`
1198	`}`	1206	`}`
1199	`}`	1207	`}`
1200		1208
1201	`#-------------------------------------------------------------------------------`	1209	`#-------------------------------------------------------------------------------`
Line 1492...	Line 1500...
1492	`Verbose0 ('devBranch :', $devBranch);`	1500	`Verbose0 ('devBranch :', $devBranch);`
1493	`Verbose0 ('devBranchPeg :', $devBranchPeg);`	1501	`Verbose0 ('devBranchPeg :', $devBranchPeg);`
1494	`Verbose0 ('devBranchHead :', $devBranchHead);`	1502	`Verbose0 ('devBranchHead :', $devBranchHead);`
1495	`Verbose0 ('tagLabel :', $tagLabel);`	1503	`Verbose0 ('tagLabel :', $tagLabel);`
1496	`Verbose0 ('tagPeg :', $tagPeg);`	1504	`Verbose0 ('tagPeg :', $tagPeg);`
1497	`Verbose0 ('tagLabelDistance :', $tagLabelDistance);`	1505	`?? Verbose0 ('tagLabelDistance :', $tagLabelDistance);`
1498	`Verbose0 ('tagLabelBranch :', $tagLabelBranch);`	1506	`Verbose0 ('tagLabelBranch :', $tagLabelBranch);`
1499	`Verbose0 ('tagLabelBranchPeg :', $tagLabelBranchPeg);`	1507	`Verbose0 ('tagLabelBranchPeg :', $tagLabelBranchPeg);`
1500	`}`	1508	`}`
1501		1509
1502	`#-------------------------------------------------------------------------------`	1510	`#-------------------------------------------------------------------------------`

Subversion Repositories DevTools

(root)/core_devl/branches/dpurdie_devl/TOOLS/jats_svnrelease.pl – Rev 1348 → 1349