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