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



            $force = 1;
        } elsif ( m~^--PreText=(.+)~ ) {
            $text = $1;
        } elsif ( m~^--NoPrint~ ) {
            $print = 0;
        } elsif ( m~^--Print~ ) {
            $print = 1;
        } else {
            Error ("SvnCo: Unknown option: $_");
        }
    }
    $self->{CoText} = $text;
 
 
    #
    #   Ensure that the output path does not exist
    #   Do not allow the user to create a local work space
    #   where one already exists

                            {
                                'process' => \&ProcessCo,
                                'data' => \@co_list,
                                'credentials' => 1,
                                'nosavedata' => 1,
                                'printdata' => $print,
                            }
                       ) || @co_list )
    {
        #
        #   We have a checkout limitation

        Verbose2 ("Remove WorkSpace: $path");
        rmtree( $path, IsVerbose(3) );
        rmtree( $path, IsVerbose(3) );
        Error ("Checking out Workspace", @{$self->{ERROR_LIST}}, @co_list );
    }
 
    return;
 
    #
    #   Internal routine to scan each the checkout
    #

# Returns         : Nothing
#
sub SvnSwitch
{
    my ($self, $RepoPath, $path, @opts) = @_;
    my $printdata = ! grep (/^--NoPrint/, @opts );
    Debug ("SvnSwitch", $RepoPath, $path);
 
    #
    #   Build up the command line
    #

                            {
                                'process' => \&ProcessSwitch,
                                'data' => \@sw_list,
                                'credentials' => 1,
                                'nosavedata' => 1,
                                'printdata' => $printdata,
                            }
                       ) || @sw_list )
    {
        #
        #   We have a switch problem

        Verbose2 ("Remove WorkSpace: $path");
        rmtree( $path, IsVerbose(3) );
        rmtree( $path, IsVerbose(3) );
        Error ("Switch elements", @{$self->{ERROR_LIST}}, @sw_list );
    }
 
    return;
 
    #
    #   Internal routine to scan each line of the Switch output
    #   Use to provide a nice display

