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->dbsize;
  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's 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's 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's 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 VOBS 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's 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's 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   foreach (@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   } # foreach
 646
 647   return;
 648 } # expand_space
 649
 650 sub countdb () {
 651   my ($self) = @_;
 652
 653   # Set values to zero in case we cannot get the right values from countdb
 654   $self->{elements} = 0;
 655   $self->{branches} = 0;
 656   $self->{versions} = 0;
 657
 658   # Countdb needs to be done in the vob's db directory
 659   my $cwd = `pwd`;
 660
 661   chomp $cwd;
 662   chdir "$self->{gpath}/db";
 663
 664    my $cmd    = "$Clearcase::COUNTDB vob_db 2>&1";
 665    my @output = `$cmd`;
 666
 667    if ($? != 0) {
 668      chdir $cwd;
 669      return;
 670     }    # if
 671
 672   chomp @output;
 673
 674   # Parse output
 675   foreach (@output) {
 676     if (/^ELEMENT\s*:\s*(\d*)/) {
 677       $self->{elements} = $1;
 678     } elsif (/^BRANCH\s*:\s*(\d*)/) {
 679       $self->{branches} = $1;
 680     } elsif (/^VERSION\s*:\s*(\d*)/) {
 681       $self->{versions} = $1;
 682     } # if
 683   } # foreach
 684
 685   chdir $cwd;
 686
 687   return;
 688 } # countdb
 689
 690 sub elements () {
 691   my ($self) = @_;
 692
 693 =pod
 694
 695 =head2 elements
 696
 697 Returns the number of elements in the VOB (obtained via countdb)
 698
 699 Parameters:
 700
 701 =for html <blockquote>
 702
 703 =over
 704
 705 =item none
 706
 707 =back
 708
 709 =for html </blockquote>
 710
 711 Returns:
 712
 713 =for html <blockquote>
 714
 715 =over
 716
 717 =item number of elements
 718
 719 =back
 720
 721 =for html </blockquote>
 722
 723 =cut
 724
 725   $self->countdb if !$self->{elements};
 726
 727   return $self->{elements};
 728 } # elements
 729
 730 sub branches () {
 731   my ($self) = @_;
 732
 733 =pod
 734
 735 =head3 branches
 736
 737 Returns the number of branch types in the vob
 738
 739 Parameters:
 740
 741 =for html <blockquote>
 742
 743 =over
 744
 745 =item none
 746
 747 =back
 748
 749 =for html </blockquote>
 750
 751 Returns:
 752
 753 =for html <blockquote>
 754
 755 =over
 756
 757 =item number of branch types
 758
 759 =back
 760
 761 =for html </blockquote>
 762
 763 =cut
 764
 765   $self->countdb if !$self->{branches};
 766
 767   return $self->{branches};
 768 } # branches
 769
 770 sub versions () {
 771   my ($self) = @_;
 772
 773 =pod
 774
 775 =head2 versions
 776
 777 Returns the number of element versions in the VOB
 778
 779 Parameters:
 780
 781 =for html <blockquote>
 782
 783 =over
 784
 785 =item none
 786
 787 =back
 788
 789 =for html </blockquote>
 790
 791 Returns:
 792
 793 =for html <blockquote>
 794
 795 =over
 796
 797 =item number of element versions
 798
 799 =back
 800
 801 =for html </blockquote>
 802
 803 =cut
 804
 805   $self->countdb if !$self->{versions};
 806
 807   return $self->{versions};
 808 } # versions
 809
 810 sub dbsize () {
 811   my ($self) = @_;
 812
 813 =pod
 814
 815 =head3 dbsize
 816
 817 Returns the size of the VOB's database
 818
 819 Parameters:
 820
 821 =for html <blockquote>
 822
 823 =over
 824
 825 =item none
 826
 827 =back
 828
 829 =for html </blockquote>
 830
 831 Returns:
 832
 833 =for html <blockquote>
 834
 835 =over
 836
 837 =item database size
 838
 839 =back
 840
 841 =for html </blockquote>
 842
 843 =cut
 844
 845   $self->expand_space if !$self->{dbsize};
 846
 847   return $self->{dbsize};
 848 } # dbsize
 849
 850 sub admsize () {
 851   my ($self) = @_;
 852
 853 =pod
 854
 855 =head2 admsize
 856
 857 Returns the size of administrative data in the VOB
 858
 859 Parameters:
 860
 861 =for html <blockquote>
 862
 863 =over
 864
 865 =item none
 866
 867 =back
 868
 869 =for html </blockquote>
 870
 871 Returns:
 872
 873 =for html <blockquote>
 874
 875 =over
 876
 877 =item adminstrative size
 878
 879 =back
 880
 881 =for html </blockquote>
 882
 883 =cut
 884
 885   $self->expand_space if !$self->{admsize};
 886
 887   return $self->{admsize};
 888 } # admsize
 889
 890 sub ctsize () {
 891   my ($self) = @_;
 892
 893 =pod
 894
 895 =head3 ctsize
 896
 897 Returns the size of the cleartext pool
 898
 899 Parameters:
 900
 901 =for html <blockquote>
 902
 903 =over
 904
 905 =item none
 906
 907 =back
 908
 909 =for html </blockquote>
 910
 911 Returns:
 912
 913 =for html <blockquote>
 914
 915 =over
 916
 917 =item cleartext pool size
 918
 919 =back
 920
 921 =for html </blockquote>
 922
 923 =cut
 924
 925   $self->expand_space if !$self->{ctsize};
 926
 927   return $self->{ctsize};
 928 } # ctsize
 929
 930 sub dosize () {
 931   my ($self) = @_;
 932
 933 =pod
 934
 935 =head2 dosize
 936
 937 Returns the size of the derived object pool
 938
 939 Parameters:
 940
 941 =for html <blockquote>
 942
 943 =over
 944
 945 =item none
 946
 947 =back
 948
 949 =for html </blockquote>
 950
 951 Returns:
 952
 953 =for html <blockquote>
 954
 955 =over
 956
 957 =item derived object pool size
 958
 959 =back
 960
 961 =for html </blockquote>
 962
 963 =cut
 964
 965   $self->expand_space if !$self->{dosize};
 966
 967   return $self->{dosize};
 968 } # dosize
 969
 970 sub srcsize () {
 971   my ($self) = @_;
 972
 973 =pod
 974
 975 =head2 srcsize
 976
 977 Returns the size of the source pool
 978
 979 Parameters:
 980
 981 =for html <blockquote>
 982
 983 =over
 984
 985 =item none
 986
 987 =back
 988
 989 =for html </blockquote>
 990
 991 Returns:
 992
 993 =for html <blockquote>
 994
 995 =over
 996
 997 =item source pool size
 998
 999 =back
1000
1001 =for html </blockquote>
1002
1003 =cut
1004
1005   $self->expand_space if !$self->{srcsize};
1006
1007   return $self->{srcsize};
1008 } # srcsize
1009
1010 sub size () {
1011   my ($self) = @_;
1012
1013 =pod
1014
1015 =head2 size
1016
1017 Returns the size of the VOB
1018
1019 Parameters:
1020
1021 =for html <blockquote>
1022
1023 =over
1024
1025 =item none
1026
1027 =back
1028
1029 =for html </blockquote>
1030
1031 Returns:
1032
1033 =for html <blockquote>
1034
1035 =over
1036
1037 =item size
1038
1039 =back
1040
1041 =for html </blockquote>
1042
1043 =cut
1044
1045   $self->expand_space if !$self->{size};
1046
1047   return $self->{size};
1048 } # size
1049
1050 sub mount () {
1051   my ($self) = @_;
1052
1053 =pod
1054
1055 =head2 mount
1056
1057 Mount the current VOB
1058
1059 Parameters:
1060
1061 =for html <blockquote>
1062
1063 =over
1064
1065 =item none
1066
1067 =back
1068
1069 =for html </blockquote>
1070
1071 Returns:
1072
1073 =for html <blockquote>
1074
1075 =over
1076
1077 =item $status
1078
1079 Status of the mount command
1080
1081 =item @output
1082
1083 An array of lines output from the cleartool mount command
1084
1085 =back
1086
1087 =for html </blockquote>
1088
1089 =cut
1090
1091   return 0 if $self->{active} && $self->{active} eq "YES";
1092
1093   my ($status, @output) = $Clearcase::CC->execute ("mount $self->{tag}");
1094
1095   return ($status, @output);
1096 } # mount
1097
1098 sub umount () {
1099   my ($self) = @_;
1100
1101 =pod
1102
1103 =head3 umount
1104
1105 Unmounts the current VOB
1106
1107 Parameters:
1108
1109 =for html <blockquote>
1110
1111 =over
1112
1113 =item none
1114
1115 =back
1116
1117 =for html </blockquote>
1118
1119 Returns:
1120
1121 =for html <blockquote>
1122
1123 =over
1124
1125 =item $status
1126
1127 Status from cleartool
1128
1129 =item @output
1130
1131 Ouput from cleartool
1132
1133 =back
1134
1135 =for html </blockquote>
1136
1137 =cut
1138
1139   my ($status, @output) = $Clearcase::CC->execute ("umount $self->{tag}");
1140
1141   return ($status, @output);
1142 } # umount
1143
1144 sub exists () {
1145   my ($self) = @_;
1146
1147 =pod
1148
1149 =head2 exists
1150
1151 Returns true or false if the VOB exists
1152
1153 Parameters:
1154
1155 =for html <blockquote>
1156
1157 =over
1158
1159 =item none
1160
1161 =back
1162
1163 =for html </blockquote>
1164
1165 Returns:
1166
1167 =for html <blockquote>
1168
1169 =over
1170
1171 =item boolean
1172
1173 =back
1174
1175 =for html </blockquote>
1176
1177 =cut
1178
1179   my ($status, @output) = $Clearcase::CC->execute ("lsvob $self->{tag}");
1180
1181   return !$status;
1182 } # exists
1183
1184 sub create (;$$$%) {
1185   my ($self, $host, $vbs, $comment, %opts) = @_;
1186
1187 =pod
1188
1189 =head2 create
1190
1191 Creates a VOB. First instantiate a VOB object with a tag. Then call create. A
1192 small subset of parameters is supported for create.
1193
1194 Parameters:
1195
1196 =for html <blockquote>
1197
1198 =over
1199
1200 =item $host (optional)
1201
1202 Host to create the vob on. Default is the current host.
1203
1204 =item $vbs (optional)
1205
1206 VOB storage area. This is a global pathname to the VOB storage
1207 area. Default will attempt to use -stgloc -auto.
1208
1209 =item $comment (optional)
1210
1211 Comment for this VOB's creation. Default is -nc
1212
1213 =back
1214
1215 =for html </blockquote>
1216
1217 Returns:
1218
1219 =for html <blockquote>
1220
1221 =over
1222
1223 =item $status
1224
1225 Status from cleartool
1226
1227 =item @output
1228
1229 Ouput from cleartool
1230
1231 =back
1232
1233 =for html </blockquote>
1234
1235 =cut
1236
1237   return (0, ()) if $self->exists;
1238
1239   $comment = Clearcase::_setComment $comment;
1240
1241   my ($status, @output);
1242
1243   my $additionalOpts = '';
1244
1245   for (keys %opts) {
1246     $additionalOpts .= "-$_ ";
1247     $additionalOpts .= "$opts{$_} " if $opts{$_};
1248   } # for
1249
1250   if ($host && $vbs) {
1251     $additionalOpts .= '-ucmproject' if $self->{ucmproject};
1252
1253     ($status, @output) = $Clearcase::CC->execute (
1254       "mkvob -tag $self->{tag} $comment $additionalOpts -host $host -hpath $vbs "
1255     . "-gpath $vbs $vbs");
1256   } else {
1257     # Note this requires that -stgloc's work and that using -auto is not a
1258     # problem.
1259     ($status, @output) =
1260       $Clearcase::CC->execute ("mkvob -tag $self->{tag} $comment $additionalOpts -stgloc -auto");
1261   } # if
1262
1263   $self->updateVobInfo;
1264
1265   return ($status, @output);
1266 } # create
1267
1268 sub remove () {
1269   my ($self) = @_;
1270
1271 =pod
1272
1273 =head2 remove
1274
1275 Removed this VOB
1276
1277 Parameters:
1278
1279 =for html <blockquote>
1280
1281 =over
1282
1283 =item none
1284
1285 =back
1286
1287 =for html </blockquote>
1288
1289 Returns:
1290
1291 =for html <blockquote>
1292
1293 =over
1294
1295 =item $status
1296
1297 Status from cleartool
1298
1299 =item @output
1300
1301 Ouput from cleartool
1302
1303 =back
1304
1305 =for html </blockquote>
1306
1307 =cut
1308
1309   return $Clearcase::CC->execute ("rmvob -force $self->{gpath}");
1310 } # remove
1311
1312 sub updateVobInfo ($$) {
1313   my ($self) = @_;
1314
1315   my ($status, @output) = $Clearcase::CC->execute ("lsvob -long $self->{tag}");
1316
1317   # Assuming this vob is an empty shell of an object that the user may possibly
1318   # use the create method on, return our blessings...
1319   return if $status != 0;
1320
1321   foreach (@output) {
1322     if (/Global path: (.*)/) {
1323       $self->{gpath} = $1;
1324     } elsif (/Server host: (.*)/) {
1325       $self->{shost} = $1;
1326     } elsif (/Access: (.*)/) {
1327       $self->{access} = $1;
1328     } elsif (/Mount options: (.*)/) {
1329       $self->{mopts} = $1;
1330     } elsif (/Region: (.*)/) {
1331       $self->{region} = $1;
1332     } elsif (/Active: (.*)/) {
1333       $self->{active} = $1;
1334     } elsif (/Vob tag replica uuid: (.*)/) {
1335       $self->{replica_uuid} = $1;
1336     } elsif (/Vob on host: (.*)/) {
1337       $self->{host} = $1;
1338     } elsif (/Vob server access path: (.*)/) {
1339       $self->{access_path} = $1;
1340     } elsif (/Vob family uuid:  (.*)/) {
1341       $self->{family_uuid} = $1;
1342     } elsif (/Vob registry attributes: (.*)/) {
1343       $self->{vob_registry_attributes} = $1;
1344     } # if
1345  } # foreach
1346
1347  return;
1348 } # getVobInfo
1349
1350 1;
1351
1352 =pod
1353
1354 =head2 DEPENDENCIES
1355
1356 =head3 ClearSCM Perl Modules
1357
1358 =for html <p><a href="/php/scm_man.php?file=lib/Clearcase.pm">Clearcase</a></p>
1359
1360 =for html <p><a href="/php/scm_man.php?file=lib/OSDep.pm">OSdep</a></p>
1361
1362 =head2 BUGS AND LIMITATIONS
1363
1364 There are no known bugs in this module
1365
1366 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
1367
1368 =head2 LICENSE AND COPYRIGHT
1369
1370 Copyright (c) 2007, ClearSCM, Inc. All rights reserved.
1371
1372 =cut