X-Git-Url: https://defaria.com/gitweb/?a=blobdiff_plain;f=lib%2FClearcase%2FVob.pm;h=f8c636b614bb794de02b1075742d87b3c85faa4b;hb=e9c727e87a9d1a0b997432d6b3610c0c9945aaab;hp=ca4f76519021cd34e4d4e5ebf4c39aa9d6c4df32;hpb=e907bf835bb61d8888f2fcd59c90bd071e841cf7;p=clearscm.git diff --git a/lib/Clearcase/Vob.pm b/lib/Clearcase/Vob.pm index ca4f765..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,8 +141,11 @@ Returns: =cut + $region ||= $Clearcase::CC->region; + $class = bless { - tag => $tag + tag => $tag, + region => $region, }, $class; $class->updateVobInfo; @@ -150,14 +153,14 @@ Returns: return $class; } # new -sub tag () { +sub tag() { my ($self) = @_; =pod =head2 tag -Returns the VOB's tag +Returns the VOB tag Parameters: @@ -188,14 +191,14 @@ Returns: return $self->{tag}; } # tag -sub gpath () { +sub gpath() { my ($self) = @_; =pod =head2 gpath -Returns the VOB's global path +Returns the VOB global path Parameters: @@ -226,14 +229,14 @@ Returns: return $self->{gpath}; } # gpath -sub shost () { +sub shost() { my ($self) = @_; =pod =head2 shost -Returns the VOB's server host +Returns the VOB server host Parameters: @@ -268,7 +271,8 @@ Returns: sub name() { goto &tag; } # name -sub access () { + +sub access() { my ($self) = @_; =pod @@ -308,7 +312,7 @@ Returns either public for public VOBs or private for private VOBs return $self->{access}; } # access -sub mopts () { +sub mopts() { my ($self) = @_; =pod @@ -346,7 +350,7 @@ Returns: return $self->{mopts}; } # mopts -sub region () { +sub region() { my ($self) = @_; =pod @@ -384,7 +388,7 @@ Returns: return $self->{region}; } # region -sub active () { +sub active() { my ($self) = @_; =pod @@ -423,14 +427,14 @@ Returns: return $self->{active}; } # active -sub replica_uuid () { +sub replica_uuid() { my ($self) = @_; =pod =head2 replica_uuid -Returns the VOBS replica_uuid +Returns the VOB replica_uuid Parameters: @@ -461,14 +465,14 @@ Returns: return $self->{replica_uuid}; } # replica_uuid -sub host () { +sub host() { my ($self) = @_; =pod =head2 host -Returns the VOB's host +Returns the VOB host Parameters: @@ -499,14 +503,14 @@ Returns: return $self->{host}; } # host -sub access_path () { +sub access_path() { my ($self) = @_; =pod =head2 access_path -Returns the VOB's access path +Returns the VOB access path Parameters: @@ -539,7 +543,7 @@ This is the path relative to the VOB's host return $self->{access_path}; } # access_path -sub family_uuid () { +sub family_uuid() { my ($self) = @_; =pod @@ -577,7 +581,7 @@ Returns: return $self->{family_uuid}; } # family_uuid -sub vob_registry_attributes () { +sub vob_registry_attributes() { my ($self) = @_; =pod @@ -615,7 +619,7 @@ Returns: return $self->{vob_registry_attributes}; } # vob_registry_attributes -sub expand_space () { +sub expand_space() { my ($self) = @_; my ($status, @output) = $Clearcase::CC->execute ("space -vob $self->{tag}"); @@ -628,7 +632,7 @@ sub expand_space () { $self->{srcsize} = 0; $self->{size} = 0; - foreach (@output) { + for (@output) { if (/(\d*\.\d).*VOB database(.*)/) { $self->{dbsize} = $1; } elsif (/(\d*\.\d).*administration data(.*)/) { @@ -642,52 +646,758 @@ sub expand_space () { } elsif (/(\d*\.\d).*Subtotal(.*)/) { $self->{size} = $1; } # if - } # foreach + } # for return; } # expand_space -sub countdb () { +sub expand_description() { my ($self) = @_; - # Set values to zero in case we cannot get the right values from countdb - $self->{elements} = 0; - $self->{branches} = 0; - $self->{versions} = 0; - - # Countdb needs to be done in the vob's db directory - my $cwd = `pwd`; + 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 - chomp $cwd; - chdir "$self->{gpath}/db"; + return; +} # expand_space - my $cmd = "$Clearcase::COUNTDB vob_db 2>&1"; - my @output = `$cmd`; +sub masterReplica() { - if ($? != 0) { - chdir $cwd; - return; - } # if +=pod - chomp @output; +=head2 masterReplica - # Parse output - foreach (@output) { - if (/^ELEMENT\s*:\s*(\d*)/) { - $self->{elements} = $1; - } elsif (/^BRANCH\s*:\s*(\d*)/) { - $self->{branches} = $1; - } elsif (/^VERSION\s*:\s*(\d*)/) { - $self->{versions} = $1; - } # if - } # foreach +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 + + my ($self) = @_; + + $self->expand_description unless $self->{masterReplica}; + + return $self->{masterReplica} +} # masterReplica + +sub created() { + +=pod + +=head2 created + +Returns the date the VOB was created + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html+ +Returns: + +=for html
+ +=over + +=item Date the VOB was created + +=back + +=for html+ +=cut + + my ($self) = @_; + + $self->expand_description unless $self->{created}; + + return $self->{created} +} # created + +sub ownername() { + +=pod + +=head2 ownername + +Returns the VOB ownername + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html+ +Returns: + +=for html
+ +=over + +=item VOB Owner Name + +=back + +=for html+ +=cut + + my ($self) = @_; + + $self->expand_description unless $self->{ownername}; + + return $self->{ownername} +} # ownername + +sub owner() { + +=pod + +=head2 owner + +Returns the VOB owner + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html+ +Returns: + +=for html
+ +=over + +=item VOB master replica + +=back + +=for html+ +=cut + + my ($self) = @_; + + $self->expand_description unless $self->{owner}; + + return $self->{owner} +} # owner + +sub comment() { + +=pod + +=head2 comment + +Returns the VOB comment + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html+ +Returns: + +=for html
+ +=over + +=item VOB comment + +=back + +=for html+ +=cut + + my ($self) = @_; + + $self->expand_description unless $self->{comment}; + + return $self->{comment} +} # comment + +sub replicaName() { + +=pod + +=head2 replicaName + +Returns the VOB replicaName + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html+ +Returns: + +=for html
+ +=over + +=item VOB replica name + +=back + +=for html+ +=cut + + my ($self) = @_; + + $self->expand_description unless $self->{replicaName}; + + return $self->{replicaName} +} # replicaName + +sub featureLevel() { + +=pod + +=head2 featureLevel + +Returns the VOB featureLevel + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html+ +Returns: + +=for html
+ +=over + +=item VOB feature level + +=back + +=for html+ +=cut + + my ($self) = @_; + + $self->expand_description unless $self->{featureLevel}; + + return $self->{featureLevel} +} # featureLevel + +sub schemaVersion() { + +=pod + +=head2 schemaVersion + +Returns the VOB schemaVersion + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html+ +Returns: + +=for html
+ +=over + +=item VOB schema version + +=back + +=for html+ +=cut + + my ($self) = @_; + + $self->expand_description unless $self->{schemaVersion}; + + return $self->{schemaVersion} +} # schemaVersion + +sub remotePrivilege() { + +=pod + +=head2 remotePrivilege + +Returns the VOB remotePrivilege + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html+ +Returns: + +=for html
+ +=over + +=item Remote Privilege capability + +=back + +=for html+ +=cut + + my ($self) = @_; + + $self->expand_description unless $self->{remotePrivilege}; + + return $self->{remotePrivilege} +} # remotePrivilege + +sub atomicCheckin() { + +=pod + +=head2 atomicCheckin + +Returns the VOB atomicCheckin + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html+ +Returns: + +=for html
+ +=over + +=item Whether atomic check in enabled + +=back + +=for html+ +=cut + + my ($self) = @_; + + $self->expand_description unless $self->{atomicCheckin}; + + return $self->{atomicCheckin} +} # atomicCheckin + +sub group() { + +=pod + +=head2 group + +Returns the VOB group + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html+ +Returns: + +=for html
+ +=over + +=item VOB group + +=back + +=for html+ +=cut + + my ($self) = @_; + + $self->expand_description unless $self->{group}; + + return $self->{group} +} # group + +sub groups() { + +=pod + +=head2 groups + +Returns the VOB groups + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html+ +Returns: + +=for html
+ +=over + +=item VOB groups + +=back + +=for html+ +=cut + + my ($self) = @_; + + $self->expand_description unless $self->{groups}; + + return @{$self->{groups}} +} # groups + +sub aclsEnabled() { + +=pod + +=head2 aclsEnabled + +Returns the VOB aclsEnabled + +Parameters: + +=for html
+ +=over + +=item none + +=back + +=for html+ +Returns: + +=for html
+ +=over + +=item VOB aclsEnabled + +=back + +=for html+ +=cut + + 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 + + my ($self) = @_; + + $self->expand_description unless $self->{attributes}; + + return %{$self->{attributes}}; +} # attributes + +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 + + 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 + $self->{elements} = 0; + $self->{branches} = 0; + $self->{versions} = 0; + + # Countdb needs to be done in the vob's db directory + my $cwd = `pwd`; + + chomp $cwd; + chdir "$self->{gpath}/db"; + + my $cmd = "$Clearcase::COUNTDB vob_db 2>&1"; + my @output = `$cmd`; + + if ($? != 0) { + chdir $cwd; + return; + } # if + + chomp @output; + + # Parse output + for (@output) { + if (/^ELEMENT\s*:\s*(\d*)/) { + $self->{elements} = $1; + } elsif (/^BRANCH\s*:\s*(\d*)/) { + $self->{branches} = $1; + } elsif (/^VERSION\s*:\s*(\d*)/) { + $self->{versions} = $1; + } # if + } # for chdir $cwd; return; } # countdb -sub elements () { +sub elements() { my ($self) = @_; =pod @@ -727,7 +1437,7 @@ Returns: return $self->{elements}; } # elements -sub branches () { +sub branches() { my ($self) = @_; =pod @@ -767,7 +1477,7 @@ Returns: return $self->{branches}; } # branches -sub versions () { +sub versions() { my ($self) = @_; =pod @@ -807,7 +1517,7 @@ Returns: return $self->{versions}; } # versions -sub dbsize () { +sub dbsize() { my ($self) = @_; =pod @@ -847,7 +1557,7 @@ Returns: return $self->{dbsize}; } # dbsize -sub admsize () { +sub admsize() { my ($self) = @_; =pod @@ -887,7 +1597,7 @@ Returns: return $self->{admsize}; } # admsize -sub ctsize () { +sub ctsize() { my ($self) = @_; =pod @@ -927,7 +1637,7 @@ Returns: return $self->{ctsize}; } # ctsize -sub dosize () { +sub dosize() { my ($self) = @_; =pod @@ -967,7 +1677,7 @@ Returns: return $self->{dosize}; } # dosize -sub srcsize () { +sub srcsize() { my ($self) = @_; =pod @@ -1007,7 +1717,7 @@ Returns: return $self->{srcsize}; } # srcsize -sub size () { +sub size() { my ($self) = @_; =pod @@ -1047,7 +1757,7 @@ Returns: return $self->{size}; } # size -sub mount () { +sub mount() { my ($self) = @_; =pod @@ -1090,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 @@ -1136,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 @@ -1176,12 +1886,12 @@ 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 (;$$$%) { +sub create(;$$$%) { my ($self, $host, $vbs, $comment, %opts) = @_; =pod @@ -1250,14 +1960,14 @@ Ouput from cleartool if ($host && $vbs) { $additionalOpts .= '-ucmproject' if $self->{ucmproject}; - ($status, @output) = $Clearcase::CC->execute ( + ($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 $additionalOpts -stgloc -auto"); + $Clearcase::CC->execute("mkvob -tag $self->{tag} $comment $additionalOpts -stgloc -auto"); } # if $self->updateVobInfo; @@ -1265,7 +1975,7 @@ Ouput from cleartool return ($status, @output); } # create -sub remove () { +sub remove() { my ($self) = @_; =pod @@ -1306,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: (.*)/) { @@ -1342,7 +2052,7 @@ sub updateVobInfo ($$) { } elsif (/Vob registry attributes: (.*)/) { $self->{vob_registry_attributes} = $1; } # if - } # foreach + } # for return; } # getVobInfo