#
# Description     : Create a package and any associated files
#
# Inputs          : $self        - Instance data
#                   A hash of named arguments
#                       package     - Name of the package
#                                     May include subdirs
#                       new         - True: Must not already exist
#                       replace     - True: Replace targets
#                       import      - DirTree to import
#                       label       - Tag for imported DirTree
#                       type        - Import TTB target
#                       printdata   - True: Print extracted files (default)
#
#
# Returns         : Revision of the copy
#
sub SvnCreatePackage
{

    my %dirs = ( 'trunk/'       => 0,
                 'tags/'        => 0,
                 'branches/'    => 0 );
 
    #
    #   Sanity Tests and defaul values
    #
    my $package = $self->Full || Error ("SvnCreatePackage: No package name provided");
    Error ("SvnCreatePackage: Invalid import path") if ( $opt{'import'} && ! -d $opt{'import'} );
    Error ("SvnCreatePackage: Tag without Import") if ( $opt{'label'} && ! $opt{'import'} );
    $opt{'label'} = SvnIsaSimpleLabel( $opt{'label'} ) if (  $opt{'label'} );
    $opt{'printdata'} = 1 unless ( exists $opt{'printdata'} );
 
    #
    #   Package path cannot contain any of the keyword paths tags,trunk,branches
    #   as this would place a package with a package
    #

    if ( $import_target )
    {
        Verbose ("Importing directory into new package: $opt{'import'}");
 
        $target = $import_target;
        $self->{PRINTDATA} = $opt{'printdata'};
        $self->SvnCmd ('import', $opt{'import'}
                        , $target
                        , '-m', 'Import by SvnCreatePackage'
                        , '--force'
                        , { 'credentials' => 1
                           ,'error' => "Import Incomplete"
                           ,'process' => \&ProcessRevNo
                           ,'printdata' => $opt{'printdata'}
                          })
    }
 
    #
    #   If imported to the trunk AND a label is provided

    #   a commit.
    #
    #   Moreover, files that are modified in the local workspace will
    #   be copied and checked into the target, but this is not nice.
    #
 
    $rv = $self->SvnCmd ( 'cp'  , $path
                        , $target
                        , '--parents'
                        , '-m', SvnComment( $opt{'comment'}, 'Created by SvnCopyWs' ),
                        , { 'process' => \&ProcessRevNo,
                            'credentials' => 1,
                            'printdata' => 1,
                             }
                        );
 
    if ($rv)
    {
        #
        #   Error in copy
        #   Attempt to delete the target. Don't worry if we can't do that

    $self->{btData} = ();
 
    #
    #   extract data
    #
 
 
    $self->SvnCmd ( 'log', '-v', '--xml', '-q', '--stop-on-copy', $self->FullPath() . '/' . $src_label
                    , { 'credentials' => 1,
                        'process' => \&ProcessBackTrack,
                        'printdata' => 0,
                         }
                        );
 
    #
    #   Process data

        my $target = $entry->{target};
 
        if ( $target =~ m~/$peglessLabel$~ )
        {
            my $parent = $entry->{fromPath};
            if ( defined $parent && $parent =~ m~(.+)/((tags|branches|trunk)(/|$).*)~ )
            {
                $branch = $2 . '@' . $entry->{fromRev};
                last;
            }
        }

    #
    #   Return nice value or original value
    #
    unless ( $branch )
    {
        $branch = $src_label;
        $self->{btData}{entryCount} = 0;
    }
 
    #
    #   Pass data back to the user

Rev 1347	Rev 1348
Line 103...	Line 103...
103	`$force = 1;`	103	`$force = 1;`
104	`} elsif ( m~^--PreText=(.+)~ ) {`	104	`} elsif ( m~^--PreText=(.+)~ ) {`
105	`$text = $1;`	105	`$text = $1;`
106	`} elsif ( m~^--NoPrint~ ) {`	106	`} elsif ( m~^--NoPrint~ ) {`
107	`$print = 0;`	107	`$print = 0;`
-		108	`} elsif ( m~^--Print~ ) {`
-		109	`$print = 1;`
108	`} else {`	110	`} else {`
109	`Error ("ScnCo: Unknown option: $_");`	111	`Error ("SvnCo: Unknown option: $_");`
110	`}`	112	`}`
111	`}`	113	`}`
112	`$self->{CoText} = $text;`	114	`$self->{CoText} = $text;`
113	`$self->{PRINTDATA} = $print;`	-
114		115
115	`#`	116	`#`
116	`# Ensure that the output path does not exist`	117	`# Ensure that the output path does not exist`
117	`# Do not allow the user to create a local work space`	118	`# Do not allow the user to create a local work space`
118	`# where one already exists`	119	`# where one already exists`
Line 133...	Line 134...
133	`{`	134	`{`
134	`'process' => \&ProcessCo,`	135	`'process' => \&ProcessCo,`
135	`'data' => \@co_list,`	136	`'data' => \@co_list,`
136	`'credentials' => 1,`	137	`'credentials' => 1,`
137	`'nosavedata' => 1,`	138	`'nosavedata' => 1,`
-		139	`'printdata' => $print,`
138	`}`	140	`}`
139	`) \|\| @co_list )`	141	`) \|\| @co_list )`
140	`{`	142	`{`
141	`#`	143	`#`
142	`# We have a checkout limitation`	144	`# We have a checkout limitation`
Line 148...	Line 150...
148	`Verbose2 ("Remove WorkSpace: $path");`	150	`Verbose2 ("Remove WorkSpace: $path");`
149	`rmtree( $path, IsVerbose(3) );`	151	`rmtree( $path, IsVerbose(3) );`
150	`rmtree( $path, IsVerbose(3) );`	152	`rmtree( $path, IsVerbose(3) );`
151	`Error ("Checking out Workspace", @{$self->{ERROR_LIST}}, @co_list );`	153	`Error ("Checking out Workspace", @{$self->{ERROR_LIST}}, @co_list );`
152	`}`	154	`}`
153	`$self->{PRINTDATA} = 0;`	-
154	`return;`	155	`return;`
155		156
156	`#`	157	`#`
157	`# Internal routine to scan each the checkout`	158	`# Internal routine to scan each the checkout`
158	`#`	159	`#`
Line 214...	Line 215...
214	`# Returns : Nothing`	215	`# Returns : Nothing`
215	`#`	216	`#`
216	`sub SvnSwitch`	217	`sub SvnSwitch`
217	`{`	218	`{`
218	`my ($self, $RepoPath, $path, @opts) = @_;`	219	`my ($self, $RepoPath, $path, @opts) = @_;`
219	`$self->{PRINTDATA} = ! grep (/^--NoPrint/, @opts );`	220	`my $printdata = ! grep (/^--NoPrint/, @opts );`
220	`Debug ("SvnSwitch", $RepoPath, $path);`	221	`Debug ("SvnSwitch", $RepoPath, $path);`
221		222
222	`#`	223	`#`
223	`# Build up the command line`	224	`# Build up the command line`
224	`#`	225	`#`
Line 227...	Line 228...
227	`{`	228	`{`
228	`'process' => \&ProcessSwitch,`	229	`'process' => \&ProcessSwitch,`
229	`'data' => \@sw_list,`	230	`'data' => \@sw_list,`
230	`'credentials' => 1,`	231	`'credentials' => 1,`
231	`'nosavedata' => 1,`	232	`'nosavedata' => 1,`
-		233	`'printdata' => $printdata,`
232	`}`	234	`}`
233	`) \|\| @sw_list )`	235	`) \|\| @sw_list )`
234	`{`	236	`{`
235	`#`	237	`#`
236	`# We have a switch problem`	238	`# We have a switch problem`
Line 242...	Line 244...
242	`Verbose2 ("Remove WorkSpace: $path");`	244	`Verbose2 ("Remove WorkSpace: $path");`
243	`rmtree( $path, IsVerbose(3) );`	245	`rmtree( $path, IsVerbose(3) );`
244	`rmtree( $path, IsVerbose(3) );`	246	`rmtree( $path, IsVerbose(3) );`
245	`Error ("Switch elements", @{$self->{ERROR_LIST}}, @sw_list );`	247	`Error ("Switch elements", @{$self->{ERROR_LIST}}, @sw_list );`
246	`}`	248	`}`
247	`$self->{PRINTDATA} = 0;`	-
248	`return;`	249	`return;`
249		250
250	`#`	251	`#`
251	`# Internal routine to scan each line of the Switch output`	252	`# Internal routine to scan each line of the Switch output`
252	`# Use to provide a nice display`	253	`# Use to provide a nice display`
Line 365...	Line 366...
365	`#`	366	`#`
366	`# Description : Create a package and any associated files`	367	`# Description : Create a package and any associated files`
367	`#`	368	`#`
368	`# Inputs : $self - Instance data`	369	`# Inputs : $self - Instance data`
369	`# A hash of named arguments`	370	`# A hash of named arguments`
370	`# package - Name of the package`	371	`# package - Name of the package`
371	`# May include subdirs`	372	`# May include subdirs`
372	`# new - True: Must not already exist`	373	`# new - True: Must not already exist`
373	`# replace - True: Replace targets`	374	`# replace - True: Replace targets`
374	`# import - DirTree to import`	375	`# import - DirTree to import`
375	`# label - Tag for imported DirTree`	376	`# label - Tag for imported DirTree`
376	`# type - Import TTB target`	377	`# type - Import TTB target`
-		378	`# printdata - True: Print extracted files (default)`
-		379	`#`
377	`#`	380	`#`
378	`# Returns : Revision of the copy`	381	`# Returns : Revision of the copy`
379	`#`	382	`#`
380	`sub SvnCreatePackage`	383	`sub SvnCreatePackage`
381	`{`	384	`{`
Line 388...	Line 391...
388	`my %dirs = ( 'trunk/' => 0,`	391	`my %dirs = ( 'trunk/' => 0,`
389	`'tags/' => 0,`	392	`'tags/' => 0,`
390	`'branches/' => 0 );`	393	`'branches/' => 0 );`
391		394
392	`#`	395	`#`
393	`# Sanity Tests`	396	`# Sanity Tests and defaul values`
394	`#`	397	`#`
395	`my $package = $self->Full \|\| Error ("SvnCreatePackage: No package name provided");`	398	`my $package = $self->Full \|\| Error ("SvnCreatePackage: No package name provided");`
396	`Error ("SvnCreatePackage: Invalid import path") if ( $opt{'import'} && ! -d $opt{'import'} );`	399	`Error ("SvnCreatePackage: Invalid import path") if ( $opt{'import'} && ! -d $opt{'import'} );`
397	`Error ("SvnCreatePackage: Tag without Import") if ( $opt{'label'} && ! $opt{'import'} );`	400	`Error ("SvnCreatePackage: Tag without Import") if ( $opt{'label'} && ! $opt{'import'} );`
398	`$opt{'label'} = SvnIsaSimpleLabel( $opt{'label'} ) if ( $opt{'label'} );`	401	`$opt{'label'} = SvnIsaSimpleLabel( $opt{'label'} ) if ( $opt{'label'} );`
-		402	`$opt{'printdata'} = 1 unless ( exists $opt{'printdata'} );`
399		403
400	`#`	404	`#`
401	`# Package path cannot contain any of the keyword paths tags,trunk,branches`	405	`# Package path cannot contain any of the keyword paths tags,trunk,branches`
402	`# as this would place a package with a package`	406	`# as this would place a package with a package`
403	`#`	407	`#`
Line 537...	Line 541...
537	`if ( $import_target )`	541	`if ( $import_target )`
538	`{`	542	`{`
539	`Verbose ("Importing directory into new package: $opt{'import'}");`	543	`Verbose ("Importing directory into new package: $opt{'import'}");`
540		544
541	`$target = $import_target;`	545	`$target = $import_target;`
542	`$self->{PRINTDATA} = 1;`	546	`$self->{PRINTDATA} = $opt{'printdata'};`
543	`$self->SvnCmd ('import', $opt{'import'}`	547	`$self->SvnCmd ('import', $opt{'import'}`
544	`, $target`	548	`, $target`
545	`, '-m', 'Import by SvnCreatePackage'`	549	`, '-m', 'Import by SvnCreatePackage'`
546	`, '--force'`	550	`, '--force'`
547	`, { 'credentials' => 1`	551	`, { 'credentials' => 1`
548	`,'error' => "Import Incomplete"`	552	`,'error' => "Import Incomplete"`
549	`,'process' => \&ProcessRevNo`	553	`,'process' => \&ProcessRevNo`
-		554	`,'printdata' => $opt{'printdata'}`
550	`})`	555	`})`
551	`}`	556	`}`
552		557
553	`#`	558	`#`
554	`# If imported to the trunk AND a label is provided`	559	`# If imported to the trunk AND a label is provided`
Line 750...	Line 755...
750	`# a commit.`	755	`# a commit.`
751	`#`	756	`#`
752	`# Moreover, files that are modified in the local workspace will`	757	`# Moreover, files that are modified in the local workspace will`
753	`# be copied and checked into the target, but this is not nice.`	758	`# be copied and checked into the target, but this is not nice.`
754	`#`	759	`#`
755	`$self->{PRINTDATA} = 1;`	-
756	`$rv = $self->SvnCmd ( 'cp' , $path`	760	`$rv = $self->SvnCmd ( 'cp' , $path`
757	`, $target`	761	`, $target`
758	`, '--parents'`	762	`, '--parents'`
759	`, '-m', SvnComment( $opt{'comment'}, 'Created by SvnCopyWs' ),`	763	`, '-m', SvnComment( $opt{'comment'}, 'Created by SvnCopyWs' ),`
760	`, { 'process' => \&ProcessRevNo,`	764	`, { 'process' => \&ProcessRevNo,`
761	`'credentials' => 1, }`	765	`'credentials' => 1,`
-		766	`'printdata' => 1,`
-		767	`}`
762	`);`	768	`);`
763	`$self->{PRINTDATA} = 0;`	-
764	`if ($rv)`	769	`if ($rv)`
765	`{`	770	`{`
766	`#`	771	`#`
767	`# Error in copy`	772	`# Error in copy`
768	`# Attempt to delete the target. Don't worry if we can't do that`	773	`# Attempt to delete the target. Don't worry if we can't do that`
Line 1875...	Line 1880...
1875	`$self->{btData} = ();`	1880	`$self->{btData} = ();`
1876		1881
1877	`#`	1882	`#`
1878	`# extract data`	1883	`# extract data`
1879	`#`	1884	`#`
1880	`#DebugDumpData("SVN", $svn );`	-
1881	`#$self->{PRINTDATA} = 1;`	-
1882	`$self->SvnCmd ( 'log', '-v', '--xml', '-q', '--stop-on-copy', $self->FullPath() . '/' . $src_label`	1885	`$self->SvnCmd ( 'log', '-v', '--xml', '-q', '--stop-on-copy', $self->FullPath() . '/' . $src_label`
1883	`, { 'credentials' => 1,`	1886	`, { 'credentials' => 1,`
1884	`'process' => \&ProcessBackTrack,`	1887	`'process' => \&ProcessBackTrack,`
-		1888	`'printdata' => 0,`
1885	`}`	1889	`}`
1886	`);`	1890	`);`
1887		1891
1888	`#`	1892	`#`
1889	`# Process data`	1893	`# Process data`
Line 1903...	Line 1907...
1903	`my $target = $entry->{target};`	1907	`my $target = $entry->{target};`
1904		1908
1905	`if ( $target =~ m~/$peglessLabel$~ )`	1909	`if ( $target =~ m~/$peglessLabel$~ )`
1906	`{`	1910	`{`
1907	`my $parent = $entry->{fromPath};`	1911	`my $parent = $entry->{fromPath};`
1908	`if ( $parent =~ m~(.+)/((tags\|branches\|trunk)(/\|$).*)~ )`	1912	`if ( defined $parent && $parent =~ m~(.+)/((tags\|branches\|trunk)(/\|$).*)~ )`
1909	`{`	1913	`{`
1910	`$branch = $2 . '@' . $entry->{fromRev};`	1914	`$branch = $2 . '@' . $entry->{fromRev};`
1911	`last;`	1915	`last;`
1912	`}`	1916	`}`
1913	`}`	1917	`}`
Line 1916...	Line 1920...
1916	`#`	1920	`#`
1917	`# Return nice value or original value`	1921	`# Return nice value or original value`
1918	`#`	1922	`#`
1919	`unless ( $branch )`	1923	`unless ( $branch )`
1920	`{`	1924	`{`
1921	`$branch = 'tags/' . $src_label;`	1925	`$branch = $src_label;`
1922	`$self->{btData}{entryCount} = 0;`	1926	`$self->{btData}{entryCount} = 0;`
1923	`}`	1927	`}`
1924		1928
1925	`#`	1929	`#`
1926	`# Pass data back to the user`	1930	`# Pass data back to the user`

Subversion Repositories DevTools

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