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



                    SvnComment
 
                    SvnUserCmd
 
                    SvnPath2Url
                    SvnPaths
                );
@EXPORT_OK =  qw(
                );
 
%EXPORT_TAGS = (All => [@EXPORT, @EXPORT_OK]);

    $self->SvnValidateTarget ( 'cmd'    => 'SvnCopyWs',
                        'target' => $target,
                        'delete' => $opt{replace},
                        'comment' => 'Deleted by SvnCopyWs'
                        );
 
    #
    #   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.

#                   Algorithm
#                       svn ls ..
#                       Am I in the parent directory
#                       Repeat
#
#                   Updates 'WS' and 'WSURL'
#
# Inputs          : $self               - Instance data
#                   $test               - True: Don't die on error
#
# Returns         : Root of workspace as an absolute address
#                   Will not return if there is an error

                if ( $#path <= 0 );
            pop @path;
        }
    }
 
    #
    #   Need to adjust the WSURL too
    #   Break into parts and pop them off as we go
    #   Add a dummy one to allow for the first iteration
    #
    my @wsurl = (split (/[\\\/]+/ , $self->{WSURL}), 'Dummy');
 
    Verbose2 ("Clean absolute path elements: @path");
    PATH_LOOP:
    while ( @path )
    {
        #
        #   This directory element. Append / to assist in compare
        #   Determine parent path
        #
        my $name = pop (@path) . '/';
        my $parent = join ('/', @path );
        pop @wsurl;
 
        #
        #   Examine the parent directory
        #   Get a list of all elements in the parent
        #   Need to ensure that this directory is one of them

        #   This parent is not a part of the same WorkSpace as 'dir'
        #   We have a winner.
        #
        chop $name;                         #   Chop the '/' previously added
        $self->{WS} = $parent . '/' . $name;
 
        #
        #   Reform the WSURL. Elements have been removed as we tested up the
        #   path
        #
        $self->{WSURL} = join '/', @wsurl;
 
        return $self->{WS};
    }
 
    #
    #   Shouldn't get this far

    #       URL: svn://auperaws996vm21/test/MixedView/trunk
    #       Repository Root: svn://auperaws996vm21/test
    #
    my $url;
    my $reporoot;
    my $repoVersion;
 
    foreach ( @{$self->{RESULT_LIST}} )
    {
        $url = $1 if ( m~^URL:\s+(.+)~ );
        $reporoot = $1 if ( m~^Repository Root:\s+(.+)~ );
        $repoVersion = $1 if ( m~^Revision:\s+(.+)~ );
        last if ( $url && $reporoot && $repoVersion);
    }
    Error ("JatsSvn Internal error. Can't parse info")
        unless ( $url && $reporoot );
 
    #

    #
    #   Insert known information
    #
    $self->{URL} = $reporoot . '/';
    $self->{PKGROOT} = $url;
    $self->{WSREVNO} = $repoVersion;
 
    #
    #   Create useful information
    #
    SplitPackageUrl($self);

    #   Populate it with information that is known
    #
    $self = NewSession() unless ( $self );
 
    #
    #   Examine the URL and convert a Repository Path into a URL
    #   as provided by configuration information within the environment
    #
    ($self->{URL}, $self->{PKGROOT} ) = SvnPath2Url ($uurl);
 
    #

            #       file://This/Isa/Bad/Guess
            #
            $url = $1;
            $pkgroot = $4;
        }
        elsif ($SVN_URLS{''} )
        {
            $url = $SVN_URLS{''};
            $pkgroot = $rpath;
        }
        else

    #
    return $url, $pkgroot if ( wantarray );
    return $url . $pkgroot;
}
 
#-------------------------------------------------------------------------------
# Function        : SvnPaths
#
# Description     : Extract SVN path conversion information
#
# Inputs          : Nothing
#
# Returns         : Two refs
#                   Hash of SVN URLS
#                   Array for search order
#
sub SvnPaths
{
    return \%SVN_URLS, \@SVN_URLS_LIST;
}
 
#-------------------------------------------------------------------------------
# Function        : SplitPackageUrl
#
# Description     : Slip the package URL into a few useful bits

