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;
use Clearcase;
use OSDep;
-sub new ($) {
- my ($class, $tag) = @_;
+sub new($;$) {
+ my ($class, $tag, $region) = @_;
=pod
=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 <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item VOB's tag
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ return $self->{tag};
+} # tag
+
+sub gpath() {
+ my ($self) = @_;
+
+=pod
+
+=head2 gpath
+
+Returns the VOB global path
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item VOB's gpath
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ return $self->{gpath};
+} # gpath
+
+sub shost() {
+ my ($self) = @_;
+
+=pod
+
+=head2 shost
+
+Returns the VOB server host
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item VOB's server host
+
+=back
+
+=for html </blockquote>
+
+=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 <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item access
+
+Returns either public for public VOBs or private for private VOBs
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ return $self->{access};
+} # access
+
+sub mopts() {
+ my ($self) = @_;
+
+=pod
+
+=head2 mopts
+
+Returns the mount options
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item VOB's mount options
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ return $self->{mopts};
+} # mopts
+
+sub region() {
+ my ($self) = @_;
+
+=pod
+
+=head3 region
+
+Returns the region for this VOB tag
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item region
+
+=back
+
+=for html </blockquote>
+
+=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 <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item Returns YES for an active VOB or NO for an inactive one
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ return $self->{active};
+} # active
+
+sub replica_uuid() {
+ my ($self) = @_;
+
+=pod
+
+=head2 replica_uuid
+
+Returns the VOB replica_uuid
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item VOB replica_uuid
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ return $self->{replica_uuid};
+} # replica_uuid
+
+sub host() {
+ my ($self) = @_;
+
+=pod
+
+=head2 host
+
+Returns the VOB host
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item VOB's host
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ return $self->{host};
+} # host
+
+sub access_path() {
+ my ($self) = @_;
+
+=pod
+
+=head2 access_path
+
+Returns the VOB access path
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item VOB access path
+
+This is the path relative to the VOB's host
+
+=back
+
+=for html </blockquote>
+
+=cut
+
+ return $self->{access_path};
+} # access_path
+
+sub family_uuid() {
+ my ($self) = @_;
+
+=pod
+
+=head2 family_uuid
+
+Returns the VOB family UUID
+
+Parameters:
+
+=for html <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item VOB family UUID
+
+=back
+
+=for html </blockquote>
+
+=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 <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item VOB Registry Attributes
+
+=back
+
+=for html </blockquote>
+
+=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 <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item VOB master replica
+
+=back
+
+=for html </blockquote>
+
+=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:
=over
-=item VOB's tag
+=item Date the VOB was created
=back
=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:
=over
-=item VOB's gpath
+=item VOB Owner Name
=back
=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:
=over
-=item VOB's server host
+=item VOB master replica
=back
=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:
=over
-=item access
-
-Returns either public for public VOBs or private for private VOBs
+=item VOB comment
=back
=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:
=over
-=item VOB's mount options
+=item VOB replica name
=back
=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:
=over
-=item region
+=item VOB feature level
=back
=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:
=over
-=item Returns YES for an active VOB or NO for an inactive one
+=item VOB schema version
=back
=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:
=over
-=item VOB replica_uuid
+=item Remote Privilege capability
=back
=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:
=over
-=item VOB's host
+=item Whether atomic check in enabled
=back
=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:
=over
-=item VOB access path
-
-This is the path relative to the VOB's host
+=item VOB group
=back
=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:
=over
-=item VOB family UUID
+=item VOB groups
=back
=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:
=over
-=item VOB Registry Attributes
+=item VOB aclsEnabled
=back
=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 <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item VOB attributes
+
+=back
+
+=for html </blockquote>
+
+=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 <blockquote>
+
+=over
+
+=item none
+
+=back
+
+=for html </blockquote>
+
+Returns:
+
+=for html <blockquote>
+
+=over
+
+=item VOB hyperlinks
+
+=back
+
+=for html </blockquote>
+
+=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
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*)/) {
} elsif (/^VERSION\s*:\s*(\d*)/) {
$self->{versions} = $1;
} # if
- } # foreach
+ } # for
chdir $cwd;
return;
} # countdb
-sub elements () {
+sub elements() {
my ($self) = @_;
=pod
return $self->{elements};
} # elements
-sub branches () {
+sub branches() {
my ($self) = @_;
=pod
return $self->{branches};
} # branches
-sub versions () {
+sub versions() {
my ($self) = @_;
=pod
return $self->{versions};
} # versions
-sub dbsize () {
+sub dbsize() {
my ($self) = @_;
=pod
return $self->{dbsize};
} # dbsize
-sub admsize () {
+sub admsize() {
my ($self) = @_;
=pod
return $self->{admsize};
} # admsize
-sub ctsize () {
+sub ctsize() {
my ($self) = @_;
=pod
return $self->{ctsize};
} # ctsize
-sub dosize () {
+sub dosize() {
my ($self) = @_;
=pod
return $self->{dosize};
} # dosize
-sub srcsize () {
+sub srcsize() {
my ($self) = @_;
=pod
return $self->{srcsize};
} # srcsize
-sub size () {
+sub size() {
my ($self) = @_;
=pod
return $self->{size};
} # size
-sub mount () {
+sub mount() {
my ($self) = @_;
=pod
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
=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
=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
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;
return ($status, @output);
} # create
-sub remove () {
+sub remove() {
my ($self) = @_;
=pod
=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: (.*)/) {
} elsif (/Vob registry attributes: (.*)/) {
$self->{vob_registry_attributes} = $1;
} # if
- } # foreach
+ } # for
return;
} # getVobInfo
projects / clearscm.git / blobdiff