X-Git-Url: https://defaria.com/gitweb/?a=blobdiff_plain;f=lib%2FClearcase%2FVob.pm;h=f8c636b614bb794de02b1075742d87b3c85faa4b;hb=8d1cd7efa187991ca2672c2dfc7fbff6a0682f09;hp=6c957c079bbed2d847f5c5042300bca2adbcdcd3;hpb=81cbd130706633b1c19ff59371c2ef61d80c562b;p=clearscm.git diff --git a/lib/Clearcase/Vob.pm b/lib/Clearcase/Vob.pm index 6c957c0..f8c636b 100644 --- a/lib/Clearcase/Vob.pm +++ b/lib/Clearcase/Vob.pm @@ -56,7 +56,7 @@ expanded if and when accessed. This helps the VOB object to be more efficient. display "DB Size:\t" . $vob->dbsize; display "Adm Size:\t" . $vob->admsize; display "CT Size:\t" . $vob->ctsize; - display "DO Size:\t" . $vob->dbsize; + display "DO Size:\t" . $vob->dosize; display "Src Size:\t" . $vob->srcsize; display "Size:\t\t" . $vob->size; @@ -98,8 +98,8 @@ use warnings; use Clearcase; use OSDep; -sub new ($) { - my ($class, $tag) = @_; +sub new($;$) { + my ($class, $tag, $region) = @_; =pod @@ -141,23 +141,655 @@ Returns: =cut + $region ||= $Clearcase::CC->region; + $class = bless { - tag => $tag + tag => $tag, + region => $region, }, $class; - $class->updateVobInfo; + $class->updateVobInfo; + + return $class; +} # new + +sub tag() { + my ($self) = @_; + +=pod + +=head2 tag + +Returns the VOB tag + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html+ +Returns: + +=for html
+ +=over + +=item VOB's tag + +=back + +=for html+ +=cut + + return $self->{tag}; +} # tag + +sub gpath() { + my ($self) = @_; + +=pod + +=head2 gpath + +Returns the VOB global path + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html+ +Returns: + +=for html
+ +=over + +=item VOB's gpath + +=back + +=for html+ +=cut + + return $self->{gpath}; +} # gpath + +sub shost() { + my ($self) = @_; + +=pod + +=head2 shost + +Returns the VOB server host + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html+ +Returns: + +=for html
+ +=over + +=item VOB's server host + +=back + +=for html+ +=cut + + return $self->{shost}; +} # shost + +# Alias name to tag +sub name() { + goto &tag; +} # name + +sub access() { + my ($self) = @_; + +=pod + +=head2 access + +Returns the type of VOB access + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html+ +Returns: + +=for html
+ +=over + +=item access + +Returns either public for public VOBs or private for private VOBs + +=back + +=for html+ +=cut + + return $self->{access}; +} # access + +sub mopts() { + my ($self) = @_; + +=pod + +=head2 mopts + +Returns the mount options + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html+ +Returns: + +=for html
+ +=over + +=item VOB's mount options + +=back + +=for html+ +=cut + + return $self->{mopts}; +} # mopts + +sub region() { + my ($self) = @_; + +=pod + +=head3 region + +Returns the region for this VOB tag + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html+ +Returns: + +=for html
+ +=over + +=item region + +=back + +=for html+ +=cut + + return $self->{region}; +} # region + +sub active() { + my ($self) = @_; + +=pod + +=head2 active + +Returns that active status (whether or not the vob is currently mounted) of the +VOB + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html+ +Returns: + +=for html
+ +=over + +=item Returns YES for an active VOB or NO for an inactive one + +=back + +=for html+ +=cut + + return $self->{active}; +} # active + +sub replica_uuid() { + my ($self) = @_; + +=pod + +=head2 replica_uuid + +Returns the VOB replica_uuid + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html+ +Returns: + +=for html
+ +=over + +=item VOB replica_uuid + +=back + +=for html+ +=cut + + return $self->{replica_uuid}; +} # replica_uuid + +sub host() { + my ($self) = @_; + +=pod + +=head2 host + +Returns the VOB host + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html+ +Returns: + +=for html
+ +=over + +=item VOB's host + +=back + +=for html+ +=cut + + return $self->{host}; +} # host + +sub access_path() { + my ($self) = @_; + +=pod + +=head2 access_path + +Returns the VOB access path + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html+ +Returns: + +=for html
+ +=over + +=item VOB access path + +This is the path relative to the VOB's host + +=back + +=for html+ +=cut + + return $self->{access_path}; +} # access_path + +sub family_uuid() { + my ($self) = @_; + +=pod + +=head2 family_uuid + +Returns the VOB family UUID + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html+ +Returns: + +=for html
+ +=over + +=item VOB family UUID + +=back + +=for html+ +=cut + + return $self->{family_uuid}; +} # family_uuid + +sub vob_registry_attributes() { + my ($self) = @_; + +=pod + +=head2 vob_registry_attributes + +Returns the VOB Registry Attributes + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html+ +Returns: + +=for html
+ +=over + +=item VOB Registry Attributes + +=back + +=for html+ +=cut + + return $self->{vob_registry_attributes}; +} # vob_registry_attributes + +sub expand_space() { + my ($self) = @_; + + my ($status, @output) = $Clearcase::CC->execute ("space -vob $self->{tag}"); + + # Initialize fields in case of command failure + $self->{dbsize} = 0; + $self->{admsize} = 0; + $self->{ctsize} = 0; + $self->{dosize} = 0; + $self->{srcsize} = 0; + $self->{size} = 0; + + for (@output) { + if (/(\d*\.\d).*VOB database(.*)/) { + $self->{dbsize} = $1; + } elsif (/(\d*\.\d).*administration data(.*)/) { + $self->{admsize} = $1; + } elsif (/(\d*\.\d).*cleartext pool(.*)/) { + $self->{ctsize} = $1; + } elsif (/(\d*\.\d).*derived object pool(.*)/) { + $self->{dosize} = $1; + } elsif (/(\d*\.\d).*source pool(.*)/) { + $self->{srcsize} = $1; + } elsif (/(\d*\.\d).*Subtotal(.*)/) { + $self->{size} = $1; + } # if + } # for + + return; +} # expand_space + +sub expand_description() { + my ($self) = @_; + + my ($status, @output) = $Clearcase::CC->execute("describe -long vob:$self->{tag}"); + + for (my $i = 0; $i < @output; $i++) { + if ($output[$i] =~ /created (\S+) by (.+) \((\S+)\)/) { + $self->{created} = $1; + $self->{ownername} = $2; + $self->{owner} = $3; + } elsif ($output[$i] =~ /^\s+\"(.+)\"/) { + $self->{comment} = $1; + } elsif ($output[$i] =~ /master replica: (.+)/) { + $self->{masterReplica} = $1; + } elsif ($output[$i] =~ /replica name: (.+)/) { + $self->{replicaName} = $1; + } elsif ($output[$i] =~ /VOB family featch level: (\d+)/) { + $self->{featureLevel} = $1; + } elsif ($output[$i] =~ /database schema version: (\d+)/) { + $self->{schemaVersion} = $1; + } elsif ($output[$i] =~ /modification by remote privileged user: (.+)/) { + $self->{remotePrivilege} = $1; + } elsif ($output[$i] =~ /atomic checkin: (.+)/) { + $self->{atomicCheckin} = $1; + } elsif ($output[$i] =~ /VOB ownership:/) { + while ($output[$i] !~ /Additional groups:/) { + $i++; + + if ($output[$i++] =~ /owner (.+)/) { + $self->{owner} = $1; + } # if + + if ($output[$i++] =~ /group (.+)/) { + $self->{group} = $1; + } # if + } # while + + my @groups; + + while ($output[$i] !~ /ACLs enabled/) { + if ($output[$i++] =~ /group (.+)/) { + push @groups, $1; + } # if + } # while + + $self->{groups} = \@groups; + + if ($output[$i++] =~ /ACLs enabled: (.+)/) { + $self->{aclsEnabled} = $1; + } # if + + my %attributes; + + while ($i < @output and $output[$i] !~ /Hyperlinks:/) { + if ($output[$i] !~ /Attributes:/) { + my ($key, $value) = split / = /, $output[$i]; + + # Trim leading spaces + $key =~ s/^\s*(\S+)/$1/; + + # Remove unnecessary '"'s + $value =~ s/\"(.*)\"/$1/; + + $attributes{$key} = $value; + } # if + + $i++; + } # while + + $self->{attributes} = \%attributes; + + $i++; + + my %hyperlinks; + + while ($i < @output and $output[$i]) { + my ($key, $value) = split " -> ", $output[$i++]; + + # Trim leading spaces + $key =~ s/^\s*(\S+)/$1/; + + $hyperlinks{$key} = $value; + } # while + + $self->{hyperlinks} = \%hyperlinks; + } # if + } # for + + return; +} # expand_space + +sub masterReplica() { - return $class; -} # new +=pod + +=head2 masterReplica + +Returns the VOB master replica + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html+ +Returns: + +=for html
+ +=over + +=item VOB master replica + +=back + +=for html+ +=cut -sub tag () { my ($self) = @_; - + + $self->expand_description unless $self->{masterReplica}; + + return $self->{masterReplica} +} # masterReplica + +sub created() { + =pod -=head2 tag +=head2 created -Returns the VOB's tag +Returns the date the VOB was created Parameters: @@ -177,7 +809,7 @@ Returns: =over -=item VOB's tag +=item Date the VOB was created =back @@ -185,17 +817,20 @@ Returns: =cut - return $self->{tag}; -} # tag - -sub gpath () { my ($self) = @_; - + + $self->expand_description unless $self->{created}; + + return $self->{created} +} # created + +sub ownername() { + =pod -=head2 gpath +=head2 ownername -Returns the VOB's global path +Returns the VOB ownername Parameters: @@ -215,7 +850,7 @@ Returns: =over -=item VOB's gpath +=item VOB Owner Name =back @@ -223,17 +858,20 @@ Returns: =cut - return $self->{gpath}; -} # gpath - -sub shost () { my ($self) = @_; - + + $self->expand_description unless $self->{ownername}; + + return $self->{ownername} +} # ownername + +sub owner() { + =pod -=head2 shost +=head2 owner -Returns the VOB's server host +Returns the VOB owner Parameters: @@ -253,7 +891,7 @@ Returns: =over -=item VOB's server host +=item VOB master replica =back @@ -261,17 +899,20 @@ Returns: =cut - return $self->{shost}; -} # shost - -sub access () { my ($self) = @_; - + + $self->expand_description unless $self->{owner}; + + return $self->{owner} +} # owner + +sub comment() { + =pod -=head2 access +=head2 comment -Returns the type of VOB access +Returns the VOB comment Parameters: @@ -291,9 +932,7 @@ Returns: =over -=item access - -Returns either public for public VOBs or private for private VOBs +=item VOB comment =back @@ -301,17 +940,20 @@ Returns either public for public VOBs or private for private VOBs =cut - return $self->{access}; -} # access - -sub mopts () { my ($self) = @_; - + + $self->expand_description unless $self->{comment}; + + return $self->{comment} +} # comment + +sub replicaName() { + =pod -=head2 mopts +=head2 replicaName -Returns the mount options +Returns the VOB replicaName Parameters: @@ -331,7 +973,7 @@ Returns: =over -=item VOB's mount options +=item VOB replica name =back @@ -339,17 +981,20 @@ Returns: =cut - return $self->{mopts}; -} # mopts - -sub region () { my ($self) = @_; - + + $self->expand_description unless $self->{replicaName}; + + return $self->{replicaName} +} # replicaName + +sub featureLevel() { + =pod -=head3 region +=head2 featureLevel -Returns the region for this VOB tag +Returns the VOB featureLevel Parameters: @@ -369,7 +1014,7 @@ Returns: =over -=item region +=item VOB feature level =back @@ -377,18 +1022,20 @@ Returns: =cut - return $self->{region}; -} # region - -sub active () { my ($self) = @_; - + + $self->expand_description unless $self->{featureLevel}; + + return $self->{featureLevel} +} # featureLevel + +sub schemaVersion() { + =pod -=head2 active +=head2 schemaVersion -Returns that active status (whether or not the vob is currently mounted) of the -VOB +Returns the VOB schemaVersion Parameters: @@ -408,7 +1055,7 @@ Returns: =over -=item Returns YES for an active VOB or NO for an inactive one +=item VOB schema version =back @@ -416,17 +1063,20 @@ Returns: =cut - return $self->{active}; -} # active - -sub replica_uuid () { my ($self) = @_; - + + $self->expand_description unless $self->{schemaVersion}; + + return $self->{schemaVersion} +} # schemaVersion + +sub remotePrivilege() { + =pod -=head2 replica_uuid +=head2 remotePrivilege -Returns the VOBS replica_uuid +Returns the VOB remotePrivilege Parameters: @@ -446,7 +1096,7 @@ Returns: =over -=item VOB replica_uuid +=item Remote Privilege capability =back @@ -454,17 +1104,20 @@ Returns: =cut - return $self->{replica_uuid}; -} # replica_uuid - -sub host () { my ($self) = @_; - + + $self->expand_description unless $self->{remotePrivilege}; + + return $self->{remotePrivilege} +} # remotePrivilege + +sub atomicCheckin() { + =pod -=head2 host +=head2 atomicCheckin -Returns the VOB's host +Returns the VOB atomicCheckin Parameters: @@ -484,7 +1137,7 @@ Returns: =over -=item VOB's host +=item Whether atomic check in enabled =back @@ -492,17 +1145,20 @@ Returns: =cut - return $self->{host}; -} # host - -sub access_path () { my ($self) = @_; - + + $self->expand_description unless $self->{atomicCheckin}; + + return $self->{atomicCheckin} +} # atomicCheckin + +sub group() { + =pod -=head2 access_path +=head2 group -Returns the VOB's access path +Returns the VOB group Parameters: @@ -522,9 +1178,7 @@ Returns: =over -=item VOB access path - -This is the path relative to the VOB's host +=item VOB group =back @@ -532,17 +1186,20 @@ This is the path relative to the VOB's host =cut - return $self->{access_path}; -} # access_path - -sub family_uuid () { my ($self) = @_; - + + $self->expand_description unless $self->{group}; + + return $self->{group} +} # group + +sub groups() { + =pod -=head2 family_uuid +=head2 groups -Returns the VOB family UUID +Returns the VOB groups Parameters: @@ -562,7 +1219,7 @@ Returns: =over -=item VOB family UUID +=item VOB groups =back @@ -570,17 +1227,20 @@ Returns: =cut - return $self->{family_uuid}; -} # family_uuid - -sub vob_registry_attributes () { my ($self) = @_; - + + $self->expand_description unless $self->{groups}; + + return @{$self->{groups}} +} # groups + +sub aclsEnabled() { + =pod -=head2 vob_registry_attributes +=head2 aclsEnabled -Returns the VOB Registry Attributes +Returns the VOB aclsEnabled Parameters: @@ -600,7 +1260,7 @@ Returns: =over -=item VOB Registry Attributes +=item VOB aclsEnabled =back @@ -608,42 +1268,96 @@ Returns: =cut - return $self->{vob_registry_attributes}; -} # vob_registry_attributes + my ($self) = @_; + + $self->expand_description unless $self->{aclsEnabled}; + + return $self->{aclsEnabled} +} # aclsEnabled + +sub attributes() { + +=pod + +=head2 attributes + +Returns the VOB attributes + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html+ +Returns: + +=for html
+ +=over + +=item VOB attributes + +=back + +=for html+ +=cut -sub expand_space () { my ($self) = @_; - my ($status, @output) = $Clearcase::CC->execute ("space -vob $self->{tag}"); + $self->expand_description unless $self->{attributes}; - # Initialize fields in case of command failure - $self->{dbsize} = 0; - $self->{admsize} = 0; - $self->{ctsize} = 0; - $self->{dosize} = 0; - $self->{srcsize} = 0; - $self->{size} = 0; + return %{$self->{attributes}}; +} # attributes - foreach (@output) { - if (/(\d*\.\d).*VOB database(.*)/) { - $self->{dbsize} = $1; - } elsif (/(\d*\.\d).*administration data(.*)/) { - $self->{admsize} = $1; - } elsif (/(\d*\.\d).*cleartext pool(.*)/) { - $self->{ctsize} = $1; - } elsif (/(\d*\.\d).*derived object pool(.*)/) { - $self->{dosize} = $1; - } elsif (/(\d*\.\d).*source pool(.*)/) { - $self->{srcsize} = $1; - } elsif (/(\d*\.\d).*Subtotal(.*)/) { - $self->{size} = $1; - } # if - } # foreach - - return; -} # expand_space +sub hyperlinks() { + +=pod + +=head2 hyperlinks + +Returns the VOB hyperlinks + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html+ +Returns: + +=for html
+ +=over + +=item VOB hyperlinks + +=back + +=for html+ +=cut -sub countdb () { + my ($self) = @_; + + $self->expand_description unless $self->{hyperlinks}; + + return %{$self->{hyperlinks}}; +} # hyperlinks + +sub countdb() { my ($self) = @_; # Set values to zero in case we cannot get the right values from countdb @@ -657,18 +1371,18 @@ sub countdb () { chomp $cwd; chdir "$self->{gpath}/db"; - my $cmd = "$Clearcase::COUNTDB vob_db 2>&1"; - my @output = `$cmd`; + my $cmd = "$Clearcase::COUNTDB vob_db 2>&1"; + my @output = `$cmd`; - if ($? != 0) { - chdir $cwd; - return; - } # if + if ($? != 0) { + chdir $cwd; + return; + } # if chomp @output; # Parse output - foreach (@output) { + for (@output) { if (/^ELEMENT\s*:\s*(\d*)/) { $self->{elements} = $1; } elsif (/^BRANCH\s*:\s*(\d*)/) { @@ -676,14 +1390,14 @@ sub countdb () { } elsif (/^VERSION\s*:\s*(\d*)/) { $self->{versions} = $1; } # if - } # foreach + } # for chdir $cwd; return; } # countdb -sub elements () { +sub elements() { my ($self) = @_; =pod @@ -723,7 +1437,7 @@ Returns: return $self->{elements}; } # elements -sub branches () { +sub branches() { my ($self) = @_; =pod @@ -763,7 +1477,7 @@ Returns: return $self->{branches}; } # branches -sub versions () { +sub versions() { my ($self) = @_; =pod @@ -803,7 +1517,7 @@ Returns: return $self->{versions}; } # versions -sub dbsize () { +sub dbsize() { my ($self) = @_; =pod @@ -843,7 +1557,7 @@ Returns: return $self->{dbsize}; } # dbsize -sub admsize () { +sub admsize() { my ($self) = @_; =pod @@ -883,7 +1597,7 @@ Returns: return $self->{admsize}; } # admsize -sub ctsize () { +sub ctsize() { my ($self) = @_; =pod @@ -923,7 +1637,7 @@ Returns: return $self->{ctsize}; } # ctsize -sub dosize () { +sub dosize() { my ($self) = @_; =pod @@ -963,7 +1677,7 @@ Returns: return $self->{dosize}; } # dosize -sub srcsize () { +sub srcsize() { my ($self) = @_; =pod @@ -1003,7 +1717,7 @@ Returns: return $self->{srcsize}; } # srcsize -sub size () { +sub size() { my ($self) = @_; =pod @@ -1043,7 +1757,7 @@ Returns: return $self->{size}; } # size -sub mount () { +sub mount() { my ($self) = @_; =pod @@ -1086,12 +1800,12 @@ An array of lines output from the cleartool mount command return 0 if $self->{active} && $self->{active} eq "YES"; - my ($status, @output) = $Clearcase::CC->execute ("mount $self->{tag}"); + my ($status, @output) = $Clearcase::CC->execute("mount $self->{tag}"); return ($status, @output); } # mount -sub umount () { +sub umount() { my ($self) = @_; =pod @@ -1132,12 +1846,12 @@ Ouput from cleartool =cut - my ($status, @output) = $Clearcase::CC->execute ("umount $self->{tag}"); + my ($status, @output) = $Clearcase::CC->execute("umount $self->{tag}"); return ($status, @output); } # umount -sub exists () { +sub exists() { my ($self) = @_; =pod @@ -1172,13 +1886,13 @@ Returns: =cut - my ($status, @output) = $Clearcase::CC->execute ("lsvob $self->{tag}"); + my ($status, @output) = $Clearcase::CC->execute("lsvob -region $self->{region} $self->{tag}"); return !$status; } # exists -sub create (;$$$) { - my ($self, $host, $vbs, $comment) = @_; +sub create(;$$$%) { + my ($self, $host, $vbs, $comment, %opts) = @_; =pod @@ -1232,20 +1946,28 @@ Ouput from cleartool return (0, ()) if $self->exists; - $comment = Clearcase::setComment $comment; + $comment = Clearcase::_setComment $comment; my ($status, @output); + my $additionalOpts = ''; + + for (keys %opts) { + $additionalOpts .= "-$_ "; + $additionalOpts .= "$opts{$_} " if $opts{$_}; + } # for + if ($host && $vbs) { - ($status, @output) = $Clearcase::CC->execute ( - "mkvob -tag $self->{tag} $comment -host $host -hpath $vbs " + $additionalOpts .= '-ucmproject' if $self->{ucmproject}; + + ($status, @output) = $Clearcase::CC->execute( + "mkvob -tag $self->{tag} $comment $additionalOpts -host $host -hpath $vbs " . "-gpath $vbs $vbs"); } else { # Note this requires that -stgloc's work and that using -auto is not a # problem. ($status, @output) = - $Clearcase::CC->execute ("mkvob -tag $self->{tag} $comment " - . "-stgloc -auto"); + $Clearcase::CC->execute("mkvob -tag $self->{tag} $comment $additionalOpts -stgloc -auto"); } # if $self->updateVobInfo; @@ -1253,7 +1975,7 @@ Ouput from cleartool return ($status, @output); } # create -sub remove () { +sub remove() { my ($self) = @_; =pod @@ -1294,19 +2016,19 @@ Ouput from cleartool =cut - return $Clearcase::CC->execute ("rmvob -force $self->{gpath}"); + return $Clearcase::CC->execute("rmvob -force $self->{gpath}"); } # remove sub updateVobInfo ($$) { my ($self) = @_; - my ($status, @output) = $Clearcase::CC->execute ("lsvob -long $self->{tag}"); + my ($status, @output) = $Clearcase::CC->execute("lsvob -long $self->{tag}"); # Assuming this vob is an empty shell of an object that the user may possibly # use the create method on, return our blessings... return if $status != 0; - foreach (@output) { + for (@output) { if (/Global path: (.*)/) { $self->{gpath} = $1; } elsif (/Server host: (.*)/) { @@ -1330,7 +2052,7 @@ sub updateVobInfo ($$) { } elsif (/Vob registry attributes: (.*)/) { $self->{vob_registry_attributes} = $1; } # if - } # foreach + } # for return; } # getVobInfo