# Inputs          : $self       - Instance data
#                                 self (is $_[0])
#
# Returns         : Data Item
#
sub Full        { return $_[0]->{URL} . $_[0]->{PKGROOT} ; }
sub FullWs      { return $_[0]->{URL} . $_[0]->{WSURL} ; }
sub FullWsRev   { return $_[0]->{URL} . $_[0]->{WSURL} . '@' . $_[0]->{WSREVNO} ; }
sub Peg         { return $_[0]->{PEG} ; }
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} ; }
 
#-------------------------------------------------------------------------------
# Function        : Print
#
# Description     : Debug display the URL

Rev 361	Rev 369
Line 54...	Line 54...
54	`SvnComment`	54	`SvnComment`
55		55
56	`SvnUserCmd`	56	`SvnUserCmd`
57		57
58	`SvnPath2Url`	58	`SvnPath2Url`
-		59	`SvnPaths`
59	`);`	60	`);`
60	`@EXPORT_OK = qw(`	61	`@EXPORT_OK = qw(`
61	`);`	62	`);`
62		63
63	`%EXPORT_TAGS = (All => [@EXPORT, @EXPORT_OK]);`	64	`%EXPORT_TAGS = (All => [@EXPORT, @EXPORT_OK]);`
Line 577...	Line 578...
577	`$self->SvnValidateTarget ( 'cmd' => 'SvnCopyWs',`	578	`$self->SvnValidateTarget ( 'cmd' => 'SvnCopyWs',`
578	`'target' => $target,`	579	`'target' => $target,`
579	`'delete' => $opt{replace},`	580	`'delete' => $opt{replace},`
580	`'comment' => 'Deleted by SvnCopyWs'`	581	`'comment' => 'Deleted by SvnCopyWs'`
581	`);`	582	`);`
-		583
582	`#`	584	`#`
583	`# Copy source to destination`	585	`# Copy source to destination`
584	`# It would appear that even though the source is a WorkSpace, the copy`	586	`# It would appear that even though the source is a WorkSpace, the copy`
585	`# does not transfer data from the WorkSpace. It appears as though its all`	587	`# does not transfer data from the WorkSpace. It appears as though its all`
586	`# done on the server. This is good - and fast.`	588	`# done on the server. This is good - and fast.`
Line 816...	Line 818...
816	`# Algorithm`	818	`# Algorithm`
817	`# svn ls ..`	819	`# svn ls ..`
818	`# Am I in the parent directory`	820	`# Am I in the parent directory`
819	`# Repeat`	821	`# Repeat`
820	`#`	822	`#`
-		823	`# Updates 'WS' and 'WSURL'`
-		824	`#`
821	`# Inputs : $self - Instance data`	825	`# Inputs : $self - Instance data`
822	`# $test - True: Don't die on error`	826	`# $test - True: Don't die on error`
823	`#`	827	`#`
824	`# Returns : Root of workspace as an absolute address`	828	`# Returns : Root of workspace as an absolute address`
825	`# Will not return if there is an error`	829	`# Will not return if there is an error`
Line 879...	Line 883...
879	`if ( $#path <= 0 );`	883	`if ( $#path <= 0 );`
880	`pop @path;`	884	`pop @path;`
881	`}`	885	`}`
882	`}`	886	`}`
883		887
-		888	`#`
-		889	`# Need to adjust the WSURL too`
-		890	`# Break into parts and pop them off as we go`
-		891	`# Add a dummy one to allow for the first iteration`
-		892	`#`
-		893	`my @wsurl = (split (/[\\\/]+/ , $self->{WSURL}), 'Dummy');`
-		894
884	`Verbose2 ("Clean absolute path elements: @path");`	895	`Verbose2 ("Clean absolute path elements: @path");`
885	`PATH_LOOP:`	896	`PATH_LOOP:`
886	`while ( @path )`	897	`while ( @path )`
887	`{`	898	`{`
888	`#`	899	`#`
889	`# This directory element. Append / to assist in compare`	900	`# This directory element. Append / to assist in compare`
890	`# Determine parent path`	901	`# Determine parent path`
891	`#`	902	`#`
892	`my $name = pop (@path) . '/';`	903	`my $name = pop (@path) . '/';`
893	`my $parent = join ('/', @path );`	904	`my $parent = join ('/', @path );`
-		905	`pop @wsurl;`
894		906
895	`#`	907	`#`
896	`# Examine the parent directory`	908	`# Examine the parent directory`
897	`# Get a list of all elements in the parent`	909	`# Get a list of all elements in the parent`
898	`# Need to ensure that this directory is one of them`	910	`# Need to ensure that this directory is one of them`
Line 913...	Line 925...
913	`# This parent is not a part of the same WorkSpace as 'dir'`	925	`# This parent is not a part of the same WorkSpace as 'dir'`
914	`# We have a winner.`	926	`# We have a winner.`
915	`#`	927	`#`
916	`chop $name; # Chop the '/' previously added`	928	`chop $name; # Chop the '/' previously added`
917	`$self->{WS} = $parent . '/' . $name;`	929	`$self->{WS} = $parent . '/' . $name;`
-		930
-		931	`#`
-		932	`# Reform the WSURL. Elements have been removed as we tested up the`
-		933	`# path`
-		934	`#`
-		935	`$self->{WSURL} = join '/', @wsurl;`
-		936
918	`return $self->{WS};`	937	`return $self->{WS};`
919	`}`	938	`}`
920		939
921	`#`	940	`#`
922	`# Shouldn't get this far`	941	`# Shouldn't get this far`
Line 1161...	Line 1180...
1161	`# URL: svn://auperaws996vm21/test/MixedView/trunk`	1180	`# URL: svn://auperaws996vm21/test/MixedView/trunk`
1162	`# Repository Root: svn://auperaws996vm21/test`	1181	`# Repository Root: svn://auperaws996vm21/test`
1163	`#`	1182	`#`
1164	`my $url;`	1183	`my $url;`
1165	`my $reporoot;`	1184	`my $reporoot;`
-		1185	`my $repoVersion;`
1166		1186
1167	`foreach ( @{$self->{RESULT_LIST}} )`	1187	`foreach ( @{$self->{RESULT_LIST}} )`
1168	`{`	1188	`{`
1169	`$url = $1 if ( m~^URL:\s+(.+)~ );`	1189	`$url = $1 if ( m~^URL:\s+(.+)~ );`
1170	`$reporoot = $1 if ( m~^Repository Root:\s+(.+)~ );`	1190	`$reporoot = $1 if ( m~^Repository Root:\s+(.+)~ );`
-		1191	`$repoVersion = $1 if ( m~^Revision:\s+(.+)~ );`
1171	`last if ( $url && $reporoot );`	1192	`last if ( $url && $reporoot && $repoVersion);`
1172	`}`	1193	`}`
1173	`Error ("JatsSvn Internal error. Can't parse info")`	1194	`Error ("JatsSvn Internal error. Can't parse info")`
1174	`unless ( $url && $reporoot );`	1195	`unless ( $url && $reporoot );`
1175		1196
1176	`#`	1197	`#`
Line 1212...	Line 1233...
1212	`#`	1233	`#`
1213	`# Insert known information`	1234	`# Insert known information`
1214	`#`	1235	`#`
1215	`$self->{URL} = $reporoot . '/';`	1236	`$self->{URL} = $reporoot . '/';`
1216	`$self->{PKGROOT} = $url;`	1237	`$self->{PKGROOT} = $url;`
-		1238	`$self->{WSREVNO} = $repoVersion;`
1217		1239
1218	`#`	1240	`#`
1219	`# Create useful information`	1241	`# Create useful information`
1220	`#`	1242	`#`
1221	`SplitPackageUrl($self);`	1243	`SplitPackageUrl($self);`
Line 1244...	Line 1266...
1244	`# Populate it with information that is known`	1266	`# Populate it with information that is known`
1245	`#`	1267	`#`
1246	`$self = NewSession() unless ( $self );`	1268	`$self = NewSession() unless ( $self );`
1247		1269
1248	`#`	1270	`#`
1249	`# Examine the UURL and convert a Repository Path into a URL`	1271	`# Examine the URL and convert a Repository Path into a URL`
1250	`# as provided by configuration information within the environment`	1272	`# as provided by configuration information within the environment`
1251	`#`	1273	`#`
1252	`($self->{URL}, $self->{PKGROOT} ) = SvnPath2Url ($uurl);`	1274	`($self->{URL}, $self->{PKGROOT} ) = SvnPath2Url ($uurl);`
1253		1275
1254	`#`	1276	`#`
Line 1341...	Line 1363...
1341	`# file://This/Isa/Bad/Guess`	1363	`# file://This/Isa/Bad/Guess`
1342	`#`	1364	`#`
1343	`$url = $1;`	1365	`$url = $1;`
1344	`$pkgroot = $4;`	1366	`$pkgroot = $4;`
1345	`}`	1367	`}`
1346	`elsif ($SVN_URLS{''})`	1368	`elsif ($SVN_URLS{''} )`
1347	`{`	1369	`{`
1348	`$url = $SVN_URLS{''};`	1370	`$url = $SVN_URLS{''};`
1349	`$pkgroot = $rpath;`	1371	`$pkgroot = $rpath;`
1350	`}`	1372	`}`
1351	`else`	1373	`else`
Line 1363...	Line 1385...
1363	`#`	1385	`#`
1364	`return $url, $pkgroot if ( wantarray );`	1386	`return $url, $pkgroot if ( wantarray );`
1365	`return $url . $pkgroot;`	1387	`return $url . $pkgroot;`
1366	`}`	1388	`}`
1367		1389
-		1390	`#-------------------------------------------------------------------------------`
-		1391	`# Function : SvnPaths`
-		1392	`#`
-		1393	`# Description : Extract SVN path conversion information`
-		1394	`#`
-		1395	`# Inputs : Nothing`
-		1396	`#`
-		1397	`# Returns : Two refs`
-		1398	`# Hash of SVN URLS`
-		1399	`# Array for search order`
-		1400	`#`
-		1401	`sub SvnPaths`
-		1402	`{`
-		1403	`return \%SVN_URLS, \@SVN_URLS_LIST;`
-		1404	`}`
1368		1405
1369	`#-------------------------------------------------------------------------------`	1406	`#-------------------------------------------------------------------------------`
1370	`# Function : SplitPackageUrl`	1407	`# Function : SplitPackageUrl`
1371	`#`	1408	`#`
1372	`# Description : Slip the package URL into a few useful bits`	1409	`# Description : Slip the package URL into a few useful bits`
Line 1437...	Line 1474...
1437	`# Inputs : $self - Instance data`	1474	`# Inputs : $self - Instance data`
1438	`# self (is $_[0])`	1475	`# self (is $_[0])`
1439	`#`	1476	`#`
1440	`# Returns : Data Item`	1477	`# Returns : Data Item`
1441	`#`	1478	`#`
1442	`sub Full { return $_[0]->{URL} . $_[0]->{PKGROOT} ; }`	1479	`sub Full { return $_[0]->{URL} . $_[0]->{PKGROOT} ; }`
1443	`sub FullWs { return $_[0]->{URL} . $_[0]->{WSURL} ; }`	1480	`sub FullWs { return $_[0]->{URL} . $_[0]->{WSURL} ; }`
-		1481	`sub FullWsRev { return $_[0]->{URL} . $_[0]->{WSURL} . '@' . $_[0]->{WSREVNO} ; }`
1444	`sub Peg { return $_[0]->{PEG} ; }`	1482	`sub Peg { return $_[0]->{PEG} ; }`
1445	`sub Type { return $_[0]->{TAGTYPE} \|\| '' ; }`	1483	`sub Type { return $_[0]->{TAGTYPE} \|\| '' ; }`
1446	`sub WsType { return $_[0]->{WSTYPE} \|\| '' ; }`	1484	`sub WsType { return $_[0]->{WSTYPE} \|\| '' ; }`
1447	`sub Path { return $_[0]->{PATH} ; }`	1485	`sub Path { return $_[0]->{PATH} ; }`
1448	`sub Version { return $_[0]->{VERSION} ; }`	1486	`sub Version { return $_[0]->{VERSION} ; }`
1449	`sub RmRef { return $_[0]->{RMREF} ; }`	1487	`sub RmRef { return $_[0]->{RMREF} ; }`
1450		1488
1451	`#-------------------------------------------------------------------------------`	1489	`#-------------------------------------------------------------------------------`
1452	`# Function : Print`	1490	`# Function : Print`
1453	`#`	1491	`#`
1454	`# Description : Debug display the URL`	1492	`# Description : Debug display the URL`

Subversion Repositories DevTools

(root)/core_devl/trunk/TOOLS/LIB/JatsSvn.pm – Rev 361 → 369