File Coverage

lib/Clearcase/Vob.pm
Criterion Covered Total %
statement 48 238 20.1
branch 24 130 18.4
condition 2 15 13.3
subroutine 13 50 26.0
pod 44 47 93.6
total 131 480 27.2


line stmt bran cond sub pod time code
1              
2             =pod
3              
4             =head1 NAME Vob.pm
5              
6             Object oriented interface to a Clearcase VOB
7              
8             =head1 VERSION
9              
10             =over
11              
12             =item Author
13              
14             Andrew DeFaria
15              
16             =item Revision
17              
18             $Revision: 1.15 $
19              
20             =item Created
21              
22             Thu Dec 29 12:07:59 PST 2005
23              
24             =item Modified
25              
26             $Date: 2011/11/16 19:46:13 $
27              
28             =back
29              
30             =head1 SYNOPSIS
31              
32             Provides access to information about a Clearcase VOB. Note that information
33             about the number of elements, branches, etc. that is provided by countdb are not
34             initially instantiated with the VOB object, rather those member variables are
35             expanded if and when accessed. This helps the VOB object to be more efficient.
36              
37             # Create VOB object
38             my $vob = new Clearcase::Vob (tag => "/vobs/test");
39              
40             # Access member variables...
41             print "Tag:\t\t" . $vob->tag . "\n";
42             print "Global path:\t" . $vob->gpath . "\n";
43             print "Sever host:\t" . $vob->shost . "\n";
44             print "Access:\t\t" . $vob->access . "\n";
45             print "Mount options:\t" . $vob->mopts . "\n";
46             print "Region:\t\t" . $vob->region . "\n";
47             print "Active:\t\t" . $vob->active . "\n";
48             print "Replica UUID:\t" . $vob->replica_uuid . "\n";
49             print "Host:\t\t" . $vob->host . "\n";
50             print "Access path:\t" . $vob->access_path . "\n";
51             print "Family UUID:\t" . $vob->family_uuid . "\n";
52              
53             # This members are not initially expanded until accessed
54             print "Elements:\t" . $vob->elements . "\n";
55             print "Branches:\t" . $vob->branches . "\n";
56             print "Versions:\t" . $vob->versions . "\n";
57             print "DB Size:\t" . $vob->dbsize . "\n";
58             print "Adm Size:\t" . $vob->admsize . "\n";
59             print "CT Size:\t" . $vob->ctsize . "\n";
60             print "DO Size:\t" . $vob->dosize . "\n";
61             print "Src Size:\t" . $vob->srcsize . "\n";
62             print "Size:\t\t" . $vob->size . "\n";
63              
64             # VOB manipulation
65             print "Umounting " . $vob->tag . "...\n";
66              
67             $vob->umount;
68              
69             print "Mounting " . $vob->tag . "...\n";
70              
71             $vob->mount;
72              
73             =head2 DESCRIPTION
74              
75             This module, and others below the Clearcase directory, implement an object
76             oriented approach to Clearcase. In general Clearcase entities are made into
77             objects that can be manipulated easily in Perl. This module is the main or
78             global module. Contained herein are members and methods of a general or global
79             nature. Also contained here is an IPC interface to cleartool such that cleartool
80             runs in the background andcommands are fed to it via the exec method. When
81             making repeated calls to cleartool this can result in a substantial savings of
82             time as most operating systems' fork/exec sequence is time consuming. Factors of
83             8 fold improvement have been measured.
84              
85             Additionally a global variable, $cc, is implemented from this module such that
86             you should not need to instantiate another one, though you could.
87              
88             =head2 ROUTINES
89              
90             The following routines are exported:
91              
92             =cut
93              
94             package Clearcase::Vob;
95              
96 2     2   2865 use strict;
  2         8  
  2         100  
97 2     2   9 use warnings;
  2         4  
  2         167  
98              
99 2     2   14 use Clearcase;
  2         10  
  2         9642  
