WebSVN – DevTools – Diff – /core_devl/branches/dpurdie_devl/TOOLS/LIB/JatsSvn.pm



    Error ("Package name contains a Peg ($1)", "Path: $package")
        if ( $package =~ m~.*(@\d+)$~ );
 
    #
    #   Determine TTB target
    #   The TTB type for branckes and tags also conatins the branch or tag
    #
    $opt{'type'} = 'trunk' unless ( $opt{'type'} );
    if ( $opt{'type'} =~ m~^(tags|branches|trunk)(/|$)(.*)~ ) {
        Error ("SvnCreatePackage: TTB type ($1) must be followed by a path element")
            if ( (($1 eq 'tags') or ($1 eq 'branches' )) && ! $3  );
        Error ('SvnCreatePackage: TTB type of trunk must not be followed by a path element: ' . $opt{'type'})
            if ( ($1 eq 'trunk') && $3  );
    } else {
        Error ("SvnCreatePackage: Invalid TTB Type: " . $opt{'type'} );
    }
 
    #
    #   Before we import data we must ensure that the targets do not exist
    #   Determine the import target(s)
    #

        #
        #   Primary target
        #   trunk, branck or tag
        #
        $import_target = $package . '/' . $opt{'type'};
        $self->{DEVBRANCH} = $opt{'type'} ;
 
        $self->SvnValidateTarget( 'target'    => $import_target,
                                  'delete'    => $opt{'replace'},
                                  'available' => 1 );
 
        #
        #   Secondary target
        #   Are we tagging the import too
        #
        if ( $opt{'label'} )
        {
            $copy_target = $package . '/tags/' . $opt{'label'};
            $self->SvnValidateTarget( 'target'    => $copy_target,
                                      'delete'    => $opt{'replace'},
                                      'available' => 1 );

 
    #
    #   Probe to see if the package exists
    #
    my ( $ref_files, $ref_dirs, $ref_svn, $found ) = $self->SvnScanPath ( 'SvnCreatePackage', $package );
 
    if ( @$ref_dirs )
    {
        Error ("SvnCreatePackage: Package directory exists",
               "Cannot create a package here. Unexpected subdirectories:", @$ref_dirs);
    }

        else
        {
            Warning ("SvnCreatePackage: Package already present");
        }
    }
 
    #
    #   Create package directories that have not been discovered
    #       trunk
    #       branches
    #       tags

 
    #
    #   Pass the updated revision number back to the user
    #
    $self->CalcRmReference($target);
    Message ("Create Package Tag is: " . $self->RmRef);
    Message ("Create Package Vcs is: " . $self->SvnTag);
    return $self->{RMREF} ;
}
 
#-------------------------------------------------------------------------------
# Function        : SvnRmView

    }
 
    #
    #   Pass the updated revision number back to the user
    #
    $self->CalcRmReference($target);
    #Message ("Tag is: " . $self->{RMREF} );
    return $self->{RMREF} ;
}
 
#-------------------------------------------------------------------------------

    #       Repository Root: svn://auperaws996vm21/test
    #
    my $url = $self->{'InfoWs'}{'URL'};
    my $reporoot = $self->{'InfoWs'}{'Repository Root'};
    my $repoVersion = $self->{'InfoWs'}{'Revision'};
    my $devBranch;
 
    Error ("JatsSvn Internal error. Can't parse info")
        unless ( $url && $reporoot );
 
    #

    #
    if (  $url =~ m~(.+)/((tags|branches|trunk)(/|$).*)~ )
    {
        $url = $1;
        $self->{WSTYPE} = $3;
        if ( $3 eq 'trunk' ) {
            $devBranch = $3;
        } elsif ( $3 eq 'branches' ) {
            $devBranch = $2;
        }
    }
    else
    {
        #
        #   If we are being slack (ie deleting the workspace)

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

}
 
#-------------------------------------------------------------------------------
# Function        : SplitPackageUrl
#
# Description     : Split the package URL into a few useful bits
#
# Inputs          : $self           - Instance data
#
# Returns         : Nothing
#

