Subversion Repositories DevTools

Rev

Rev 351 | Rev 361 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 351 Rev 353
Line 23... Line 23...
23 
#......................................................................#
 23 
#......................................................................#
24 
 
 24 
 
25 
require 5.008_002;
 25 
require 5.008_002;
26 
use strict;
 26 
use strict;
27 
use warnings;
 27 
use warnings;
28 
our $GBE_SVN_URL;
 - 
 
29 
our $USER;
 28 
our $USER;
30 
use JatsEnv;
 29 
use JatsEnv;
31 
 
 30 
 
32 
package JatsSvn;
 31 
package JatsSvn;
33 
 
 32 
 
Line 64... Line 63...
64 
#
 63 
#
65 
#   Global Variables
 64 
#   Global Variables
66 
#
 65 
#
67 
 
 66 
 
68 
#-------------------------------------------------------------------------------
 67 
#-------------------------------------------------------------------------------
69 
# Function        : BEGIN
 - 
 
70 
#
 - 
 
71 
# Description     : Module Initialization
 - 
 
72 
#                   Invoked by Perl as soon as possible
 - 
 
73 
#                       Setup environment variables
 - 
 
74 
#                       Calculate globals
 - 
 
75 
#
 - 
 
76 
# Inputs          : None
 - 
 
77 
#
 - 
 
78 
# Returns         : Nothing
 - 
 
79 
#
 - 
 
80 
sub BEGIN
 - 
 
