WebSVN – DevTools – Diff – /core_devl/trunk/TOOLS/LIB/JatsSvn.pm



    {
        #
        #   We have a checkout limitation
        #   Delete the workspace and then report the error
        #
        #   Note: For some reason a simple rmtree doesn't work
        #         Nor does glob show all the directories
        #
        Verbose2 ("Remove WorkSpace: $path");
        rmtree( $path, IsVerbose(3) );
        rmtree( $path, IsVerbose(3) );
        Error ("Checking out Workspace", @{$self->{ERROR_LIST}}, @co_list );
    }
    return;
 
    #

    if ( @dirs )
    {
        $self->SvnCmd ('mkdir', @dirs
                       , '-m', $self->Path() . ': Created by SvnCreatePackage'
                       , '--parents'
                       , { 'credentials' => 1
                           ,'error' => "SvnCreatePackage"
                           ,'process' => \&ProcessRevNo
                         } );
    }
 
    #
    #   Import data into the package if required
    #   Import data. Possible cases:

#                       path     - Path to local workspace
#                       target   - Location within the repository to copy to
#                       comment  - Commit comment
#                       modified - Array of files that are allowed to
#                                  be modified in the workspace.
#                       noswitch        - True: Don't switch to the new URL
#                       replace         - True: Delete existing tag if present
#                       allowLocalMods  - True: Allow complex tagging
#
# Returns         : Revision of the copy
#
sub SvnCopyWs
{
    my $self = shift;
    my %opt = @_;
    my $rv;
    Debug ("SvnCopyWs");
    Error ("Odd number of args to SvnCopyWs") unless ((@_ % 2) == 0);
    Error ("SvnCopyWs: No Workspace" ) unless ( $self->{WS} );
 
    #

    #
    #   Examine the workspace and ensure that there are no modified
    #   files - unless they are expected
    #
    $self->SvnWsModified ( 'cmd' => 'SvnCopyWs', %opt );
 
    #
    #   Validate the repository
    #   Ensure that the target does not exist
    #   The target may be deleted if it exists and allowed by the user
    #

    #   Copy source to destination
    #   It would appear that even though the source is a WorkSpace, the copy
    #   does not transfer data from the WorkSpace. It appears as though its all
    #   done on the server. This is good - and fast.
    #
    #   Moreover, files that are modified in the local workspace will
    #   be copied and checked into the target, but this is not nice.
    #
    $self->{PRINTDATA} = 1;
    $rv = $self->SvnCmd ( 'cp'  , $path
                        , $target
                        , '--parents'
                        , '-m', SvnComment( $opt{'comment'}, 'Created by SvnCopyWs' ),
                        , { 'process' => \&ProcessRevNo,
                            'credentials' => 1, }
                        );
    $self->{PRINTDATA} = 0;
    if ($rv)
    {
        #
        #   Error in copy
        #   Attempt to delete the target. Don't worry if we can't do that
        #

#                   A hash of named arguments
#                       path        - Path to local workspace
#                       modified    - Files that are allowed to be modified
#                                     Relative to the 'path'
#                                     May be a single file or an array of files
#                       allowLocalMods - Only warn about local mods
#                       cmd         - Command name for error reporting
#
# Returns         :
#
sub SvnWsModified

            #
            my $f1 =  substr ($entry, 0,1 );
            next if ( $f1 =~ m{[?I!~]} );
            push @unexpected, $entry;
        }
 
        if ( @unexpected )
        {
            if ( $opt{allowLocalMods} ) {
                Message ("Workspace contains locally modified files:", @unexpected);
            } else {
                Error ("Workspace contains unexpected modified files", @unexpected);
            }
        }
    }
}
 
#-------------------------------------------------------------------------------
# Function        : SvnListPackages

#                   Type
#                   WsType
#                   Path
#                   Version
#                   RmRef
#                   RmPath
#
# Description     : Accessor functions
#
# Inputs          : $self       - Instance data
#                                 self (is $_[0])

sub Type        { return $_[0]->{TAGTYPE} || '' ; }
sub WsType      { return $_[0]->{WSTYPE}  || '' ; }
sub Path        { return $_[0]->{PATH} ; }
sub Version     { return $_[0]->{VERSION} ; }
sub RmRef       { return $_[0]->{RMREF} ; }
sub RmPath      { my $path = $_[0]->{RMREF}; $path =~ s~@.*?$~~ ;return  $path; }
 
#-------------------------------------------------------------------------------
# Function        : Print
#
# Description     : Debug display the URL

