lib/Clearcase/Vob.pm

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