81 
{
 - 
 
82 
    #
 - 
 
83 
    #   Need to have a configured Repository
 - 
 
84 
    #
 - 
 
85 
    ::EnvImport ('GBE_SVN_URL' );
 - 
 
86 
 
 - 
 
87 
    #
 - 
 
88 
    #   Remove trailing /s
 - 
 
89 
    #
 - 
 
90 
    $::GBE_SVN_URL =~ s~/*$~~;
 - 
 
91 
 
 - 
 
92 
    #
 - 
 
93 
    #   Ensure that it is in valid format
 - 
 
94 
    #   Three forms are supported
 - 
 
95 
    #
 - 
 
96 
    if ( $::GBE_SVN_URL =~ m{^svn://[^/]+$} ) {
 - 
 
97 
        #
 - 
 
98 
        #   Type is SVN server
 - 
 
99 
        #   Protocol + server name
 - 
 
100 
        #
 - 
 
101 
    } elsif ( $::GBE_SVN_URL =~ m{^http://.+} ) {
 - 
 
102 
        #
 - 
 
103 
        #   Type is HTTP server
 - 
 
104 
        #   Protocol + server name + path on server
 - 
 
105 
        #
 - 
 
106 
    } elsif ( $::GBE_SVN_URL =~ m{^file:///+[A-Z]:/} ) {
 - 
 
107 
        #
 - 
 
108 
        #   Type is local Repo (file)
 - 
 
109 
        #   Windows absolute pathname
 - 
 
110 
        #   file:///I:/path/...
 - 
 
111 
        #
 - 
 
112 
    } elsif ( $::GBE_SVN_URL =~ m{^file:///+[^/]} ) {
 - 
 
113 
        #
 - 
 
114 
        #   Type is local Repo (file)
 - 
 
115 
        #   Unix absolute pathname
 - 
 
116 
        #   file:///path/...
 - 
 
117 
        #
 - 
 
118 
    } else {
 - 
 
119 
        Error ("GBE_SVN_URL format not understood","GBE_SVN_URL: $::GBE_SVN_URL");
 - 
 
120 
    }
 - 
 
121 
 
 - 
 
122 
    #
 - 
 
123 
    #   Add a trailing '/'
 - 
 
124 
    #   This will make it easier to use
 - 
 
125 
    #
 - 
 
126 
    $::GBE_SVN_URL .= '/';
 - 
 
127
- 
 
128 
}
 - 
 
129 
 
 - 
 
130 
#-------------------------------------------------------------------------------
 - 
 
131 
# Function        : SvnCo
 68 
# Function        : SvnCo
132 
#
 69 
#
133 
# Description     : Create a workspace
 70 
# Description     : Create a workspace
134 
#                   Can be used to extract files, without creating the
 71 
#                   Can be used to extract files, without creating the
135 
#                   subversion control files.
 72 
#                   subversion control files.
Line 690... Line 627...
690 
 
 627 
 
691 
    #
 628 
    #
692 
    #   Pass the updated revision number back to the user
 629 
    #   Pass the updated revision number back to the user
693 
    #
 630 
    #
694 
    $self->CalcRmReference($target );
 631 
    $self->CalcRmReference($target );
695 
    Message ("Tag is: " . $self->{RMREF} );
 632 
    #Message ("Tag is: " . $self->{RMREF} );
696 
    return $self->{RMREF} ;
 633 
    return $self->{RMREF} ;
697 
}
 634 
}
698 
 
 635 
 
699 
#-------------------------------------------------------------------------------
 636 
#-------------------------------------------------------------------------------
700 
# Function        : SvnWsModified
 637 
# Function        : SvnWsModified
Line 1165... Line 1102...
1165 
    #
 1102 
    #
1166 
    #   Document Class Variables
 1103 
    #   Document Class Variables
1167 
    #
 1104 
    #
1168 
    $self->{URL} = '';                  # Repo URL prefix
 1105 
    $self->{URL} = '';                  # Repo URL prefix
1169 
    $self->{WS}  = '';                  # Users WorkSpace
 1106 
    $self->{WS}  = '';                  # Users WorkSpace
1170 
    $self->{NAMEDSERVER} = '';          # User specified server
 - 
 
1171 
    $self->{PROTOCOL} = '';             # Named Access Protocol
 1107 
    $self->{PROTOCOL} = '';             # Named Access Protocol
1172 
    $self->{PKGROOT} = '';              # Package root
 1108 
    $self->{PKGROOT} = '';              # Package root
1173 
 
 1109 
 
1174 
    #
 1110 
    #
1175 
    #   Create a class
 1111 
    #   Create a class
Line 1297... Line 1233...
1297 
    #   Populate it with information that is known
 1233 
    #   Populate it with information that is known
1298 
    #
 1234 
    #
1299 
    $self = NewSession() unless ( $self );
 1235 
    $self = NewSession() unless ( $self );
1300 
 
 1236 
 
1301 
    #
 1237 
    #
1302 
    #   Examine the URL and determine if we have a FULL Url or
 1238 
    #   Examine the UURL and convert a Repository Path into a URL
1303 
    #   a path within the 'default' server
 1239 
    #   as provided by configuration information within the environment
1304 
    #
 1240 
    #
1305 
    if ( defined $::GBE_SVN_URL && $uurl =~ m~^$::GBE_SVN_URL(.*)~ )
 1241 
    $uurl =~ m~(.+?)/(.*)~;
- 
 
 1242 
    my $fe = $1 || $uurl;
- 
 
 1243 
    my $rest = $2 || '';
- 
 
 1244 
    my $processed = 0;
- 
 
 1245 
    if ( $SVN_URLS{$fe} )
1306 
    {
 1246 
    {
- 
 
 1247 
        $self->{URL} = $SVN_URLS{$fe};
- 
 
 1248 
        $self->{PKGROOT} = $rest;
1307 
        $uurl = $1;
 1249 
        $processed = 1;
1308 
    }
 1250 
    }
1309 
 
 1251 
 
1310 
    if ( $uurl =~ m~^((file|http|https|svn):///?([^/]+)/)(.+)~ )
 - 
 
1311 
    {
 - 
 
1312 
        #       http://server/
 - 
 
1313 
        #       https://server/
 - 
 
1314 
        #       svn://server/
 1252 
    if ( ! $processed )
1315 
        #       file://This/Isa/Bad/Guess
 - 
 
1316 
        #
 - 
 
1317 
        $self->{NAMEDSERVER} = 1;
 - 
 
1318 
        $self->{PROTOCOL} = $2;
 - 
 
1319 
 
 - 
 
1320 
        $self->{URL} = $1;
 - 
 
1321 
        $self->{PKGROOT} = $4;
 - 
 
1322 
    }
 - 
 
1323 
    else
 - 
 
1324 
    {
 1253 
    {
1325 
        #
 1254 
        #
- 
 
 1255 
        #   Examine the URL and determine if we have a FULL Url or
1326 
        #   User default (site configured) Repo Root
 1256 
        #   a path within the 'default' server
1327 
        #
 1257 
        #
1328 
        Error ("No site repository configured",
 1258 
        foreach my $key ( @SVN_URLS_LIST )
- 
 
 1259 
        {
1329 
               "Configure GBE_SVN_URL" ) unless ( $::GBE_SVN_URL );
 1260 
            if ( $uurl =~ m~^$SVN_URLS{$key}(.*)~ )
- 
 
 1261 
            {
- 
 
 1262 
                $self->{URL} = $SVN_URLS{$key};
- 
 
 1263 
                $self->{PKGROOT} = $1;
- 
 
 1264 
                $processed = 1;
- 
 
 1265 
                last;
- 
 
 1266 
            }
- 
 
 1267 
        }
- 
 
 1268 
    }
1330 
 
 1269 
 
- 
 
 1270 
    #
- 
 
 1271 
    #   Last attempt
- 
 
 1272 
    #   Treat as a raw URL - some operations won't be allowed
- 
 
 1273 
    #
- 
 
 1274 
    if ( ! $processed )
- 
 
 1275 
    {
- 
 
 1276 
        if ( $uurl =~ m~^((file|http|https|svn):///?([^/]+)/)(.+)~ )
- 
 
 1277 
        {
- 
 
 1278 
            #       http://server/
- 
 
 1279 
            #       https://server/
- 
 
 1280 
            #       svn://server/
- 
 
 1281 
            #       file://This/Isa/Bad/Guess
- 
 
 1282 
            #
- 
 
 1283 
            $self->{URL} = $1;
- 
 
 1284 
            $self->{PKGROOT} = $4;
- 
 
 1285 
        }
- 
 
 1286 
        elsif ($SVN_URLS{''})
- 
 
 1287 
        {
1331 
        $self->{URL} = $::GBE_SVN_URL;
 1288 
            $self->{URL} = $SVN_URLS{''};
1332 
        $self->{PKGROOT} = $uurl;
 1289 
            $self->{PKGROOT} = $uurl;
- 
 
 1290 
        }
- 
 
 1291 
        else
- 
 
 1292 
        {
- 
 
 1293 
            #
- 
 
 1294 
            #   User default (site configured) Repo Root
- 
 
 1295 
            #
- 
 
 1296 
            Error ("No site repository configured for : $fe",
- 
 
 1297 
                   "Configure GBE_SVN_URL_" . uc($fe) );
- 
 
 1298 
        }
1333 
    }
 1299 
    }
1334 
 
 1300 
 
1335 
    #
 1301 
    #
1336 
    #   Create useful information
 1302 
    #   Create useful information
1337 
    #
 1303 
    #
Line 1349... Line 1315...
1349 
# Returns         : Nothing
 1315 
# Returns         : Nothing
1350 
#
 1316 
#
1351 
sub SplitPackageUrl
 1317 
sub SplitPackageUrl
1352 
{
 1318 
{
1353 
    my ($self) = @_;
 1319 
    my ($self) = @_;
1354 
    Debug ("SplitPackageUrl", @_);
 1320 
    Debug ("SplitPackageUrl", $self->{URL}, $self->{PKGROOT});
1355 
 
 1321 
 
1356 
    #
 1322 
    #
1357 
    #   Remove any protocol that may be present
 1323 
    #   Remove any protocol that may be present
1358 
    #       http://server/
 1324 
    #       http://server/
1359 
    #       https://server/
 1325 
    #       https://server/
Line 1467... Line 1433...
1467 
    print $indent . "PROTOCOL:" . $self->{PROTOCOL} . "\n";
 1433 
    print $indent . "PROTOCOL:" . $self->{PROTOCOL} . "\n";
1468 
    print $indent . "SERVER  :" . $self->{SERVER} . "\n";
 1434 
    print $indent . "SERVER  :" . $self->{SERVER} . "\n";
1469 
    print $indent . "URL     :" . $self->{URL} . "\n";
 1435 
    print $indent . "URL     :" . $self->{URL} . "\n";
1470 
    print $indent . "PKGROOT :" . $self->{PKGROOT} . "\n";
 1436 
    print $indent . "PKGROOT :" . $self->{PKGROOT} . "\n";
1471 
    print $indent . "PATH    :" . $self->{PATH} . "\n";
 1437 
    print $indent . "PATH    :" . $self->{PATH} . "\n";
1472 
    print $indent . "TAGTYPE :" . $self->{TAGTYPE} . "\n";
 1438 
    print $indent . "TAGTYPE :" . ($self->{TAGTYPE} || '') . "\n";
1473 
    print $indent . "VERSION :" . $self->{VERSION} . "\n";
 1439 
    print $indent . "VERSION :" . ($self->{VERSION} || '') . "\n";
1474 
    print $indent . "PEG     :" . $self->{PEG} . "\n";
 1440 
    print $indent . "PEG     :" . ($self->{PEG} || '') . "\n";
1475 
    print $indent . "FULL    :" . $self->Full . "\n";
 1441 
    print $indent . "FULL    :" . $self->Full . "\n";
1476 
}
 1442 
}
1477 
 
 1443 
 
1478 
#-------------------------------------------------------------------------------
 1444 
#-------------------------------------------------------------------------------
1479 
# Function        : BranchName
 1445 
# Function        : BranchName