sub Full        { return $_[0]->{URL} . $_[0]->{PKGROOT} ; }
sub FullWs      { return $_[0]->{URL} . $_[0]->{WSURL} ; }
sub FullWsRev   { return $_[0]->{URL} . $_[0]->{WSURL} . '@' . $_[0]->{WSREVNO} ; }
sub FullPath    { return $_[0]->{URL} . $_[0]->{PATH} ; }
sub Peg         { return $_[0]->{PEG} ; }
sub DevBranch   { return $_[0]->{DEVBRANCH} || '' ; }
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; }
sub SvnTag      { return $_[0]->{SVNTAG} || '' ; }
 
#-------------------------------------------------------------------------------
# Function        : Print
#
# Description     : Debug display the URL

    print "$header\n" if $header;
    $indent = 4 unless ( defined $indent );
    $indent = ' ' x $indent;
 
 
    print $indent . "PROTOCOL :" . $self->{PROTOCOL} . "\n";
    print $indent . "SERVER   :" . $self->{SERVER} . "\n";
    print $indent . "URL      :" . $self->{URL} . "\n";
    print $indent . "PKGROOT  :" . $self->{PKGROOT} . "\n";
    print $indent . "PATH     :" . $self->{PATH} . "\n";
    print $indent . "TAGTYPE  :" . ($self->{TAGTYPE} || '') . "\n";
    print $indent . "VERSION  :" . ($self->{VERSION} || '') . "\n";
    print $indent . "PEG      :" . ($self->{PEG} || '') . "\n";
    print $indent . "DEVBRANCH:" . ($self->{DEVBRANCH} || '') . "\n";
    print $indent . "SVNTAG   :" . ($self->{SVNTAG} || '') . "\n";
#    print $indent . "FULL    :" . $self->Full . "\n";
 
    print $indent . "Full         :" . $self->Full . "\n";
#    print $indent . "FullWs       :" . $self->FullWs    . "\n";
#    print $indent . "FullWsRev    :" . $self->FullWsRev . "\n";
    print $indent . "FullPath     :" . $self->FullPath  . "\n";
    print $indent . "Peg          :" . $self->Peg       . "\n";
    print $indent . "DevBranch    :" . $self->DevBranch . "\n";
    print $indent . "Type         :" . $self->Type      . "\n";
    print $indent . "WsType       :" . $self->WsType    . "\n";
    print $indent . "Path         :" . $self->Path      . "\n";
    print $indent . "Version      :" . $self->Version   . "\n";
    print $indent . "RmRef        :" . ($self->RmRef || '') . "\n";

    #
    #   Return 0 to keep on going
    return 0;
}
 
 
 
#------------------------------------------------------------------------------
1;

