File Coverage

blib/lib/VCS/PVCS/Project.pm
Criterion Covered Total %
statement 16 18 88.8
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 22 24 91.6


line stmt bran cond sub pod time code
1             # Project.pm - Primary class for Perl PVCS module
2             #
3             # Copyright (c) 1998 Bill Middleton
4             #
5             #
6              
7             =head1 NAME
8              
9             VCS::PVCS::Project - Standard PVCS Project class for for VCS::PVCS
10              
11              
12             =head1 SYNOPSIS
13              
14             use VCS::PVCS::Project;
15             $project = new VCS::PVCS::Project("Project Name");
16              
17             $folds = $project->openFolders("SCRIPTS");
18             foreach $folder (@$folds){
19             $folder->checkout; # Checkout all files in the folder to the WD
20             }
21              
22             =head1 DESCRIPTION
23              
24             Inherit from VCS::PVCS::* to get all necessary methods to
25             parse master config file, as well as the master pvcsproj.pub
26             to learn about all projects in the PVCSROOT.
27              
28             Provides methods to operate on an entire project's files all\
29             at once. You can checkout, checkin, get history, or use the
30             VCS command to perform many different archive operations on
31             all the files in the project.
32              
33             =head1 METHODS
34              
35             =over 5
36              
37             =item B
38              
39             new VCS::PVCS::Project("NAME", {'WKDIR' => $wdir });
40              
41             Open an project in PVCS. If the project doesn't exist,
42             an attempt is made to create it. If an VCS::PVCS object
43             is not passed in, then the superclass routines from VCS::PVCS
44             are called to parse ISLVINI, PVCSPROJ files, and store global
45             information, relevant to all projects, from MASTER.CFG. Then open
46             and parse project-specific files (pvcsfold.pub) to learn about
47             all folders and documents within the project.
48              
49             Pass the hashref with WKDIR to specify a working directory for
50             the entire project. This method also creates the projects'
51             control files, project.cfg, and control directory.
52              
53             Returns a project object.
54              
55             =item B
56              
57             @members = $project->members("regexp");
58              
59             Return an array (or ref to array) of blessed Archive objects which
60             match the regexp. If no regexp is passed in, then return all of
61             the archives in the project. These objects can then call the
62             methods in the VCS::PVCS::Archive class.
63              
64             =item B
65              
66             When the Project object goes out of scope (e.g. when the program
67             finishes), the destroyer checks the list of archive directories
68             which have been added to the project, and saves a new config file
69             if appropriate.
70              
71             B
72             CONFIGURATION OPTIONS IN THE PROJECT CONFIG FILES AROUND VCSDIR.
73             THIS FEATURE MAY BE DISABLED BY TURNING ON $PVCSDONTSAVE in VCS::PVCS.pm.>
74              
75             =item B
76              
77             $project->newArchive()
78              
79             Create a new archive in the project. Normally, this method is called
80             by $Folder->newArchive, but if you, for some reason, dont use PVCS
81             folders, then you'll need to call this directly to create a new
82             archive.
83            
84             =item B
85              
86             Sorry, not copying projects in this release
87              
88             =item B
89              
90             Sorry, not deleting projects in this release
91              
92             =item B
93              
94             Sorry, not locking projects in this release
95              
96             =item B
97              
98             $Project->get([get opts]);
99              
100             Checkout all of the archive members in the project
101             to the the project's working directory, or CWD if
102             WD is not specified in pvcsproj.pub. Use opts to change
103             default actions.
104              
105             =item B
106              
107             Convenience routine calls $Project->get()
108              
109             =item B
110              
111             Convenience routine calls $Project->get()
112              
113             =item B
114              
115             $Project->put([put opts]);
116              
117             Checkin all of the archive members of the project from the
118             projects' WD or CWD. Use opts to change default actions.
119              
120             =item B
121              
122             Convenience routine calls put()
123              
124             =item B
125              
126             Convenience routine calls put()
127              
128             =item B
129              
130             $Project->vlog([vlog opts]);
131              
132             Takes a full vlog on all of the archive members in the project.
133             Use opts to change default actions. Result in $PVCSOUTPUT.
134              
135             =item B
136              
137             Convenience routine calls vlog()
138              
139             =item B
140              
141             Convenience routine calls vlog()
142              
143             =item B
144              
145             $Project->lock($label|$version,[vcs opts]);
146              
147             Locks the named revision (or rev spec'd by label) for all
148             archive members in the project. Use opts to change default action.
149              
150             =item B
151              
152             $Project->unlock($label|$version,[vcs opts]);
153              
154             unlocks the named revision (or rev spec'd by label) for all
155             archive members of the project. Use opts to change default action.
156              
157             =item B
158              
159             $Project->addVersionLabel($label,[vcs opts]);
160              
161             Create a new sticky version label for the all of the archive
162             members of the project (optionally with :). Use opts
163             for additonal params.
164              
165             =item B
166              
167             $Project->deleteVersionLabel($label,[vcs opts]);
168              
169             Delete a version label from all of the archive members of the project.
170              
171             =item B
172              
173             $Project->replaceVersionLabel($newlabel,$oldlabel,[vcs opts]);
174              
175             Rename a version label in all of the archive members of the project.
176              
177             =item B
178              
179             $Project->addFloatingVersionLabel($label,[vcs opts]);
180              
181             Create a floating version label for all of the archive members
182             of the project.
183              
184             =item B
185              
186             $Project->transformVersionLabel($label,[vcs opts])';
187              
188             Transform a specified version label to a floating version label
189             for all of the archive members of the project.
190              
191             =item B
192              
193             $Project->deletePromoGroup($group,[vcs opts]);
194              
195             Delete the promotion group from the archive for all archive
196             members in the project.
197              
198             =item B
199              
200             $Project->deletePromoGroup($group:$rev,[vcs opts])';
201              
202             Add the archive, or promote it to, the named promotion group,
203             for all of the archive members in the project.
204              
205             Create a new archive
206              
207             =item B
208              
209             $Project->vcs([opts][files]);
210              
211             Run vcs in the project's WD, with opts.
212              
213             =item B
214              
215             $Project->getAttributes(@_);
216              
217             Populates and returns the archive object associated with the archive
218             for all archives in the project.
219              
220             This object is blessed into the VCS::PVCS::Attributes class.
221              
222             =back
223              
224             =head1 AUTHOR
225              
226             Bill Middleton, wjm@metronet.com
227              
228             =head1 COPYRIGHT
229              
230             The PVCS module is Copyright (c) 1998 Bill Middleton.
231             All rights reserved.
232              
233             You may distribute under the terms of either the GNU General Public
234             License or the Artistic License, as specified in the Perl README file.
235              
236             =head1 SUPPORT / WARRANTY
237              
238             The VCS::PVCS modules are free software.
239              
240             B
241              
242             Commercial support agreements for Perl can be arranged via
243             The Perl Clinic. See http://www.perl.co.uk/tpc for more details.
244              
245             =head1 SEE ALSO
246              
247             perl(1).
248              
249             =cut
250              
251             package VCS::PVCS::Project;
252 3     3   21759 use strict;
  3         12  
  3         181  
253 3     3   16 no strict qw(refs);
  3         7  
  3         103  
254 3     3   16 use vars qw($VERSION @ISA @EXPORT);
  3         5  
  3         306  
255 3     3   17 use Carp;
  3         5  
  3         420  
256 3     3   15 use Cwd;
  3         6  
  3         252  
257 3     3   1700 use VCS::PVCS;
  0            
  0            
258             require VCS::PVCS::Folder;
259             require Exporter;
260             @ISA = qw(VCS::PVCS::Folder);
261             $VERSION = "0.01";
262             @EXPORT = ("\$PVCSSHOWMODE","\$PVCSERR","\$PVCSOUTPUT","\$PVCSDEBUG");
263              
264             ################################################
265             ## Constructor
266             ##
267              
268             sub new {
269             my $type = shift;
270             my($self);
271             my $class = ref($type) || $type || "VCS::PVCS::Project";
272             (@_ >= 1) or croak "usage: new $class [PROJECTNAME]";
273             my($name) = shift;
274             my($args) = shift;
275             my $config = ($class =~ /^VCS::PVCS$/) ? $type : VCS::PVCS::new();
276            
277             if(defined($config->{'projects'}->{$name})){
278             $self = openProject($config,$name,$args)
279             or return undef;
280             }
281             else{
282             warn "Project $_[0] does not exist, attempting to create" if
283             $PVCSDEBUG;
284             $self = createProject($config,$name)
285             or return undef;
286             }
287             $self->{'DIR'} = $config->{'projects'}->{$name}->{'DIR'};
288             $self->{'CFG'} = $config->{'projects'}->{$name}->{'CFG'};
289             $self->{'WKDIR'} = $config->{'projects'}->{$name}->{'WKDIR'};
290             $self->{'NAME'} = $config->{'projects'}->{$name}->{'NAME'};
291             $self->{'config'} = $config; # Master.cfg info
292             readProjectConfigFile($self);
293             # circular? Probably need a DESTROY...
294             $self->{'currentProject'} = $config->{'projects'}->{$name};
295             bless($self->{'currentProject'},"VCS::PVCS::Project");
296             ($^O ne "MSWin32") ?
297             translatePath2Unix(\$self->{'currentProject'}->{'CFG'}):
298             translatePath2Win(\$self->{'currentProject'}->{'CFG'});
299             $PVCSCURRPROJCFG = $self->{'currentProject'}->{'CFG'};
300            
301             bless($self,$class);
302             }
303              
304             sub readProjectConfigFile{
305             my($self) = shift;
306             my($key,$value);
307             my($tmpcfg);
308             # Eventually, this'll be replaced with API call
309             # Right now the only thing we're interested in is VCSDIR,
310             # since the command line tools will read them for themselves.
311             $tmpcfg = $self->{'CFG'};
312             (($^O ne "MSWin32") and $PVCSMULTIPLATFORM) and
313             translatePath2Unix(\$tmpcfg);
314             (croak "Cant find your Project Config file, $tmpcfg")
315             unless (-e "$tmpcfg");
316             open(MASTER, "$tmpcfg") ||
317             croak "cant open $tmpcfg\n";
318             while(){
319             chop;chop; # icky but ok
320             ($key,$value) = split(/\s+[= ]+\s*/,$_);
321             next unless ($key =~ s/.*(VCSDIR).*/$1/);
322             $self->{'VCSDIR'} = $value;
323             $value =~s/^\s*\"//;
324             $value =~s/\"\s*$//;
325             @{$self->{'VCSDIRS'}} = split(/\"\;\"/,$value);
326             last;
327             }
328             }
329              
330             sub DESTROY{
331             my($self) = shift;
332             my($tmpcfg);
333             my($key,$value,$dir,$found);
334             my(@tmp,@new);
335             $tmpcfg = $self->{'CFG'};
336             return unless defined($self->{'NEWVCSDIRS'}); # Nothing to do
337             return if $VCS::PVCS::PVCSDONTSAVE;
338             (($^O ne "MSWin32") and $PVCSMULTIPLATFORM) and
339             translatePath2Unix(\$tmpcfg);
340             (croak "Cant find your Project Config file, $tmpcfg")
341             unless (-e "$tmpcfg");
342             open(MASTER, "$tmpcfg") ||
343             (warn "cant open $tmpcfg\n" && return);
344             open(NEWCFG,">$PVCSPROJ/$$.NEW") ||
345             croak "Could not open tmpfile\n";
346             while(){
347             if(/^\s*VCSDIR/){
348             ($key,$value) = split(/\s+[= ]+\s*/,$_);
349             if($value ne $self->{'VCSDIR'}){ # Something has changed
350             $value =~s/^\s*\"//;
351             $value =~s/\"\s*$//;
352             @{$self->{'VCSDIRS'}}= split(/\"\;\"/,$value);
353             }
354             foreach $dir (@{$self->{'NEWVCSDIRS'}}){
355             push(@{$self->{'VCSDIRS'}},$dir);
356             }
357             my($newvcs) = 'VCSDIR = "'.join('";"',@{$self->{'VCSDIRS'}}).'"'."\n";
358             print NEWCFG $newvcs;
359             $found = 1;
360             }
361             else{
362             print NEWCFG $_;
363             }
364             }
365             if(!$found){ # New project has no VCSDIRS yet
366             my($newvcs) = 'VCSDIR = "'.join('";"',@{$self->{'NEWVCSDIRS'}}).'"'."\n";
367             print NEWCFG $newvcs;
368             }
369             close MASTER;
370             close NEWCFG;
371             rename("$tmpcfg","$tmpcfg.old");
372             rename("$PVCSPROJ/$$.NEW","$tmpcfg");
373              
374             (warn "Saved your new configuration file $tmpcfg, and renamed your old configuration file $tmpcfg to $tmpcfg.old\n") if $PVCSDEBUG;
375              
376             }
377              
378              
379              
380             sub newArchive {
381             my $type = shift;
382             my $class = ref($type);
383             my($newarchive,$folder);
384             my($fullapath,$fullwpath,$a,$b,$c,$d);
385              
386             ($class =~ /VCS::PVCS::Project/) or
387             croak "Must pass project ref to newArchive\n";
388              
389             (@_ >= 2) or croak 'usage: $Project->newArchive(workfile, archivedir,
390             [workingdir], [checkincomment], [workfilecomment]';
391              
392             my($workfile,$archdir,$workingdir,$cicomment,$workcomment) = @_;
393              
394             if(! $workingdir){
395             $workingdir = (-d $type->{'WKDIR'}) ? $type->{'WKDIR'} : "./";
396             }
397             if((! defined($cicomment)) || (! length($cicomment))){
398             $cicomment = "Checked in from Perl VCS::PVCS module";
399             }
400             if((! defined($workcomment)) || (! length($workcomment))){
401             $workcomment = "Checked in from Perl VCS::PVCS module";
402             }
403              
404             ($^O ne "MSWin32") ?
405             translatePath2Unix(\$archdir):
406             translatePath2Win(\$archdir);
407              
408             ($^O ne "MSWin32") ?
409             translatePath2Unix(\$workingdir):
410             translatePath2Win(\$workingdir);
411              
412              
413             $newarchive = VCS::PVCS::Archive::new( $workfile,$archdir,$workingdir,$cicomment,$workcomment);
414              
415             if($newarchive and (! $PVCSSHOWMODE)){
416             $folder = $PVCSPROJ."/".$type->{'DIR'}."/pvcsfold.pub";
417             ($fullapath = $newarchive->archive()) =~ m/(.*)[\\\/](.*)/;
418             ($a,$b) = ($1,$2);
419             ($fullwpath = $newarchive->{'workfiles'}->{'MASTER'}) =~ m/(.*)[\\\/](.*)/;
420             ($c,$d) = ($1,$2);
421             open(PROJECT,">>$folder") ||
422             croak "Cant open pvcsfold.pub for new archive\n";
423             print PROJECT "[DOCUMENT=$a;$b;$c;$d]\n";
424             close PROJECT;
425             $type->{'documents'}->{$fullapath}= $newarchive;
426             # Add the new archive to the Config file on DESTROY, if it's not there already
427             if((! grep('$a',@{$type->{'VCSDIRS'}})) &&
428             (! grep('$a',@{$type->{'NEWVCSDIRS'}})) ){
429             push(@{$type->{'NEWVCSDIRS'}},$a);
430             }
431             return ("[DOCUMENT=$a;$b;$c;$d]\n",$newarchive);
432             }
433             return undef;
434             }
435             ###############################################################################
436             sub openProject{ # opens an existing project
437             ###############################################################################
438             my($self) = shift;
439             my($projname) = shift;
440             my $project = {};
441             my($newfolder,$folder);
442             my($nextline);
443             my($archdir,$archfile,$workdir,$workfile,$tmp);
444              
445             croak "No such project: $projname" unless
446             (defined($self->{'projects'}->{$projname}));
447              
448             $folder = $PVCSPROJ."/".$self->{'projects'}->{$projname}->{'DIR'};
449              
450             croak "No pvcsfold.pub in $folder for $projname" unless
451             (-e "$folder/pvcsfold.pub");
452              
453             open(MASTER,"<$folder/pvcsfold.pub") or
454             (croak "Cant open $folder/pvcsfold.pub\n");
455              
456             while (){
457             chomp;
458             if(/^\[FOLDER=(.*)\]/){
459             $newfolder = $1;
460             for(1 .. 2){
461             chomp($nextline = );
462             if($nextline =~ m/^(DIR|WKDIR)=([^\015]*)/){
463             $project->{'folders'}->{$newfolder}->{$1} = $2;
464             }
465             }
466             $project->{'folders'}->{$newfolder}->{'NAME'} = $newfolder;
467            
468             }
469             elsif(/^\[DOCUMENT=(.*)\]/){
470             $tmp = $1;
471             ($archdir,$archfile,$workdir,$workfile) = split(/;/,$1);
472             $project->{'documents'}->{"$archdir\\$archfile"} = {};
473             bless($project->{'documents'}->{"$archdir\\$archfile"},"VCS::PVCS::Archive");
474             $project->{'documents'}->{"$archdir\\$archfile"}->{'workfiles'}->{'MASTER'} = "$workdir/$workfile";
475             if($VCS::PVCS::USESQL){
476             # Insert SQL lookup for archiveID here
477             }
478             $project->{'documents'}->{"$archdir\\$archfile"}->{'arpath'} = "$archdir\\$archfile";
479             }
480             }
481             $project;
482             }
483              
484             sub createProject{
485             my($self) = shift;
486             my($projname) = shift;
487             my $project = {};
488             my($folder,$shortname,$tmp);
489             my($args) = shift;
490              
491             (ref($args)) or ($args = {});
492              
493             $shortname = _name2Eight($self,$projname);
494             $folder = "$PVCSPROJ/$shortname.prj";
495              
496             # Create project folder
497             unless($PVCSSHOWMODE){
498             croak "cant create $folder for $projname" unless
499             (mkdir("$folder",0755));
500              
501             # Create project master pvcsfold.pub
502             croak "cant open $folder/pvcsfold.pub for $projname" unless
503             open(PVCSFOLD,">$folder/pvcsfold.pub");
504             print PVCSFOLD "[FORMAT=PVCS_GUI]\nVersion=5.2\n";
505             close(PVCSFOLD);
506              
507             # Create project project.cfg
508             croak "cant open $PVCSPROJ/$shortname.cfg for $projname" unless
509             open(PVCSFOLD,">>$PVCSPROJ/$shortname.cfg");
510             print PVCSFOLD "# VERSION PVCS VM_5.3.00\n";
511             close(PVCSFOLD);
512              
513             # Create project config file and set up the config object
514             croak "cant open $PVCSPROJ/pvcsproj.pub for $projname" unless
515             open(PVCSFOLD,">>$PVCSPROJ/pvcsproj.pub");
516              
517             print PVCSFOLD "\n[Project=$projname]\n";
518             }
519             $self->{'projects'}->{$projname}->{'NAME'} = $projname;
520             $tmp = $PVCSPROJ."/$shortname.cfg";
521              
522             ($PVCSMULTIPLATFORM) && translatePath2Win(\$tmp);
523              
524             $self->{'projects'}->{$projname}->{'CFG'} = $tmp;
525              
526             unless($PVCSSHOWMODE){
527             print PVCSFOLD "CFG=$tmp\n";
528             print PVCSFOLD "DIR=$shortname.prj\n";
529             }
530             $self->{'projects'}->{$projname}->{'DIR'} = "$shortname.prj";
531              
532             unless($PVCSSHOWMODE){
533             if(defined($args->{'ARDIR'})){
534             print PVCSFOLD "ARDIR=".$args->{'ARDIR'}."\n";
535             }
536             else{
537             print PVCSFOLD "ARDIR=\n";
538             }
539             }
540             $self->{'projects'}->{$projname}->{'ARDIR'} = $args->{'ARDIR'};
541              
542             unless($PVCSSHOWMODE){
543             if($args->{'WKDIR'}){
544             $tmp = $args->{'WKDIR'};
545             }else{
546             $tmp = $PVCSPROJ."/PVCSWORK";
547             }
548             ($PVCSMULTIPLATFORM) && translatePath2Win(\$tmp);
549             print PVCSFOLD "WKDIR=$tmp\n";
550             }
551              
552             $self->{'projects'}->{$projname}->{'WKDIR'} = $tmp;
553              
554             unless($PVCSSHOWMODE){
555             close(PVCSFOLD);
556             }
557              
558             if($PVCSSHOWMODE){
559             print "Would have created Project: $shortname.prj\n";
560             }
561             return $project;
562              
563             }
564              
565             sub copyProject{
566             croak "Sorry, not copying projects in this release\n";
567             }
568              
569             sub deleteProject{
570             croak "Sorry, not deleting projects in this release\n";
571             }
572              
573             sub lockProject{
574             croak "Sorry, not locking projects in this release\n";
575             }
576              
577             sub _name2Eight{
578             my($type,$name) = @_;
579             my($nomatch) = 1;
580              
581             if(length($name) > 8){
582             $name = substr($name,0,8);
583             }
584             while($nomatch){
585             if(-e "$PVCSPROJ/$name.cfg"){
586             $name++;
587             next;
588             }
589             $nomatch=0;
590             }
591             $name;
592             }
593              
594             sub Members{
595             members(@_);
596             }
597              
598             sub members{
599             @_ >= 1 or croak 'usage: $Project->members("regexp")';
600             my($type) = shift;
601             my($class) = ref($type);
602             my($match) = shift;
603             my($retval) = [];
604             my($member);
605              
606             if($class eq "VCS::PVCS::Project"){
607             if($match){
608             foreach $member (values %{$type->{'documents'}}){
609             if( grep(/$match/, (values %{$member->{'workfiles'}})) ){
610             push(@{$retval},$member);
611             }
612             }
613             return (wantarray) ? @{$retval} : $retval;
614             }
615             else{
616             return (wantarray) ? @{$type->{'documents'}} : $type->{'documents'};
617             }
618             }
619              
620             }
621              
622              
623             sub getAttributes{
624             @_ >= 1 or croak 'usage: $Project->getAttributes([vcs opts])';
625             my($type) = shift;
626             my($class) = ref($type);
627             my($member,$error);
628             my($curdir) = cwd();
629             $error=1;
630             if($class eq "VCS::PVCS::Project"){
631             $PVCSOUTPUT = "";
632             foreach $member (values %{$type->{'documents'}}){
633             unless($member->getAttributes(@_)){
634             (warn "getAttributes error: $PVCSCURROUTPUT") if $PVCSDEBUG;
635             $error=0;
636             }
637             }
638             }
639             else{
640             croak "Must invoke Folder::getAttributes passing folder object";
641             }
642             $error;
643             }
644              
645              
646             ##############################################################################
647             # Project Checkout methods
648             ##############################################################################
649             sub get{
650             @_ >= 1 or croak 'usage: $Project->get([$label|$version],[vcs opts])';
651             my($type) = shift;
652             my($class) = ref($type);
653             my($document,$error);
654             $error=1;
655             if($class eq "VCS::PVCS::Project"){
656             $PVCSOUTPUT = "";
657             foreach $document (values %{$type->{'documents'}}){
658             unless($document->get(@_)){
659             (warn "GET error: $PVCSCURROUTPUT") if $PVCSDEBUG;
660             $error = 0;
661             }
662             }
663             }
664             else{
665             croak 'Must pass Project object to VCS::PVS::Project::get()';
666             }
667             $error
668             }
669              
670             sub checkout{
671             get(@_);
672             }
673              
674             sub co{
675             get(@_);
676             }
677              
678             ##############################################################################
679             # Checkin methods
680             ##############################################################################
681              
682             sub put{
683             @_ >= 1 or croak 'usage: $Project->vlog([vlog opts])';
684             my($type) = shift;
685             my($class) = ref($type);
686             my($document,$error);
687             $error=1;
688             if($class eq "VCS::PVCS::Project"){
689             $PVCSOUTPUT = "";
690             foreach $document (values %{$type->{'documents'}}){
691             unless($document->put(@_)){
692             (warn "PUT error: $PVCSCURROUTPUT") if $PVCSDEBUG;
693             $error=0;
694             }
695             }
696             }
697             else{
698             croak 'Must pass Project object to VCS::PVS::Project::put()';
699             }
700             $error;
701             }
702              
703             sub checkin{
704             put(@_);
705             }
706              
707             sub ci{
708             put(@_);
709             }
710              
711              
712             ##############################################################################
713             # history methods
714             ##############################################################################
715             sub vlog{
716             @_ >= 1 or croak 'usage: $Project->vlog([vlog opts])';
717             my($type) = shift;
718             my($class) = ref($type);
719             my($document,$error);
720             $error=1;
721             if($class eq "VCS::PVCS::Project"){
722             $PVCSOUTPUT = "";
723             foreach $document (values %{$type->{'documents'}}){
724             unless($document->vlog(@_)){
725             (warn "VLOG error: $PVCSCURROUTPUT") if $PVCSDEBUG;
726             $error=0;
727             }
728             }
729             }
730             else{
731             croak 'Must pass Project object to VCS::PVS::Project::vlog()';
732             }
733             $error;
734             }
735              
736             sub log{
737             vlog(@_);
738             }
739              
740             sub history{
741             vlog(@_);
742             }
743              
744             ######################################################################
745             # locking methods
746             ######################################################################
747              
748             sub lock{
749             @_ >= 1 or croak 'usage: $Project->lock([$label|$version],[vcs opts])';
750             my($type) = shift;
751             my($class) = ref($type);
752             my($tmptype) = $VCS::PVCS::Commands::vcsopts->{'L'};
753             my($version) = shift;
754              
755             $VCS::PVCS::Commands::vcsopts->{'L'} = ($version) ? $version : 1;
756             vcs($type,@_);
757             $VCS::PVCS::Commands::vcsopts->{'L'} = $tmptype;
758              
759             }
760              
761             sub unlock{
762              
763             @_ >= 1 or croak 'usage: $Project->unlock($label|$version,[vcs opts])';
764             my($type) = shift;
765             my($tmptype) = $VCS::PVCS::Commands::vcsopts->{'U'};
766             my($version) = shift;
767              
768             $VCS::PVCS::Commands::vcsopts->{'U'} = ($version) ? $version : 1;
769             vcs($type,@_);
770             $VCS::PVCS::Commands::vcsopts->{'U'} = $tmptype;
771              
772             }
773              
774             ######################################################################
775             # Project Version label methods
776             ######################################################################
777              
778             sub addVersionLabel{
779             @_ >= 2 or croak 'usage: $Project->addVersionLabel($label,[vcs opts])';
780             my($type) = shift;
781             my($label) = shift;
782             vcs($type,@_,"-V$label");
783             }
784              
785             sub deleteVersionLabel{
786             @_ >= 2 or croak 'usage: $Project->deleteVersionLabel($label,[vcs opts])';
787             my($type) = shift;
788             my($label) = shift;
789              
790             ($label .= ":delete") unless ($label =~ /:delete$/);
791             vcs($type,@_,"-V$label");
792             }
793              
794             sub replaceVersionLabel{
795             @_ >= 3 or
796             croak 'usage: $Project->replaceVersionLabel($newlabel,$oldlabel,[vcs opts])';
797             my($type) = shift;
798             my($newlabel) = shift;
799             my($oldlabel) = shift;
800              
801             vcs($type,@_,"-V$newlabel\:\:$oldlabel");
802             }
803              
804             sub addFloatingVersionLabel{
805             @_ >= 2 or croak 'usage: $Project->addFloatingVersionLabel($label,[vcs opts])';
806             my($type) = shift;
807             my($label) = shift;
808              
809             ($label .= ":\\*") unless ($label =~ /:\*$/);
810             vcs($type,@_,"-V$label");
811             }
812              
813             sub transformVersionLabel{
814             @_ >= 2 or croak 'usage: $Project->transformVersionLabel($label,[vcs opts])';
815             my($type) = shift;
816             my($label) = shift;
817              
818             ($label .= ":\\*") unless ($label =~ /:\*$/);
819             vcs($type,@_,"-V$label","-Y");
820             }
821              
822              
823             ######################################################################
824             # Promotion group methods
825             ######################################################################
826              
827             sub deletePromoGroup{
828             @_ >= 2 or croak 'usage: $Project->deletePromoGroup($group,[vcs opts])';
829             my($type) = shift;
830             my($label) = shift;
831              
832             ($label .= ":delete") unless ($label =~ /:delete$/);
833             vcs($type,@_,"-G$label");
834             }
835              
836             sub addPromoGroup{
837             @_ >= 2 or croak 'usage: $Project->deletePromoGroup($group:$rev,[vcs opts])';
838             my($type) = shift;
839             my($label) = shift;
840              
841             vcs($type,@_,"-G$label");
842             }
843              
844             sub createArchive{
845             @_ >= 1 or croak 'usage: createArchive($archive,[vcs opts])';
846             my($type) = shift;
847             my($class) = ref($type);
848              
849             vcs($type,@_,"-I");
850             }
851              
852             ##########################################################################
853             # The Project VCS utility command
854             ##########################################################################
855             sub vcs{
856             @_ >= 1 or croak 'usage: $Project->vcs([opts][files])';
857             my($type) = shift;
858             my($class) = ref($type);
859             my($document,$error);
860             $error=1;
861             if($class eq "VCS::PVCS::Project"){
862             $PVCSOUTPUT = "";
863             foreach $document (values %{$type->{'documents'}}){
864             unless($document->vcs(@_)){
865             (warn "VCS error: $PVCSCURROUTPUT") if $PVCSDEBUG;
866             $error = 0;
867             }
868             }
869             }
870             else{
871             croak 'Must pass Project object to VCS::PVS::Project::vcs()';
872             }
873             $error;
874             }
875              
876              
877             1;
878              
879             __END__