100              
101             sub new($;$) {
102 2     2 1 2359 my ($class, $tag, $region) = @_;
103              
104             =pod
105              
106             =head2 new (tag)
107              
108             Construct a new Clearcase VOB object. Note that not all members are
109             initially populated because doing so would be time consuming. Such
110             member variables will be expanded when accessed.
111              
112             Parameters:
113              
114             =for html
115              
116             =over
117              
118             =item tag
119              
120             VOB tag to be instantiated. You can use either an object oriented call
121             (i.e. my $vob = new Clearcase::Vob (tag => "/vobs/test")) or the
122             normal call (i.e. my $vob = new Clearcase::Vob ("/vobs/test")). You
123             can also instantiate a new vob by supplying a tag and then later
124             calling the create method.
125              
126             =back
127              
128             =for html
129              
130             Returns:
131              
132             =for html
133              
134             =over
135              
136             =item Clearcase VOB object
137              
138             =back
139              
140             =for html
141              
142             =cut
143              
144 2   33     41 $region ||= $Clearcase::CC->region;
145              
146 2         9 $class = bless {
147             tag => $tag,
148             region => $region,
149             }, $class;
150              
151 2         11 $class->updateVobInfo;
152              
153 2         6 return $class;
154             } # new
155              
156             sub tag() {
157 2     2 1 495 my ($self) = @_;
158              
159             =pod
160              
161             =head2 tag
162              
163             Returns the VOB tag
164              
165             Parameters:
166              
167             =for html
168              
169             =over
170              
171             =item none
172              
173             =back
174              
175             =for html
176              
177             Returns:
178              
179             =for html
180              
181             =over
182              
183             =item VOB's tag
184              
185             =back
186              
187             =for html
188              
189             =cut
190              
191 2         10 return $self->{tag};
192             } # tag
193              
194             sub gpath() {
195 1     1 1 3 my ($self) = @_;
196              
197             =pod
198              
199             =head2 gpath
200              
201             Returns the VOB global path
202              
203             Parameters:
204              
205             =for html
206              
207             =over
208              
209             =item none
210              
211             =back
212              
213             =for html
214              
215             Returns:
216              
217             =for html
218              
219             =over
220              
221             =item VOB's gpath
222              
223             =back
224              
225             =for html
226              
227             =cut
228              
229 1         8 return $self->{gpath};
230             } # gpath
231              
232             sub shost() {
233 0     0 1 0 my ($self) = @_;
234              
235             =pod
236              
237             =head2 shost
238              
239             Returns the VOB server host
240              
241             Parameters:
242              
243             =for html
244              
245             =over
246              
247             =item none
248              
249             =back
250              
251             =for html
252              
253             Returns:
254              
255             =for html
256              
257             =over
258              
259             =item VOB's server host
260              
261             =back
262              
263             =for html
264              
265             =cut
266              
267 0         0 return $self->{shost};
268             } # shost
269              
270             # Alias name to tag
271             sub name() {
272 0     0 1 0 goto &tag;
273             } # name
274              
275             sub access() {
276 0     0 1 0 my ($self) = @_;
277              
278             =pod
279              
280             =head2 access
281              
282             Returns the type of VOB access
283              
284             Parameters:
285              
286             =for html
287              
288             =over
289              
290             =item none
291              
292             =back
293              
294             =for html
295              
296             Returns:
297              
298             =for html
299              
300             =over
301              
302             =item access
303              
304             Returns either public for public VOBs or private for private VOBs
305              
306             =back
307              
308             =for html
309              
310             =cut
311              
312 0         0 return $self->{access};
313             } # access
314              
315             sub mopts() {
316 0     0 1 0 my ($self) = @_;
317              
318             =pod
319              
320             =head2 mopts
321              
322             Returns the mount options
323              
324             Parameters:
325              
326             =for html
327              
328             =over
329              
330             =item none
331              
332             =back
333              
334             =for html
335              
336             Returns:
337              
338             =for html
339              
340             =over
341              
342             =item VOB's mount options
343              
344             =back
345              
346             =for html
347              
348             =cut
349              
350 0         0 return $self->{mopts};
351             } # mopts
352              
353             sub region() {
354 1     1 1 3 my ($self) = @_;
355              
356             =pod
357              
358             =head3 region
359              
360             Returns the region for this VOB tag
361              
362             Parameters:
363              
364             =for html
365              
366             =over
367              
368             =item none
369              
370             =back
371              
372             =for html
373              
374             Returns:
375              
376             =for html
377              
378             =over
379              
380             =item region
381              
382             =back
383              
384             =for html
385              
386             =cut
387              
388 1         5 return $self->{region};
389             } # region
390              
391             sub active() {
392 0     0 1 0 my ($self) = @_;
393              
394             =pod
395              
396             =head2 active
397              
398             Returns that active status (whether or not the vob is currently mounted) of the
399             VOB
400              
401             Parameters:
402              
403             =for html
404              
405             =over
406              
407             =item none
408              
409             =back
410              
411             =for html
412              
413             Returns:
414              
415             =for html
416              
417             =over
418              
419             =item Returns YES for an active VOB or NO for an inactive one
420              
421             =back
422              
423             =for html
424              
425             =cut
426              
427 0         0 return $self->{active};
428             } # active
429              
430             sub replica_uuid() {
431 0     0 1 0 my ($self) = @_;
432              
433             =pod
434              
435             =head2 replica_uuid
436              
437             Returns the VOB replica_uuid
438              
439             Parameters:
440              
441             =for html
442              
443             =over
444              
445             =item none
446              
447             =back
448              
449             =for html
450              
451             Returns:
452              
453             =for html
454              
455             =over
456              
457             =item VOB replica_uuid
458              
459             =back
460              
461             =for html
462              
463             =cut
464              
465 0         0 return $self->{replica_uuid};
466             } # replica_uuid
467              
468             sub host() {
469 0     0 1 0 my ($self) = @_;
470              
471             =pod
472              
473             =head2 host
474              
475             Returns the VOB host
476              
477             Parameters:
478              
479             =for html
480              
481             =over
482              
483             =item none
484              
485             =back
486              
487             =for html
488              
489             Returns:
490              
491             =for html
492              
493             =over
494              
495             =item VOB's host
496              
497             =back
498              
499             =for html
500              
501             =cut
502              
503 0         0 return $self->{host};
504             } # host
505              
506             sub access_path() {
507 0     0 1 0 my ($self) = @_;
508              
509             =pod
510              
511             =head2 access_path
512              
513             Returns the VOB access path
514              
515             Parameters:
516              
517             =for html
518              
519             =over
520              
521             =item none
522              
523             =back
524              
525             =for html
526              
527             Returns:
528              
529             =for html
530              
531             =over
532              
533             =item VOB access path
534              
535             This is the path relative to the VOB's host
536              
537             =back
538              
539             =for html
540              
541             =cut
542              
543 0         0 return $self->{access_path};
544             } # access_path
545              
546             sub family_uuid() {
547 0     0 1 0 my ($self) = @_;
548              
549             =pod
550              
551             =head2 family_uuid
552              
553             Returns the VOB family UUID
554              
555             Parameters:
556              
557             =for html
558              
559             =over
560              
561             =item none
562              
563             =back
564              
565             =for html
566              
567             Returns:
568              
569             =for html
570              
571             =over
572              
573             =item VOB family UUID
574              
575             =back
576              
577             =for html
578              
579             =cut
580              
581 0         0 return $self->{family_uuid};
582             } # family_uuid
583              
584             sub vob_registry_attributes() {
585 0     0 1 0 my ($self) = @_;
586              
587             =pod
588              
589             =head2 vob_registry_attributes
590              
591             Returns the VOB Registry Attributes
592              
593             Parameters:
594              
595             =for html
596              
597             =over
598              
599             =item none
600              
601             =back
602              
603             =for html
604              
605             Returns:
606              
607             =for html
608              
609             =over
610              
611             =item VOB Registry Attributes
612              
613             =back
614              
615             =for html
616              
617             =cut
618              
619 0         0 return $self->{vob_registry_attributes};
620             } # vob_registry_attributes
621              
622             sub expand_space() {
623 0     0 0 0 my ($self) = @_;
624              
625 0         0 my ($status, @output) = $Clearcase::CC->execute ("space -vob $self->{tag}");
626              
627             # Initialize fields in case of command failure
628 0         0 $self->{dbsize} = 0;
629 0         0 $self->{admsize} = 0;
630 0         0 $self->{ctsize} = 0;
631 0         0 $self->{dosize} = 0;
632 0         0 $self->{srcsize} = 0;
633 0         0 $self->{size} = 0;
634              
635 0         0 for (@output) {
636 0 0       0 if (/(\d*\.\d).*VOB database.*/) {
    0          
    0          
    0          
    0          
    0          
637 0         0 $self->{dbsize} = $1;
638             } elsif (/(\d*\.\d).*administration data.*/) {
639 0         0 $self->{admsize} = $1;
640             } elsif (/(\d*\.\d).*cleartext pool.*/) {
641 0         0 $self->{ctsize} = $1;
642             } elsif (/(\d*\.\d).*derived object pool.*/) {
643 0         0 $self->{dosize} = $1;
644             } elsif (/(\d*\.\d).*source pool.*/) {
645 0         0 $self->{srcsize} = $1;
646             } elsif (/(\d*\.\d).*Subtotal.*/) {
647 0         0 $self->{size} = $1;
648             } # if
649             } # for
650              
651 0         0 return;
652             } # expand_space
653              
654             sub expand_description() {
655 0     0 0 0 my ($self) = @_;
656              
657 0         0 my ($status, @output) =
658             $Clearcase::CC->execute ("describe -long vob:$self->{tag}");
659              
660 0         0 for (my $i = 0; $i < @output; $i++) {
661 0 0       0 if ($output[$i] =~ /created (\S+) by (.+) \((\S+)\)/) {
    0          
    0          
    0          
    0          
    0          
    0          
    0          
    0          
662 0         0 $self->{created} = $1;
663 0         0 $self->{ownername} = $2;
664 0         0 $self->{owner} = $3;
665             } elsif ($output[$i] =~ /^\s+\"(.+)\"/) {
666 0         0 $self->{comment} = $1;
667             } elsif ($output[$i] =~ /master replica: (.+)/) {
668 0         0 $self->{masterReplica} = $1;
669             } elsif ($output[$i] =~ /replica name: (.+)/) {
670 0         0 $self->{replicaName} = $1;
671             } elsif ($output[$i] =~ /VOB family featch level: (\d+)/) {
672 0         0 $self->{featureLevel} = $1;
673             } elsif ($output[$i] =~ /database schema version: (\d+)/) {
674 0         0 $self->{schemaVersion} = $1;
675             } elsif ($output[$i] =~ /modification by remote privileged user: (.+)/) {
676 0         0 $self->{remotePrivilege} = $1;
677             } elsif ($output[$i] =~ /atomic checkin: (.+)/) {
678 0         0 $self->{atomicCheckin} = $1;
679             } elsif ($output[$i] =~ /VOB ownership:/) {
680 0         0 while ($output[$i] !~ /Additional groups:/) {
681 0         0 $i++;
682              
683 0 0       0 if ($output[$i++] =~ /owner (.+)/) {
684 0         0 $self->{owner} = $1;
685             } # if
686              
687 0 0       0 if ($output[$i++] =~ /group (.+)/) {
688 0         0 $self->{group} = $1;
689             } # if
690             } # while
691              
692 0         0 my @groups;
693              
694 0         0 while ($output[$i] !~ /ACLs enabled/) {
695 0 0       0 if ($output[$i++] =~ /group (.+)/) {
696 0         0 push @groups, $1;
697             } # if
698             } # while
699              
700 0         0 $self->{groups} = \@groups;
701              
702 0 0       0 if ($output[$i++] =~ /ACLs enabled: (.+)/) {
703 0         0 $self->{aclsEnabled} = $1;
704             } # if
705              
706 0         0 my %attributes;
707              
708 0   0     0 while ($i < @output and $output[$i] !~ /Hyperlinks:/) {
709 0 0       0 if ($output[$i] !~ /Attributes:/) {
710 0         0 my ($key, $value) = split / = /, $output[$i];
711              
712             # Trim leading spaces
713 0         0 $key =~ s/^\s*(\S+)/$1/;
714              
715             # Remove unnecessary '"'s
716 0         0 $value =~ s/\"(.*)\"/$1/;
717              
718 0         0 $attributes{$key} = $value;
719             } # if
720              
721 0         0 $i++;
722             } # while
723              
724 0         0 $self->{attributes} = \%attributes;
725              
726 0         0 $i++;
727              
728 0         0 my %hyperlinks;
729              
730 0   0     0 while ($i < @output and $output[$i]) {
731 0         0 my ($key, $value) = split " -> ", $output[$i++];
732              
733             # Trim leading spaces
734 0         0 $key =~ s/^\s*(\S+)/$1/;
735              
736 0         0 $hyperlinks{$key} = $value;
737             } # while
738              
739 0         0 $self->{hyperlinks} = \%hyperlinks;
740             } # if
741             } # for
742              
743 0         0 return;
744             } # expand_space
745              
746             sub masterReplica() {
747              
748             =pod
749              
750             =head2 masterReplica
751              
752             Returns the VOB master replica
753              
754             Parameters:
755              
756             =for html
757              
758             =over
759              
760             =item none
761              
762             =back
763              
764             =for html
765              
766             Returns:
767              
768             =for html
769              
770             =over
771              
772             =item VOB master replica
773              
774             =back
775              
776             =for html
777              
778             =cut
779              
780 0     0 1 0 my ($self) = @_;
781              
782 0 0       0 $self->expand_description unless $self->{masterReplica};
783              
784 0         0 return $self->{masterReplica};
785             } # masterReplica
786              
787             sub created() {
788              
789             =pod
790              
791             =head2 created
792              
793             Returns the date the VOB was created
794              
795             Parameters:
796              
797             =for html
798              
799             =over
800              
801             =item none
802              
803             =back
804              
805             =for html
806              
807             Returns:
808              
809             =for html
810              
811             =over
812              
813             =item Date the VOB was created
814              
815             =back
816              
817             =for html
818              
819             =cut
820              
821 0     0 1 0 my ($self) = @_;
822              
823 0 0       0 $self->expand_description unless $self->{created};
824              
825 0         0 return $self->{created};
826             } # created
827              
828             sub ownername() {
829              
830             =pod
831              
832             =head2 ownername
833              
834             Returns the VOB ownername
835              
836             Parameters:
837              
838             =for html
839              
840             =over
841              
842             =item none
843              
844             =back
845              
846             =for html
847              
848             Returns:
849              
850             =for html
851              
852             =over
853              
854             =item VOB Owner Name
855              
856             =back
857              
858             =for html
859              
860             =cut
861              
862 0     0 1 0 my ($self) = @_;
863              
864 0 0       0 $self->expand_description unless $self->{ownername};
865              
866 0         0 return $self->{ownername};
867             } # ownername
868              
869             sub owner() {
870              
871             =pod
872              
873             =head2 owner
874              
875             Returns the VOB owner
876              
877             Parameters:
878              
879             =for html
880              
881             =over
882              
883             =item none
884              
885             =back
886              
887             =for html
888              
889             Returns:
890              
891             =for html
892              
893             =over
894              
895             =item VOB master replica
896              
897             =back
898              
899             =for html
900              
901             =cut
902              
903 0     0 1 0 my ($self) = @_;
904              
905 0 0       0 $self->expand_description unless $self->{owner};
906              
907 0         0 return $self->{owner};
908             } # owner
909              
910             sub comment() {
911              
912             =pod
913              
914             =head2 comment
915              
916             Returns the VOB comment
917              
918             Parameters:
919              
920             =for html
921              
922             =over
923              
924             =item none
925              
926             =back
927              
928             =for html
929              
930             Returns:
931              
932             =for html
933              
934             =over
935              
936             =item VOB comment
937              
938             =back
939              
940             =for html
941              
942             =cut
943              
944 0     0 1 0 my ($self) = @_;
945              
946 0 0       0 $self->expand_description unless $self->{comment};
947              
948 0         0 return $self->{comment};
949             } # comment
950              
951             sub replicaName() {
952              
953             =pod
954              
955             =head2 replicaName
956              
957             Returns the VOB replicaName
958              
959             Parameters:
960              
961             =for html
962              
963             =over
964              
965             =item none
966              
967             =back
968              
969             =for html
970              
971             Returns:
972              
973             =for html
974              
975             =over
976              
977             =item VOB replica name
978              
979             =back
980              
981             =for html
982              
983             =cut
984              
985 0     0 1 0 my ($self) = @_;
986              
987 0 0       0 $self->expand_description unless $self->{replicaName};
988              
989 0         0 return $self->{replicaName};
990             } # replicaName
991              
992             sub featureLevel() {
993              
994             =pod
995              
996             =head2 featureLevel
997              
998             Returns the VOB featureLevel
999              
1000             Parameters:
1001              
1002             =for html
1003              
1004             =over
1005              
1006             =item none
1007              
1008             =back
1009              
1010             =for html
1011              
1012             Returns:
1013              
1014             =for html
1015              
1016             =over
1017              
1018             =item VOB feature level
1019              
1020             =back
1021              
1022             =for html
1023              
1024             =cut
1025              
1026 0     0 1 0 my ($self) = @_;
1027              
1028 0 0       0 $self->expand_description unless $self->{featureLevel};
1029              
1030 0         0 return $self->{featureLevel};
1031             } # featureLevel
1032              
1033             sub schemaVersion() {
1034              
1035             =pod
1036              
1037             =head2 schemaVersion
1038              
1039             Returns the VOB schemaVersion
1040              
1041             Parameters:
1042              
1043             =for html
1044              
1045             =over
1046              
1047             =item none
1048              
1049             =back
1050              
1051             =for html
1052              
1053             Returns:
1054              
1055             =for html
1056              
1057             =over
1058              
1059             =item VOB schema version
1060              
1061             =back
1062              
1063             =for html
1064              
1065             =cut
1066              
1067 0     0 1 0 my ($self) = @_;
1068              
1069 0 0       0 $self->expand_description unless $self->{schemaVersion};
1070              
1071 0         0 return $self->{schemaVersion};
1072             } # schemaVersion
1073              
1074             sub remotePrivilege() {
1075              
1076             =pod
1077              
1078             =head2 remotePrivilege
1079              
1080             Returns the VOB remotePrivilege
1081              
1082             Parameters:
1083              
1084             =for html
1085              
1086             =over
1087              
1088             =item none
1089              
1090             =back
1091              
1092             =for html
1093              
1094             Returns:
1095              
1096             =for html
1097              
1098             =over
1099              
1100             =item Remote Privilege capability
1101              
1102             =back
1103              
1104             =for html
1105              
1106             =cut
1107              
1108 0     0 1 0 my ($self) = @_;
1109              
1110 0 0       0 $self->expand_description unless $self->{remotePrivilege};
1111              
1112 0         0 return $self->{remotePrivilege};
1113             } # remotePrivilege
1114              
1115             sub atomicCheckin() {
1116              
1117             =pod
1118              
1119             =head2 atomicCheckin
1120              
1121             Returns the VOB atomicCheckin
1122              
1123             Parameters:
1124              
1125             =for html
1126              
1127             =over
1128              
1129             =item none
1130              
1131             =back
1132              
1133             =for html
1134              
1135             Returns:
1136              
1137             =for html
1138              
1139             =over
1140              
1141             =item Whether atomic check in enabled
1142              
1143             =back
1144              
1145             =for html
1146              
1147             =cut
1148              
1149 0     0 1 0 my ($self) = @_;
1150              
1151 0 0       0 $self->expand_description unless $self->{atomicCheckin};
1152              
1153 0         0 return $self->{atomicCheckin};
1154             } # atomicCheckin
1155              
1156             sub group() {
1157              
1158             =pod
1159              
1160             =head2 group
1161              
1162             Returns the VOB group
1163              
1164             Parameters:
1165              
1166             =for html
1167              
1168             =over
1169              
1170             =item none
1171              
1172             =back
1173              
1174             =for html
1175              
1176             Returns:
1177              
1178             =for html
1179              
1180             =over
1181              
1182             =item VOB group
1183              
1184             =back
1185              
1186             =for html
1187              
1188             =cut
1189              
1190 0     0 1 0 my ($self) = @_;
1191              
1192 0 0       0 $self->expand_description unless $self->{group};
1193              
1194 0         0 return $self->{group};
1195             } # group
1196              
1197             sub groups() {
1198              
1199             =pod
1200              
1201             =head2 groups
1202              
1203             Returns the VOB groups
1204              
1205             Parameters:
1206              
1207             =for html
1208              
1209             =over
1210              
1211             =item none
1212              
1213             =back
1214              
1215             =for html
1216              
1217             Returns:
1218              
1219             =for html
1220              
1221             =over
1222              
1223             =item VOB groups
1224              
1225             =back
1226              
1227             =for html
1228              
1229             =cut
1230              
1231 0     0 1 0 my ($self) = @_;
1232              
1233 0 0       0 $self->expand_description unless $self->{groups};
1234              
1235 0         0 return @{$self->{groups}};
  0         0  
1236             } # groups
1237              
1238             sub aclsEnabled() {
1239              
1240             =pod
1241              
1242             =head2 aclsEnabled
1243              
1244             Returns the VOB aclsEnabled
1245              
1246             Parameters:
1247              
1248             =for html
1249              
1250             =over
1251              
1252             =item none
1253              
1254             =back
1255              
1256             =for html
1257              
1258             Returns:
1259              
1260             =for html
1261              
1262             =over
1263              
1264             =item VOB aclsEnabled
1265              
1266             =back
1267              
1268             =for html
1269              
1270             =cut
1271              
1272 0     0 1 0 my ($self) = @_;
1273              
1274 0 0       0 $self->expand_description unless $self->{aclsEnabled};
1275              
1276 0         0 return $self->{aclsEnabled};
1277             } # aclsEnabled
1278              
1279             sub attributes() {
1280              
1281             =pod
1282              
1283             =head2 attributes
1284              
1285             Returns the VOB attributes
1286              
1287             Parameters:
1288              
1289             =for html
1290              
1291             =over
1292              
1293             =item none
1294              
1295             =back
1296              
1297             =for html
1298              
1299             Returns:
1300              
1301             =for html
1302              
1303             =over
1304              
1305             =item VOB attributes
1306              
1307             =back
1308              
1309             =for html
1310              
1311             =cut
1312              
1313 0     0 1 0 my ($self) = @_;
1314              
1315 0 0       0 $self->expand_description unless $self->{attributes};
1316              
1317 0         0 return %{$self->{attributes}};
  0         0  
1318             } # attributes
1319              
1320             sub hyperlinks() {
1321              
1322             =pod
1323              
1324             =head2 hyperlinks
1325              
1326             Returns the VOB hyperlinks
1327              
1328             Parameters:
1329              
1330             =for html
1331              
1332             =over
1333              
1334             =item none
1335              
1336             =back
1337              
1338             =for html
1339              
1340             Returns:
1341              
1342             =for html
1343              
1344             =over
1345              
1346             =item VOB hyperlinks
1347              
1348             =back
1349              
1350             =for html
1351              
1352             =cut
1353              
1354 0     0 1 0 my ($self) = @_;
1355              
1356 0 0       0 $self->expand_description unless $self->{hyperlinks};
1357              
1358 0         0 return %{$self->{hyperlinks}};
  0         0  
1359             } # hyperlinks
1360              
1361             sub countdb() {
1362 0     0 0 0 my ($self) = @_;
1363              
1364             # Set values to zero in case we cannot get the right values from countdb
1365 0         0 $self->{elements} = 0;
1366 0         0 $self->{branches} = 0;
1367 0         0 $self->{versions} = 0;
1368              
1369             # Countdb needs to be done in the vob's db directory
1370 0         0 my $cwd = `pwd`;
1371              
1372 0         0 chomp $cwd;
1373 0         0 chdir "$self->{gpath}/db";
1374              
1375 0         0 my $cmd = "$Clearcase::COUNTDB vob_db 2>&1";
1376 0         0 my @output = `$cmd`;
1377              
1378 0 0       0 if ($? != 0) {
1379 0         0 chdir $cwd;
1380 0         0 return;
1381             } # if
1382              
1383 0         0 chomp @output;
1384              
1385             # Parse output
1386 0         0 for (@output) {
1387 0 0       0 if (/^ELEMENT\s*:\s*(\d*)/) {
    0          
    0          
1388 0         0 $self->{elements} = $1;
1389             } elsif (/^BRANCH\s*:\s*(\d*)/) {
1390 0         0 $self->{branches} = $1;
1391             } elsif (/^VERSION\s*:\s*(\d*)/) {
1392 0         0 $self->{versions} = $1;
1393             } # if
1394             } # for
1395              
1396 0         0 chdir $cwd;
1397              
1398 0         0 return;
1399             } # countdb
1400              
1401             sub elements() {
1402 0     0 1 0 my ($self) = @_;
1403              
1404             =pod
1405              
1406             =head2 elements
1407              
1408             Returns the number of elements in the VOB (obtained via countdb)
1409              
1410             Parameters:
1411              
1412             =for html
1413              
1414             =over
1415              
1416             =item none
1417              
1418             =back
1419              
1420             =for html
1421              
1422             Returns:
1423              
1424             =for html
1425              
1426             =over
1427              
1428             =item number of elements
1429              
1430             =back
1431              
1432             =for html
1433              
1434             =cut
1435              
1436 0 0       0 $self->countdb if !$self->{elements};
1437              
1438 0         0 return $self->{elements};
1439             } # elements
1440              
1441             sub branches() {
1442 0     0 1 0 my ($self) = @_;
1443              
1444             =pod
1445              
1446             =head3 branches
1447              
1448             Returns the number of branch types in the vob
1449              
1450             Parameters:
1451              
1452             =for html
1453              
1454             =over
1455              
1456             =item none
1457              
1458             =back
1459              
1460             =for html
1461              
1462             Returns:
1463              
1464             =for html
1465              
1466             =over
1467              
1468             =item number of branch types
1469              
1470             =back
1471              
1472             =for html
1473              
1474             =cut
1475              
1476 0 0       0 $self->countdb if !$self->{branches};
1477              
1478 0         0 return $self->{branches};
1479             } # branches
1480              
1481             sub versions() {
1482 0     0 1 0 my ($self) = @_;
1483              
1484             =pod
1485              
1486             =head2 versions
1487              
1488             Returns the number of element versions in the VOB
1489              
1490             Parameters:
1491              
1492             =for html
1493              
1494             =over
1495              
1496             =item none
1497              
1498             =back
1499              
1500             =for html
1501              
1502             Returns:
1503              
1504             =for html
1505              
1506             =over
1507              
1508             =item number of element versions
1509              
1510             =back
1511              
1512             =for html
1513              
1514             =cut
1515              
1516 0 0       0 $self->countdb if !$self->{versions};
1517              
1518 0         0 return $self->{versions};
1519             } # versions
1520              
1521             sub dbsize() {
1522 0     0 1 0 my ($self) = @_;
1523              
1524             =pod
1525              
1526             =head3 dbsize
1527              
1528             Returns the size of the VOB's database
1529              
1530             Parameters:
1531              
1532             =for html
1533              
1534             =over
1535              
1536             =item none
1537              
1538             =back
1539              
1540             =for html
1541              
1542             Returns:
1543              
1544             =for html
1545              
1546             =over
1547              
1548             =item database size
1549              
1550             =back
1551              
1552             =for html
1553              
1554             =cut
1555              
1556 0 0       0 $self->expand_space if !$self->{dbsize};
1557              
1558 0         0 return $self->{dbsize};
1559             } # dbsize
1560              
1561             sub admsize() {
1562 0     0 1 0 my ($self) = @_;
1563              
1564             =pod
1565              
1566             =head2 admsize
1567              
1568             Returns the size of administrative data in the VOB
1569              
1570             Parameters:
1571              
1572             =for html
1573              
1574             =over
1575              
1576             =item none
1577              
1578             =back
1579              
1580             =for html
1581              
1582             Returns:
1583              
1584             =for html
1585              
1586             =over
1587              
1588             =item adminstrative size
1589              
1590             =back
1591              
1592             =for html
1593              
1594             =cut
1595              
1596 0 0       0 $self->expand_space if !$self->{admsize};
1597              
1598 0         0 return $self->{admsize};
1599             } # admsize
1600              
1601             sub ctsize() {
1602 0     0 1 0 my ($self) = @_;
1603              
1604             =pod
1605              
1606             =head3 ctsize
1607              
1608             Returns the size of the cleartext pool
1609              
1610             Parameters:
1611              
1612             =for html
1613              
1614             =over
1615              
1616             =item none
1617              
1618             =back
1619              
1620             =for html
1621              
1622             Returns:
1623              
1624             =for html
1625              
1626             =over
1627              
1628             =item cleartext pool size
1629              
1630             =back
1631              
1632             =for html
1633              
1634             =cut
1635              
1636 0 0       0 $self->expand_space if !$self->{ctsize};
1637              
1638 0         0 return $self->{ctsize};
1639             } # ctsize
1640              
1641             sub dosize() {
1642 0     0 1 0 my ($self) = @_;
1643              
1644             =pod
1645              
1646             =head2 dosize
1647              
1648             Returns the size of the derived object pool
1649              
1650             Parameters:
1651              
1652             =for html
1653              
1654             =over
1655              
1656             =item none
1657              
1658             =back
1659              
1660             =for html
1661              
1662             Returns:
1663              
1664             =for html
1665              
1666             =over
1667              
1668             =item derived object pool size
1669              
1670             =back
1671              
1672             =for html
1673              
1674             =cut
1675              
1676 0 0       0 $self->expand_space if !$self->{dosize};
1677              
1678 0         0 return $self->{dosize};
1679             } # dosize
1680              
1681             sub srcsize() {
1682 0     0 1 0 my ($self) = @_;
1683              
1684             =pod
1685              
1686             =head2 srcsize
1687              
1688             Returns the size of the source pool
1689              
1690             Parameters:
1691              
1692             =for html
1693              
1694             =over
1695              
1696             =item none
1697              
1698             =back
1699              
1700             =for html
1701              
1702             Returns:
1703              
1704             =for html
1705              
1706             =over
1707              
1708             =item source pool size
1709              
1710             =back
1711              
1712             =for html
1713              
1714             =cut
1715              
1716 0 0       0 $self->expand_space if !$self->{srcsize};
1717              
1718 0         0 return $self->{srcsize};
1719             } # srcsize
1720              
1721             sub size() {
1722 0     0 1 0 my ($self) = @_;
1723              
1724             =pod
1725              
1726             =head2 size
1727              
1728             Returns the size of the VOB
1729              
1730             Parameters:
1731              
1732             =for html
1733              
1734             =over
1735              
1736             =item none
1737              
1738             =back
1739              
1740             =for html
1741              
1742             Returns:
1743              
1744             =for html
1745              
1746             =over
1747              
1748             =item size
1749              
1750             =back
1751              
1752             =for html
1753              
1754             =cut
1755              
1756 0 0       0 $self->expand_space if !$self->{size};
1757              
1758 0         0 return $self->{size};
1759             } # size
1760              
1761             sub mount() {
1762 1     1 1 213 my ($self) = @_;
1763              
1764             =pod
1765              
1766             =head2 mount
1767              
1768             Mount the current VOB
1769              
1770             Parameters:
1771              
1772             =for html
1773              
1774             =over
1775              
1776             =item none
1777              
1778             =back
1779              
1780             =for html
1781              
1782             Returns:
1783              
1784             =for html
1785              
1786             =over
1787              
1788             =item $status
1789              
1790             Status of the mount command
1791              
1792             =item @output
1793              
1794             An array of lines output from the cleartool mount command
1795              
1796             =back
1797              
1798             =for html
1799              
1800             =cut
1801              
1802 1 50 33     9 return 0 if $self->{active} && $self->{active} eq "YES";
1803              
1804 0         0 my ($status, @output) = $Clearcase::CC->execute ("mount $self->{tag}");
1805              
1806 0         0 return ($status, @output);
1807             } # mount
1808              
1809             sub umount() {
1810 1     1 1 6 my ($self) = @_;
1811              
1812             =pod
1813              
1814             =head3 umount
1815              
1816             Unmounts the current VOB
1817              
1818             Parameters:
1819              
1820             =for html
1821              
1822             =over
1823              
1824             =item none
1825              
1826             =back
1827              
1828             =for html
1829              
1830             Returns:
1831              
1832             =for html
1833              
1834             =over
1835              
1836             =item $status
1837              
1838             Status from cleartool
1839              
1840             =item @output
1841              
1842             Ouput from cleartool
1843              
1844             =back
1845              
1846             =for html
1847              
1848             =cut
1849              
1850 1         3 my ($status, @output) = $Clearcase::CC->execute ("umount $self->{tag}");
1851              
1852 1         10 return ($status, @output);
1853             } # umount
1854              
1855             sub exists() {
1856 2     2 1 7 my ($self) = @_;
1857              
1858             =pod
1859              
1860             =head2 exists
1861              
1862             Returns true or false if the VOB exists
1863              
1864             Parameters:
1865              
1866             =for html
1867              
1868             =over
1869              
1870             =item none
1871              
1872             =back
1873              
1874             =for html
1875              
1876             Returns:
1877              
1878             =for html
1879              
1880             =over
1881              
1882             =item boolean
1883              
1884             =back
1885              
1886             =for html
1887              
1888             =cut
1889              
1890 2         8 my ($status, @output) =
1891             $Clearcase::CC->execute ("lsvob -region $self->{region} $self->{tag}");
1892              
1893 2         27 return !$status;
1894             } # exists
1895              
1896             sub create(;$$$%) {
1897 1     1 1 327 my ($self, $host, $vbs, $comment, %opts) = @_;
1898              
1899             =pod
1900              
1901             =head2 create
1902              
1903             Creates a VOB. First instantiate a VOB object with a tag. Then call create. A
1904             small subset of parameters is supported for create.
1905              
1906             Parameters:
1907              
1908             =for html
1909              
1910             =over
1911              
1912             =item $host (optional)
1913              
1914             Host to create the vob on. Default is the current host.
1915              
1916             =item $vbs (optional)
1917              
1918             VOB storage area. This is a global pathname to the VOB storage
1919             area. Default will attempt to use -stgloc -auto.
1920              
1921             =item $comment (optional)
1922              
1923             Comment for this VOB's creation. Default is -nc
1924              
1925             =back
1926              
1927             =for html
1928              
1929             Returns:
1930              
1931             =for html
1932              
1933             =over
1934              
1935             =item $status
1936              
1937             Status from cleartool
1938              
1939             =item @output
1940              
1941             Ouput from cleartool
1942              
1943             =back
1944              
1945             =for html
1946              
1947             =cut
1948              
1949 1 50       4 return (0, ()) if $self->exists;
1950              
1951 0         0 $comment = Clearcase::setComment $comment;
1952              
1953 0         0 my ($status, @output);
1954              
1955 0         0 my $additionalOpts = '';
1956              
1957 0         0 for (keys %opts) {
1958 0         0 $additionalOpts .= "-$_ ";
1959 0 0       0 $additionalOpts .= "$opts{$_} " if $opts{$_};
1960             } # for
1961              
1962 0 0 0     0 if ($host && $vbs) {
1963 0 0       0 $additionalOpts .= '-ucmproject' if $self->{ucmproject};
1964              
1965 0         0 ($status, @output) = $Clearcase::CC->execute (
1966             "mkvob -tag $self->{tag} $comment $additionalOpts -host $host -hpath $vbs "
1967             . "-gpath $vbs $vbs");
1968             } else {
1969              
1970             # Note this requires that -stgloc's work and that using -auto is not a
1971             # problem.
1972 0         0 ($status, @output) =
1973             $Clearcase::CC->execute (
1974             "mkvob -tag $self->{tag} $comment $additionalOpts -stgloc -auto");
1975             } # if
1976              
1977 0         0 $self->updateVobInfo;
1978              
1979 0         0 return ($status, @output);
1980             } # create
1981              
1982             sub remove() {
1983 1     1 1 11 my ($self) = @_;
1984              
1985             =pod
1986              
1987             =head2 remove
1988              
1989             Removed this VOB
1990              
1991             Parameters:
1992              
1993             =for html
1994              
1995             =over
1996              
1997             =item none
1998              
1999             =back
2000              
2001             =for html
2002              
2003             Returns:
2004              
2005             =for html
2006              
2007             =over
2008              
2009             =item $status
2010              
2011             Status from cleartool
2012              
2013             =item @output
2014              
2015             Ouput from cleartool
2016              
2017             =back
2018              
2019             =for html
2020              
2021             =cut
2022              
2023 1         5 return $Clearcase::CC->execute ("rmvob -force $self->{gpath}");
2024             } # remove
2025              
2026             =pod
2027              
2028             =head2 updateVobInfo ($vob)
2029              
2030             Updates the VOB info from cleartool lsvob
2031              
2032             Parameters:
2033              
2034             =for html
2035              
2036             =over
2037              
2038             =item $vob
2039              
2040             The vob object/tag to update info for
2041              
2042             =back
2043              
2044             =for html
2045              
2046             Returns:
2047              
2048             =for html
2049              
2050             =over
2051              
2052             =item nothing
2053              
2054             =back
2055              
2056             =for html
2057              
2058             =cut
2059              
2060             =pod
2061              
2062             =head2 updateVobInfo ($vob)
2063              
2064             Updates the VOB info from cleartool lsvob
2065              
2066             Parameters:
2067              
2068             =for html
2069              
2070             =over
2071              
2072             =item $vob
2073              
2074             The vob object/tag to update info for
2075              
2076             =back
2077              
2078             =for html
2079              
2080             Returns:
2081              
2082             =for html
2083              
2084             =over
2085              
2086             =item nothing
2087              
2088             =back
2089              
2090             =for html
2091              
2092             =cut
2093              
2094             sub updateVobInfo ($$) {
2095 2     2 1 4 my ($self) = @_;
2096              
2097 2         48 my ($status, @output) = $Clearcase::CC->execute ("lsvob -long $self->{tag}");
2098              
2099             # Assuming this vob is an empty shell of an object that the user may possibly
2100             # use the create method on, return our blessings...
2101 2 50       83 return if $status != 0;
2102              
2103 2         6 for (@output) {
2104 24 100       208 if (/Global path: (.*)/) {
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    100          
    50          
    100          
2105 2         8 $self->{gpath} = $1;
2106             } elsif (/Server host: (.*)/) {
2107 2         7 $self->{shost} = $1;
2108             } elsif (/Access: (.*)/) {
2109 2         6 $self->{access} = $1;
2110             } elsif (/Mount options: (.*)/) {
2111 2         6 $self->{mopts} = $1;
2112             } elsif (/Region: (.*)/) {
2113 2         17 $self->{region} = $1;
2114             } elsif (/Active: (.*)/) {
2115 2         7 $self->{active} = $1;
2116             } elsif (/Vob tag replica uuid: (.*)/) {
2117 2         6 $self->{replica_uuid} = $1;
2118             } elsif (/Vob on host: (.*)/) {
2119 2         6 $self->{host} = $1;
2120             } elsif (/Vob server access path: (.*)/) {
2121 2         6 $self->{access_path} = $1;
2122             } elsif (/Vob family uuid: (.*)/) {
2123 0         0 $self->{family_uuid} = $1;
2124             } elsif (/Vob registry attributes: (.*)/) {
2125 2         6 $self->{vob_registry_attributes} = $1;
2126             } # if
2127             } # for
2128              
2129 2         7 return;
2130             } # getVobInfo
2131              
2132             1;
2133              
2134             =pod
2135              
2136             =head2 DEPENDENCIES
2137              
2138             =head2 Modules
2139              
2140             =over
2141              
2142             =item L
2143              
2144             =item L
2145              
2146             =back
2147              
2148             =head2 BUGS AND LIMITATIONS
2149              
2150             There are no known bugs in this module
2151              
2152             Please report problems to Andrew DeFaria .
2153              
2154             =head1 COPYRIGHT AND LICENSE
2155              
2156             Copyright (C) 2020 by Andrew@DeFaria.com
2157              
2158             This library is free software; you can redistribute it and/or modify
2159             it under the same terms as Perl itself, either Perl version 5.38.0 or,
2160             at your option, any later version of Perl 5 you may have available.
2161              
2162             =cut