Rev 1345	Rev 1347
Line 410...	Line 410...
410	`Error ("Package name contains a Peg ($1)", "Path: $package")`	410	`Error ("Package name contains a Peg ($1)", "Path: $package")`
411	`if ( $package =~ m~.*(@\d+)$~ );`	411	`if ( $package =~ m~.*(@\d+)$~ );`
412		412
413	`#`	413	`#`
414	`# Determine TTB target`	414	`# Determine TTB target`
-		415	`# The TTB type for branckes and tags also conatins the branch or tag`
415	`#`	416	`#`
416	`$opt{'type'} = 'trunk' unless ( $opt{'type'} );`	417	`$opt{'type'} = 'trunk' unless ( $opt{'type'} );`
417	`Error ("Invalid TTB type") unless ( $opt{'type'} =~ m{^(tags\|branches\|trunk)$} );`	418	`if ( $opt{'type'} =~ m~^(tags\|branches\|trunk)(/\|$)(.*)~ ) {`
-		419	`Error ("SvnCreatePackage: TTB type ($1) must be followed by a path element")`
-		420	`if ( (($1 eq 'tags') or ($1 eq 'branches' )) && ! $3 );`
-		421	`Error ('SvnCreatePackage: TTB type of trunk must not be followed by a path element: ' . $opt{'type'})`
-		422	`if ( ($1 eq 'trunk') && $3 );`
-		423	`} else {`
418	`Error ("Import without label") if ( $opt{'type'} ne 'trunk' && ! $opt{'label'} );`	424	`Error ("SvnCreatePackage: Invalid TTB Type: " . $opt{'type'} );`
-		425	`}`
419		426
420	`#`	427	`#`
421	`# Before we import data we must ensure that the targets do not exist`	428	`# Before we import data we must ensure that the targets do not exist`
422	`# Determine the import target(s)`	429	`# Determine the import target(s)`
423	`#`	430	`#`
Line 429...	Line 436...
429	`#`	436	`#`
430	`# Primary target`	437	`# Primary target`
431	`# trunk, branck or tag`	438	`# trunk, branck or tag`
432	`#`	439	`#`
433	`$import_target = $package . '/' . $opt{'type'};`	440	`$import_target = $package . '/' . $opt{'type'};`
434	`$import_target .= '/' .$opt{'label'} if ( $opt{'type'} ne 'trunk');`	441	`$self->{DEVBRANCH} = $opt{'type'} ;`
435		442
436	`$self->SvnValidateTarget( 'target' => $import_target,`	443	`$self->SvnValidateTarget( 'target' => $import_target,`
437	`'delete' => $opt{'replace'},`	444	`'delete' => $opt{'replace'},`
438	`'available' => 1 );`	445	`'available' => 1 );`
439		446
440	`#`	447	`#`
441	`# Secondary target`	448	`# Secondary target`
442	`# If primary is a trunk and a label is provided`	449	`# Are we tagging the import too`
443	`#`	450	`#`
444	`if ( $opt{'type'} eq 'trunk' && $opt{'label'} )`	451	`if ( $opt{'label'} )`
445	`{`	452	`{`
446	`$copy_target = $package . '/tags/' . $opt{'label'};`	453	`$copy_target = $package . '/tags/' . $opt{'label'};`
447	`$self->SvnValidateTarget( 'target' => $copy_target,`	454	`$self->SvnValidateTarget( 'target' => $copy_target,`
448	`'delete' => $opt{'replace'},`	455	`'delete' => $opt{'replace'},`
449	`'available' => 1 );`	456	`'available' => 1 );`
Line 452...	Line 459...
452		459
453	`#`	460	`#`
454	`# Probe to see if the package exists`	461	`# Probe to see if the package exists`
455	`#`	462	`#`
456	`my ( $ref_files, $ref_dirs, $ref_svn, $found ) = $self->SvnScanPath ( 'SvnCreatePackage', $package );`	463	`my ( $ref_files, $ref_dirs, $ref_svn, $found ) = $self->SvnScanPath ( 'SvnCreatePackage', $package );`
457		-
458	`if ( @$ref_dirs )`	464	`if ( @$ref_dirs )`
459	`{`	465	`{`
460	`Error ("SvnCreatePackage: Package directory exists",`	466	`Error ("SvnCreatePackage: Package directory exists",`
461	`"Cannot create a package here. Unexpected subdirectories:", @$ref_dirs);`	467	`"Cannot create a package here. Unexpected subdirectories:", @$ref_dirs);`
462	`}`	468	`}`
Line 495...	Line 501...
495	`else`	501	`else`
496	`{`	502	`{`
497	`Warning ("SvnCreatePackage: Package already present");`	503	`Warning ("SvnCreatePackage: Package already present");`
498	`}`	504	`}`
499	`}`	505	`}`
500		-
501	`#`	506	`#`
502	`# Create package directories that have not been discovered`	507	`# Create package directories that have not been discovered`
503	`# trunk`	508	`# trunk`
504	`# branches`	509	`# branches`
505	`# tags`	510	`# tags`
Line 564...	Line 569...
564		569
565	`#`	570	`#`
566	`# Pass the updated revision number back to the user`	571	`# Pass the updated revision number back to the user`
567	`#`	572	`#`
568	`$self->CalcRmReference($target);`	573	`$self->CalcRmReference($target);`
569	`Message ("Create Package Tag is: " . $self->{RMREF} );`	574	`Message ("Create Package Tag is: " . $self->RmRef);`
-		575	`Message ("Create Package Vcs is: " . $self->SvnTag);`
570	`return $self->{RMREF} ;`	576	`return $self->{RMREF} ;`
571	`}`	577	`}`
572		578
573	`#-------------------------------------------------------------------------------`	579	`#-------------------------------------------------------------------------------`
574	`# Function : SvnRmView`	580	`# Function : SvnRmView`
Line 789...	Line 795...
789	`}`	795	`}`
790		796
791	`#`	797	`#`
792	`# Pass the updated revision number back to the user`	798	`# Pass the updated revision number back to the user`
793	`#`	799	`#`
794	`$self->CalcRmReference($target );`	800	`$self->CalcRmReference($target);`
795	`#Message ("Tag is: " . $self->{RMREF} );`	801	`#Message ("Tag is: " . $self->{RMREF} );`
796	`return $self->{RMREF} ;`	802	`return $self->{RMREF} ;`
797	`}`	803	`}`
798		804
799	`#-------------------------------------------------------------------------------`	805	`#-------------------------------------------------------------------------------`
Line 1399...	Line 1405...
1399	`# Repository Root: svn://auperaws996vm21/test`	1405	`# Repository Root: svn://auperaws996vm21/test`
1400	`#`	1406	`#`
1401	`my $url = $self->{'InfoWs'}{'URL'};`	1407	`my $url = $self->{'InfoWs'}{'URL'};`
1402	`my $reporoot = $self->{'InfoWs'}{'Repository Root'};`	1408	`my $reporoot = $self->{'InfoWs'}{'Repository Root'};`
1403	`my $repoVersion = $self->{'InfoWs'}{'Revision'};`	1409	`my $repoVersion = $self->{'InfoWs'}{'Revision'};`
-		1410	`my $devBranch;`
1404		1411
1405	`Error ("JatsSvn Internal error. Can't parse info")`	1412	`Error ("JatsSvn Internal error. Can't parse info")`
1406	`unless ( $url && $reporoot );`	1413	`unless ( $url && $reporoot );`
1407		1414
1408	`#`	1415	`#`
Line 1425...	Line 1432...
1425	`#`	1432	`#`
1426	`if ( $url =~ m~(.+)/((tags\|branches\|trunk)(/\|$).*)~ )`	1433	`if ( $url =~ m~(.+)/((tags\|branches\|trunk)(/\|$).*)~ )`
1427	`{`	1434	`{`
1428	`$url = $1;`	1435	`$url = $1;`
1429	`$self->{WSTYPE} = $3;`	1436	`$self->{WSTYPE} = $3;`
-		1437	`if ( $3 eq 'trunk' ) {`
-		1438	`$devBranch = $3;`
-		1439	`} elsif ( $3 eq 'branches' ) {`
-		1440	`$devBranch = $2;`
-		1441	`}`
1430	`}`	1442	`}`
1431	`else`	1443	`else`
1432	`{`	1444	`{`
1433	`#`	1445	`#`
1434	`# If we are being slack (ie deleting the workspace)`	1446	`# If we are being slack (ie deleting the workspace)`
Line 1445...	Line 1457...
1445	`# Insert known information`	1457	`# Insert known information`
1446	`#`	1458	`#`
1447	`$self->{URL} = $reporoot . '/';`	1459	`$self->{URL} = $reporoot . '/';`
1448	`$self->{PKGROOT} = $url;`	1460	`$self->{PKGROOT} = $url;`
1449	`$self->{WSREVNO} = $repoVersion;`	1461	`$self->{WSREVNO} = $repoVersion;`
-		1462	`$self->{DEVBRANCH} = $devBranch;`
1450		1463
1451	`#`	1464	`#`
1452	`# Create useful information`	1465	`# Create useful information`
1453	`#`	1466	`#`
1454	`SplitPackageUrl($self);`	1467	`SplitPackageUrl($self);`
Line 1618...	Line 1631...
1618	`}`	1631	`}`
1619		1632
1620	`#-------------------------------------------------------------------------------`	1633	`#-------------------------------------------------------------------------------`
1621	`# Function : SplitPackageUrl`	1634	`# Function : SplitPackageUrl`
1622	`#`	1635	`#`
1623	`# Description : Slip the package URL into a few useful bits`	1636	`# Description : Split the package URL into a few useful bits`
1624	`#`	1637	`#`
1625	`# Inputs : $self - Instance data`	1638	`# Inputs : $self - Instance data`
1626	`#`	1639	`#`
1627	`# Returns : Nothing`	1640	`# Returns : Nothing`
1628	`#`	1641	`#`
Line 1694...	Line 1707...
1694	`sub Full { return $_[0]->{URL} . $_[0]->{PKGROOT} ; }`	1707	`sub Full { return $_[0]->{URL} . $_[0]->{PKGROOT} ; }`
1695	`sub FullWs { return $_[0]->{URL} . $_[0]->{WSURL} ; }`	1708	`sub FullWs { return $_[0]->{URL} . $_[0]->{WSURL} ; }`
1696	`sub FullWsRev { return $_[0]->{URL} . $_[0]->{WSURL} . '@' . $_[0]->{WSREVNO} ; }`	1709	`sub FullWsRev { return $_[0]->{URL} . $_[0]->{WSURL} . '@' . $_[0]->{WSREVNO} ; }`
1697	`sub FullPath { return $_[0]->{URL} . $_[0]->{PATH} ; }`	1710	`sub FullPath { return $_[0]->{URL} . $_[0]->{PATH} ; }`
1698	`sub Peg { return $_[0]->{PEG} ; }`	1711	`sub Peg { return $_[0]->{PEG} ; }`
-		1712	`sub DevBranch { return $_[0]->{DEVBRANCH} \|\| '' ; }`
1699	`sub Type { return $_[0]->{TAGTYPE} \|\| '' ; }`	1713	`sub Type { return $_[0]->{TAGTYPE} \|\| '' ; }`
1700	`sub WsType { return $_[0]->{WSTYPE} \|\| '' ; }`	1714	`sub WsType { return $_[0]->{WSTYPE} \|\| '' ; }`
1701	`sub Path { return $_[0]->{PATH} ; }`	1715	`sub Path { return $_[0]->{PATH} ; }`
1702	`sub Version { return $_[0]->{VERSION} ; }`	1716	`sub Version { return $_[0]->{VERSION} ; }`
1703	`sub RmRef { return $_[0]->{RMREF} ; }`	1717	`sub RmRef { return $_[0]->{RMREF} ; }`
1704	`sub RmPath { my $path = $_[0]->{RMREF}; $path =~ s~@.*?$~~ ;return $path; }`	1718	`sub RmPath { my $path = $_[0]->{RMREF}; $path =~ s~@.*?$~~ ;return $path; }`
-		1719	`sub SvnTag { return $_[0]->{SVNTAG} \|\| '' ; }`
1705		1720
1706	`#-------------------------------------------------------------------------------`	1721	`#-------------------------------------------------------------------------------`
1707	`# Function : Print`	1722	`# Function : Print`
1708	`#`	1723	`#`
1709	`# Description : Debug display the URL`	1724	`# Description : Debug display the URL`
Line 1720...	Line 1735...
1720	`print "$header\n" if $header;`	1735	`print "$header\n" if $header;`
1721	`$indent = 4 unless ( defined $indent );`	1736	`$indent = 4 unless ( defined $indent );`
1722	`$indent = ' ' x $indent;`	1737	`$indent = ' ' x $indent;`
1723		1738
1724		1739
1725	`print $indent . "PROTOCOL:" . $self->{PROTOCOL} . "\n";`	1740	`print $indent . "PROTOCOL :" . $self->{PROTOCOL} . "\n";`
1726	`print $indent . "SERVER :" . $self->{SERVER} . "\n";`	1741	`print $indent . "SERVER :" . $self->{SERVER} . "\n";`
1727	`print $indent . "URL :" . $self->{URL} . "\n";`	1742	`print $indent . "URL :" . $self->{URL} . "\n";`
1728	`print $indent . "PKGROOT :" . $self->{PKGROOT} . "\n";`	1743	`print $indent . "PKGROOT :" . $self->{PKGROOT} . "\n";`
1729	`print $indent . "PATH :" . $self->{PATH} . "\n";`	1744	`print $indent . "PATH :" . $self->{PATH} . "\n";`
1730	`print $indent . "TAGTYPE :" . ($self->{TAGTYPE} \|\| '') . "\n";`	1745	`print $indent . "TAGTYPE :" . ($self->{TAGTYPE} \|\| '') . "\n";`
1731	`print $indent . "VERSION :" . ($self->{VERSION} \|\| '') . "\n";`	1746	`print $indent . "VERSION :" . ($self->{VERSION} \|\| '') . "\n";`
1732	`print $indent . "PEG :" . ($self->{PEG} \|\| '') . "\n";`	1747	`print $indent . "PEG :" . ($self->{PEG} \|\| '') . "\n";`
-		1748	`print $indent . "DEVBRANCH:" . ($self->{DEVBRANCH} \|\| '') . "\n";`
-		1749	`print $indent . "SVNTAG :" . ($self->{SVNTAG} \|\| '') . "\n";`
1733	`# print $indent . "FULL :" . $self->Full . "\n";`	1750	`# print $indent . "FULL :" . $self->Full . "\n";`
1734		1751
1735	`print $indent . "Full :" . $self->Full . "\n";`	1752	`print $indent . "Full :" . $self->Full . "\n";`
1736	`# print $indent . "FullWs :" . $self->FullWs . "\n";`	1753	`# print $indent . "FullWs :" . $self->FullWs . "\n";`
1737	`# print $indent . "FullWsRev :" . $self->FullWsRev . "\n";`	1754	`# print $indent . "FullWsRev :" . $self->FullWsRev . "\n";`
1738	`print $indent . "FullPath :" . $self->FullPath . "\n";`	1755	`print $indent . "FullPath :" . $self->FullPath . "\n";`
1739	`print $indent . "Peg :" . $self->Peg . "\n";`	1756	`print $indent . "Peg :" . $self->Peg . "\n";`
-		1757	`print $indent . "DevBranch :" . $self->DevBranch . "\n";`
1740	`print $indent . "Type :" . $self->Type . "\n";`	1758	`print $indent . "Type :" . $self->Type . "\n";`
1741	`print $indent . "WsType :" . $self->WsType . "\n";`	1759	`print $indent . "WsType :" . $self->WsType . "\n";`
1742	`print $indent . "Path :" . $self->Path . "\n";`	1760	`print $indent . "Path :" . $self->Path . "\n";`
1743	`print $indent . "Version :" . $self->Version . "\n";`	1761	`print $indent . "Version :" . $self->Version . "\n";`
1744	`print $indent . "RmRef :" . ($self->RmRef \|\| '') . "\n";`	1762	`print $indent . "RmRef :" . ($self->RmRef \|\| '') . "\n";`
Line 1974...	Line 1992...
1974	`#`	1992	`#`
1975	`# Return 0 to keep on going`	1993	`# Return 0 to keep on going`
1976	`return 0;`	1994	`return 0;`
1977	`}`	1995	`}`
1978		1996
1979		-
1980		-
1981	`#------------------------------------------------------------------------------`	1997	`#------------------------------------------------------------------------------`
1982	`1;`	1998	`1;`

Subversion Repositories DevTools

(root)/core_devl/branches/dpurdie_devl/TOOLS/LIB/JatsSvn.pm – Rev 1345 → 1347