Rev 383	Rev 385
Line 115...	Line 115...
115	`{`	115	`{`
116	`#`	116	`#`
117	`# We have a checkout limitation`	117	`# We have a checkout limitation`
118	`# Delete the workspace and then report the error`	118	`# Delete the workspace and then report the error`
119	`#`	119	`#`
-		120	`# Note: For some reason a simple rmtree doesn't work`
-		121	`# Nor does glob show all the directories`
-		122	`#`
120	`Verbose2 ("Remove WorkSpace: $path");`	123	`Verbose2 ("Remove WorkSpace: $path");`
121	`rmtree( $path, IsVerbose(3) );`	124	`rmtree( $path, IsVerbose(3) );`
-		125	`rmtree( $path, IsVerbose(3) );`
122	`Error ("Checking out Workspace", @{$self->{ERROR_LIST}}, @co_list );`	126	`Error ("Checking out Workspace", @{$self->{ERROR_LIST}}, @co_list );`
123	`}`	127	`}`
124	`return;`	128	`return;`
125		129
126	`#`	130	`#`
Line 411...	Line 415...
411	`if ( @dirs )`	415	`if ( @dirs )`
412	`{`	416	`{`
413	`$self->SvnCmd ('mkdir', @dirs`	417	`$self->SvnCmd ('mkdir', @dirs`
414	`, '-m', $self->Path() . ': Created by SvnCreatePackage'`	418	`, '-m', $self->Path() . ': Created by SvnCreatePackage'`
415	`, '--parents'`	419	`, '--parents'`
416	`, { 'credentials' => 1,`	420	`, { 'credentials' => 1`
417	`'error' => "SvnCreatePackage" } );`	421	`,'error' => "SvnCreatePackage"`
-		422	`,'process' => \&ProcessRevNo`
-		423	`} );`
418	`}`	424	`}`
419		425
420	`#`	426	`#`
421	`# Import data into the package if required`	427	`# Import data into the package if required`
422	`# Import data. Possible cases:`	428	`# Import data. Possible cases:`
Line 549...	Line 555...
549	`# path - Path to local workspace`	555	`# path - Path to local workspace`
550	`# target - Location within the repository to copy to`	556	`# target - Location within the repository to copy to`
551	`# comment - Commit comment`	557	`# comment - Commit comment`
552	`# modified - Array of files that are allowed to`	558	`# modified - Array of files that are allowed to`
553	`# be modified in the workspace.`	559	`# be modified in the workspace.`
554	`# noswitch - True: Don't switch to the new URL`	560	`# noswitch - True: Don't switch to the new URL`
555	`# replace - True: Delete existing tag if present`	561	`# replace - True: Delete existing tag if present`
-		562	`# allowLocalMods - True: Allow complex tagging`
556	`#`	563	`#`
557	`# Returns : Revision of the copy`	564	`# Returns : Revision of the copy`
558	`#`	565	`#`
559	`sub SvnCopyWs`	566	`sub SvnCopyWs`
560	`{`	567	`{`
561	`my $self = shift;`	568	`my $self = shift;`
562	`my %opt = @_;`	569	`my %opt = @_;`
-		570	`my $rv;`
563	`Debug ("SvnCopyWs");`	571	`Debug ("SvnCopyWs");`
564	`Error ("Odd number of args to SvnCopyWs") unless ((@_ % 2) == 0);`	572	`Error ("Odd number of args to SvnCopyWs") unless ((@_ % 2) == 0);`
565	`Error ("SvnCopyWs: No Workspace" ) unless ( $self->{WS} );`	573	`Error ("SvnCopyWs: No Workspace" ) unless ( $self->{WS} );`
566		574
567	`#`	575	`#`
Line 584...	Line 592...
584	`#`	592	`#`
585	`# Examine the workspace and ensure that there are no modified`	593	`# Examine the workspace and ensure that there are no modified`
586	`# files - unless they are expected`	594	`# files - unless they are expected`
587	`#`	595	`#`
588	`$self->SvnWsModified ( 'cmd' => 'SvnCopyWs', %opt );`	596	`$self->SvnWsModified ( 'cmd' => 'SvnCopyWs', %opt );`
589		597
590	`#`	598	`#`
591	`# Validate the repository`	599	`# Validate the repository`
592	`# Ensure that the target does not exist`	600	`# Ensure that the target does not exist`
593	`# The target may be deleted if it exists and allowed by the user`	601	`# The target may be deleted if it exists and allowed by the user`
594	`#`	602	`#`
Line 602...	Line 610...
602	`# Copy source to destination`	610	`# Copy source to destination`
603	`# It would appear that even though the source is a WorkSpace, the copy`	611	`# It would appear that even though the source is a WorkSpace, the copy`
604	`# does not transfer data from the WorkSpace. It appears as though its all`	612	`# does not transfer data from the WorkSpace. It appears as though its all`
605	`# done on the server. This is good - and fast.`	613	`# done on the server. This is good - and fast.`
606	`#`	614	`#`
607	`# More over files that are modified in the local workspace will`	615	`# Moreover, files that are modified in the local workspace will`
608	`# be copied and checked into the target.`	616	`# be copied and checked into the target, but this is not nice.`
609	`#`	617	`#`
-		618	`$self->{PRINTDATA} = 1;`
610	`if ( $self->SvnCmd ( 'cp' , $path`	619	`$rv = $self->SvnCmd ( 'cp' , $path`
611	`, $target`	620	`, $target`
612	`, '--parents'`	621	`, '--parents'`
613	`, '-m', SvnComment( $opt{'comment'}, 'Created by SvnCopyWs' ),`	622	`, '-m', SvnComment( $opt{'comment'}, 'Created by SvnCopyWs' ),`
614	`, { 'process' => \&ProcessRevNo,`	623	`, { 'process' => \&ProcessRevNo,`
615	`'credentials' => 1, }`	624	`'credentials' => 1, }`
616	`) )`	625	`);`
-		626	`$self->{PRINTDATA} = 0;`
-		627	`if ($rv)`
617	`{`	628	`{`
618	`#`	629	`#`
619	`# Error in copy`	630	`# Error in copy`
620	`# Attempt to delete the target. Don't worry if we can't do that`	631	`# Attempt to delete the target. Don't worry if we can't do that`
621	`#`	632	`#`
Line 664...	Line 675...
664	`# A hash of named arguments`	675	`# A hash of named arguments`
665	`# path - Path to local workspace`	676	`# path - Path to local workspace`
666	`# modified - Files that are allowed to be modified`	677	`# modified - Files that are allowed to be modified`
667	`# Relative to the 'path'`	678	`# Relative to the 'path'`
668	`# May be a single file or an array of files`	679	`# May be a single file or an array of files`
-		680	`# allowLocalMods - Only warn about local mods`
669	`# cmd - Command name for error reporting`	681	`# cmd - Command name for error reporting`
670	`#`	682	`#`
671	`# Returns :`	683	`# Returns :`
672	`#`	684	`#`
673	`sub SvnWsModified`	685	`sub SvnWsModified`
Line 746...	Line 758...
746	`#`	758	`#`
747	`my $f1 = substr ($entry, 0,1 );`	759	`my $f1 = substr ($entry, 0,1 );`
748	`next if ( $f1 =~ m{[?I!~]} );`	760	`next if ( $f1 =~ m{[?I!~]} );`
749	`push @unexpected, $entry;`	761	`push @unexpected, $entry;`
750	`}`	762	`}`
-		763
-		764	`if ( @unexpected )`
-		765	`{`
-		766	`if ( $opt{allowLocalMods} ) {`
751	`Error ("Workspace contains unexpected modified files", @unexpected)`	767	`Message ("Workspace contains locally modified files:", @unexpected);`
752	`if ( @unexpected );`	768	`} else {`
-		769	`Error ("Workspace contains unexpected modified files", @unexpected);`
-		770	`}`
-		771	`}`
753	`}`	772	`}`
754	`}`	773	`}`
755		774
756	`#-------------------------------------------------------------------------------`	775	`#-------------------------------------------------------------------------------`
757	`# Function : SvnListPackages`	776	`# Function : SvnListPackages`
Line 1493...	Line 1512...
1493	`# Type`	1512	`# Type`
1494	`# WsType`	1513	`# WsType`
1495	`# Path`	1514	`# Path`
1496	`# Version`	1515	`# Version`
1497	`# RmRef`	1516	`# RmRef`
-		1517	`# RmPath`
1498	`#`	1518	`#`
1499	`# Description : Accessor functions`	1519	`# Description : Accessor functions`
1500	`#`	1520	`#`
1501	`# Inputs : $self - Instance data`	1521	`# Inputs : $self - Instance data`
1502	`# self (is $_[0])`	1522	`# self (is $_[0])`
Line 1510...	Line 1530...
1510	`sub Type { return $_[0]->{TAGTYPE} \|\| '' ; }`	1530	`sub Type { return $_[0]->{TAGTYPE} \|\| '' ; }`
1511	`sub WsType { return $_[0]->{WSTYPE} \|\| '' ; }`	1531	`sub WsType { return $_[0]->{WSTYPE} \|\| '' ; }`
1512	`sub Path { return $_[0]->{PATH} ; }`	1532	`sub Path { return $_[0]->{PATH} ; }`
1513	`sub Version { return $_[0]->{VERSION} ; }`	1533	`sub Version { return $_[0]->{VERSION} ; }`
1514	`sub RmRef { return $_[0]->{RMREF} ; }`	1534	`sub RmRef { return $_[0]->{RMREF} ; }`
-		1535	`sub RmPath { my $path = $_[0]->{RMREF}; $path =~ s~@.*?$~~ ;return $path; }`
1515		1536
1516	`#-------------------------------------------------------------------------------`	1537	`#-------------------------------------------------------------------------------`
1517	`# Function : Print`	1538	`# Function : Print`
1518	`#`	1539	`#`
1519	`# Description : Debug display the URL`	1540	`# Description : Debug display the URL`

Subversion Repositories DevTools

(root)/core_devl/trunk/TOOLS/LIB/JatsSvn.pm – Rev 383 → 385