lib/Clearcase/Element.pm

   1 =pod
   2
   3 =head1 NAME $RCSfile: Element.pm,v $
   4
   5 Object oriented interface to Clearcase Elements
   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.18 $
  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 Clearcase Elements.
  32
  33  my $element = new Clearcase::Element (pname => "element");
  34
  35  display "Element:\t"   . $element->pname;
  36  display "Version:\t"   . $element->version;
  37  display "Pred:\t\t"    . $element->pred;
  38
  39  display "Activities:";
  40
  41  if (my %activities = $element->activities) {
  42    display "\t\t$_: $activities{$_}" foreach (keys %activities);
  43  } else {
  44    display "\t\tNone";
  45  } # if
  46
  47  display "Attributes:";
  48
  49  if (my %attributes = $element->attributes) {
  50    display "\t\t$_=$attributes{$_}" foreach (keys %attributes);
  51  } else {
  52    display"\t\tNone";
  53  } # if
  54
  55  display "Hyperlinks:";
  56
  57  if (my @hyperlinks = $element->hyperlinks) {
  58    display "\t\t$_" foreach (@hyperlinks);
  59  } else {
  60    display "\t\tNone";
  61  } # if
  62
  63  display "Comments:";
  64
  65  if ($element->comments) {
  66    display "\t\t" . $element->comments;
  67  } else {
  68    display "\t\tNone";
  69  } # if
  70
  71  display "Create_date:\t" . $element->create_date;
  72  display "User:\t\t"      . $element->user;
  73  display "Group:\t\t"     . $element->group;
  74  display "User_mode:\t"   . $element->user_mode;
  75  display "Group_mode:\t"  . $element->group_mode;
  76  display "Other_mode:\t"  . $element->other_mode;
  77  display "Mode:\t\t"      . $element->mode;
  78
  79  display "Labels:";
  80
  81  if (my @labels = $element->labels) {
  82    display "\t\t$_" foreach (@labels);
  83  } else {
  84   display "\t\tNone";
  85  } # if
  86
  87  display "Rule:\t\t"  . $element->rule;
  88  display "Xname:\t\t" . $element->xname;
  89
  90 =head1 DESCRIPTION
  91
  92 This module implements a Clearcase Element object.
  93
  94 =head1 ROUTINES
  95
  96 The following routines are exported:
  97
  98 =cut
  99
 100 package Clearcase::Element;
 101
 102 use strict;
 103 use warnings;
 104
 105 use lib '..';
 106
 107 use Clearcase;
 108
 109 sub collapseOverExtendedVersionPathname ($) {
 110   my ($versionStr) = @_;
 111
 112 =pod
 113
 114 =head2 collapseOverExtendedVersionPathname
 115
 116 This utility function will collapse an "over extended" version pathname. These
 117 over extended pathnames can occur when we are not operating in the UCM view
 118 from which the version was generated. Clearcase gives us enormous,technically
 119 correct but hard to read, view/vob extended path names. Here's an example
 120 (broken by lines for readability):
 121
 122  /vob/component/branch1@@/main/branch1_Integration/1/src/main/branch1_
 123  /2/com/main/branch1_Integration/2/company/main/branch1_Integration/2/
 124  ManagerPlatform/main/branch1_Integration/2/nma/main/
 125  branch1_Integration/devbranch_17/1/common/main/devbranch_17/3/exception/
 126  main/mainline/devbranch_r17/1/Exception.java/main/mainline/1
 127
 128 We want this to read:
 129
 130   element: /vob/component/src/com/company/ManagerPlatform/nma/
 131            common/exception/Exception.java
 132   version: /main/mainline/1
 133
 134 Parameters:
 135
 136 =for html <blockquote>
 137
 138 =over
 139
 140 =item $versionStr
 141
 142 This is the over extended version pathname
 143
 144 =back
 145
 146 =for html </blockquote>
 147
 148 Returns:
 149
 150 =for html <blockquote>
 151
 152 =over
 153
 154 =item %element hash
 155
 156 A hash containing the element's name and version string collapsed
 157
 158 =back
 159
 160 =for html </blockquote>
 161
 162 =cut
 163
 164   return
 165     unless $versionStr;
 166
 167   $versionStr =~ s/\\/\//g;
 168
 169   my ($name, $version) = split /$Clearcase::SFX/, $versionStr;
 170
 171   my %element = (
 172     extended_name => $versionStr,
 173     name          => $name,
 174     version       => $version,
 175   );
 176
 177   return
 178     unless $element{version};
 179
 180   while ($element{version} =~ s/.*?\/\d+\/(.*?)\///) {
 181     $element{name} .= "/$1";
 182   } # while
 183
 184   $element{version} = "/$element{version}"
 185     if $element{version} !~ /^\//;
 186
 187   return %element;
 188 } # collapseOverExtendedVersionPathname
 189
 190 sub new ($) {
 191   my ($class, $pname) = @_;
 192
 193 =pod
 194
 195 =head2 new
 196
 197 Construct a new Clearcase Element object.
 198
 199 Parameters:
 200
 201 =for html <blockquote>
 202
 203 =over
 204
 205 =item element name
 206
 207 =back
 208
 209 =for html </blockquote>
 210
 211 Returns:
 212
 213 =for html <blockquote>
 214
 215 =over
 216
 217 =item Clearcase Element object
 218
 219 =back
 220
 221 =for html </blockquote>
 222
 223 =cut
 224
 225   my $self = bless {
 226     pname => $pname,
 227   }, $class;
 228
 229   my ($version, $rule);
 230
 231   my ($status, @output) = $Clearcase::CC->execute ("ls -d $pname");
 232
 233   return $self
 234     if $status;
 235
 236   # Sometimes ls -d puts out more than one line. Join them...
 237   if ((join ' ', @output) =~ /^.*\@\@(\S+)\s+Rule: (.*)$/m) {
 238     $version = $1;
 239     $rule    = $2;
 240   } # if
 241
 242   $self->{rule}    = $rule;
 243   $self->{version} = $version;
 244
 245   return $self;
 246 } # new
 247
 248 sub describe () {
 249   my ($self) = @_;
 250   # Get information that can only be gotten with describe -long. These fields
 251   # lack a -fmt option.
 252
 253   my ($status, @output) = $Clearcase::CC->execute (
 254     "describe -long $self->{pname}"
 255   );
 256
 257   return
 258     if $status != 0;
 259
 260   my $section;
 261
 262   foreach (@output) {
 263     if (/Hyperlinks:/) {
 264       $section = 'hyperlinks';
 265       next;
 266     } elsif (/Attached activities:/) {
 267       $section = 'activities';
 268       next;
 269     } # if
 270
 271     if ($section) {
 272       if ($section eq 'activities') {
 273         if (/activity:(.*)\s+\"(.*)\"/) {
 274           ${$self->{activities}}{$1} = $2;
 275         } # if
 276       } elsif ($section eq "hyperlinks") {
 277         if (/\s+(.*)/) {
 278           push @{$self->{hyperlinks}}, $1;
 279         } # if
 280       } # if
 281
 282       next;
 283     } # if
 284
 285     if (/User : \S+\s*: (.*)/) {
 286       $self->{user_mode} = $1;
 287     } elsif (/Group: \S+\s*: (.*)/) {
 288       $self->{group_mode} = $1;
 289     } elsif (/Other:\s+: (.*)/) {
 290       $self->{other_mode} = $1;
 291     } # if
 292   } # foreach
 293
 294   # Change modes to numeric
 295   $self->{mode} = 0;
 296
 297   $self->{mode} += 400 if $self->{user_mode}  =~ /r/;
 298   $self->{mode} += 200 if $self->{user_mode}  =~ /w/;
 299   $self->{mode} += 100 if $self->{user_mode}  =~ /x/;
 300   $self->{mode} += 40  if $self->{group_mode} =~ /r/;
 301   $self->{mode} += 20  if $self->{group_mode} =~ /w/;
 302   $self->{mode} += 10  if $self->{group_mode} =~ /x/;
 303   $self->{mode} += 4   if $self->{other_mode} =~ /r/;
 304   $self->{mode} += 2   if $self->{other_mode} =~ /w/;
 305   $self->{mode} += 1   if $self->{other_mode} =~ /x/;
 306
 307   return;
 308 } # describe
 309
 310 sub activities () {
 311   my ($self) = @_;
 312
 313 =pod
 314
 315 =head2 activities
 316
 317 Returns a hash of activity name/value pairs
 318
 319 Parameters:
 320
 321 =for html <blockquote>
 322
 323 =over
 324
 325 =item none
 326
 327 =back
 328
 329 =for html </blockquote>
 330
 331 Returns:
 332
 333 =for html <blockquote>
 334
 335 =over
 336
 337 =item Hash of activity name/value pairs
 338
 339 =back
 340
 341 =for html </blockquote>
 342
 343 =cut
 344
 345   $self->describe
 346     unless $self->{activities};
 347
 348   return $self->{activities} ? %{$self->{activities}} : ();
 349 } # activities
 350
 351 sub attributes () {
 352   my ($self) = @_;
 353
 354 =pod
 355
 356 =head2 attributes
 357
 358 Returns a hash of attribute name/value pairs
 359
 360 Parameters:
 361
 362 =for html <blockquote>
 363
 364 =over
 365
 366 =item none
 367
 368 =back
 369
 370 =for html </blockquote>
 371
 372 Returns:
 373
 374 =for html <blockquote>
 375
 376 =over
 377
 378 =item Hash of attribute name/value pairs
 379
 380 =back
 381
 382 =for html </blockquote>
 383
 384 =cut
 385
 386   $self->updateElementInfo
 387     unless $self->{attributes};
 388
 389   return %{$self->{attributes}};
 390 } # attributes
 391
 392 sub comments () {
 393   my ($self) = @_;
 394
 395 =pod
 396
 397 =head2 comments
 398
 399 Returns the comments associated with the current version element.
 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 comment
 420
 421 =back
 422
 423 =for html </blockquote>
 424
 425 =cut
 426
 427   $self->updateElementInfo
 428     unless $self->{comments};
 429
 430   return $self->{comments};
 431 } # comments
 432
 433 sub create_date () {
 434   my ($self) = @_;
 435
 436 =pod
 437
 438 =head2 create_date
 439
 440 Returns the date of creation of the element.
 441
 442 Parameters:
 443
 444 =for html <blockquote>
 445
 446 =over
 447
 448 =item none
 449
 450 =back
 451
 452 =for html </blockquote>
 453
 454 Returns:
 455
 456 =for html <blockquote>
 457
 458 =over
 459
 460 =item create date
 461
 462 =back
 463
 464 =for html </blockquote>
 465
 466 =cut
 467
 468   $self->updateElementInfo
 469     unless $self->{create_date};
 470
 471   return $self->{create_date};
 472 } # create_date
 473
 474 sub group () {
 475   my ($self) = @_;
 476
 477 =pod
 478
 479 =head2 group
 480
 481 Returns the group of the element.
 482
 483 Parameters:
 484
 485 =for html <blockquote>
 486
 487 =over
 488
 489 =item none
 490
 491 =back
 492
 493 =for html </blockquote>
 494
 495 Returns:
 496
 497 =for html <blockquote>
 498
 499 =over
 500
 501 =item group
 502
 503 =back
 504
 505 =for html </blockquote>
 506
 507 =cut
 508
 509   $self->updateElementInfo
 510     unless $self->{group};
 511
 512   return $self->{group};
 513 } # group
 514
 515 sub group_mode () {
 516   my ($self) = @_;
 517
 518 =pod
 519
 520 =head2 group_mode
 521
 522 Returns the group mode of the element
 523
 524 Parameters:
 525
 526 =for html <blockquote>
 527
 528 =over
 529
 530 =item none
 531
 532 =back
 533
 534 =for html </blockquote>
 535
 536 Returns:
 537
 538 =for html <blockquote>
 539
 540 =over
 541
 542 =item group mode
 543
 544 =back
 545
 546 =for html </blockquote>
 547
 548 =cut
 549
 550   $self->describe
 551     unless $self->{group_mode};
 552
 553   return $self->{group_mode};
 554 } # group_mode
 555
 556 sub hyperlinks () {
 557   my ($self) = @_;
 558
 559 =pod
 560
 561 =head2 hyperlinks
 562
 563 Returns a hash of hyperlink name/value pairs
 564
 565 Parameters:
 566
 567 =for html <blockquote>
 568
 569 =over
 570
 571 =item none
 572
 573 =back
 574
 575 =for html </blockquote>
 576
 577 Returns:
 578
 579 =for html <blockquote>
 580
 581 =over
 582
 583 =item Hash of hyperlink name/value pairs
 584
 585 =back
 586
 587 =for html </blockquote>
 588
 589 =cut
 590
 591   $self->describe
 592     unless $self->{hyperlinks};
 593
 594   return @{$self->{hyperlinks}}
 595 } # hyperlinks
 596
 597 sub labels () {
 598   my ($self) = @_;
 599
 600 =pod
 601
 602 =head2 labels
 603
 604 Returns an array of labels
 605
 606 Parameters:
 607
 608 =for html <blockquote>
 609
 610 =over
 611
 612 =item none
 613
 614 =back
 615
 616 =for html </blockquote>
 617
 618 Returns:
 619
 620 =for html <blockquote>
 621
 622 =over
 623
 624 =item Array of labels
 625
 626 =back
 627
 628 =for html </blockquote>
 629
 630 =cut
 631
 632   $self->updateElementInfo
 633     unless $self->{labels};
 634
 635   return @{$self->{labels}};
 636 } # labels
 637
 638 sub mode () {
 639   my ($self) = @_;
 640
 641 =pod
 642
 643 =head2 mode
 644
 645 Returns the numeric mode representing the element's access mode
 646
 647 Parameters:
 648
 649 =for html <blockquote>
 650
 651 =over
 652
 653 =item none
 654
 655 =back
 656
 657 =for html </blockquote>
 658
 659 Returns:
 660
 661 =for html <blockquote>
 662
 663 =over
 664
 665 =item Array of activities
 666
 667 =back
 668
 669 =for html </blockquote>
 670
 671 =cut
 672
 673   $self->describe
 674     unless $self->{mode};
 675
 676   return $self->{mode};
 677 } # mode
 678
 679 sub other_mode () {
 680   my ($self) = @_;
 681
 682 =pod
 683
 684 =head2 other_mode
 685
 686 Returns the mode for other for the element.
 687
 688 Parameters:
 689
 690 =for html <blockquote>
 691
 692 =over
 693
 694 =item none
 695
 696 =back
 697
 698 =for html </blockquote>
 699
 700 Returns:
 701
 702 =for html <blockquote>
 703
 704 =over
 705
 706 =item  A string repesenting the other mode
 707
 708 =back
 709
 710 =for html </blockquote>
 711
 712 =cut
 713
 714   $self->describe
 715     unless $self->{other_mode};
 716
 717   return $self->{other_mode};
 718 } # other_mode
 719
 720 sub pname () {
 721   my ($self) = @_;
 722
 723 =pod
 724
 725 =head2 pname
 726
 727 Returns the pname of the element.
 728
 729 Parameters:
 730
 731 =for html <blockquote>
 732
 733 =over
 734
 735 =item none
 736
 737 =back
 738
 739 =for html </blockquote>
 740
 741 Returns:
 742
 743 =for html <blockquote>
 744
 745 =over
 746
 747 =item pname
 748
 749 =back
 750
 751 =for html </blockquote>
 752
 753 =cut
 754
 755   return $self->{pname};
 756 } # pname
 757
 758 sub pred () {
 759   my ($self) = @_;
 760
 761 =pod
 762
 763 =head2 pred
 764
 765 Returns the predecessor version of this element
 766
 767 Parameters:
 768
 769 =for html <blockquote>
 770
 771 =over
 772
 773 =item none
 774
 775 =back
 776
 777 =for html </blockquote>
 778
 779 Returns:
 780
 781 =for html <blockquote>
 782
 783 =over
 784
 785 =item Predecessor version
 786
 787 =back
 788
 789 =for html </blockquote>
 790
 791 =cut
 792
 793   $self->updateElementInfo
 794     unless $self->{pred};
 795
 796   return $self->{pred};
 797 } # pred
 798
 799 sub rule () {
 800   my ($self) = @_;
 801
 802 =pod
 803
 804 =head2 rule
 805
 806 Returns the config spec rule that selected this element's version.
 807
 808 Parameters:
 809
 810 =for html <blockquote>
 811
 812 =over
 813
 814 =item none
 815
 816 =back
 817
 818 =for html </blockquote>
 819
 820 Returns:
 821
 822 =for html <blockquote>
 823
 824 =over
 825
 826 =item rule
 827
 828 =back
 829
 830 =for html </blockquote>
 831
 832 =cut
 833
 834   return $self->{rule};
 835 } # rule
 836
 837 sub type () {
 838   my ($self) = @_;
 839
 840 =pod
 841
 842 =head2 type
 843
 844 Returns the element's type
 845
 846 Parameters:
 847
 848 =for html <blockquote>
 849
 850 =over
 851
 852 =item none
 853
 854 =back
 855
 856 =for html </blockquote>
 857
 858 Returns:
 859
 860 =for html <blockquote>
 861
 862 =over
 863
 864 =item element type
 865
 866 =back
 867
 868 =for html </blockquote>
 869
 870 =cut
 871
 872   $self->updateElementInfo
 873     unless $self->{type};
 874
 875   return $self->{type};
 876 } # type
 877
 878 sub objkind () {
 879   my ($self) = @_;
 880
 881 =pod
 882
 883 =head2 objkind
 884
 885 Returns the element's object kind
 886
 887 Parameters:
 888
 889 =for html <blockquote>
 890
 891 =over
 892
 893 =item none
 894
 895 =back
 896
 897 =for html </blockquote>
 898
 899 Returns:
 900
 901 =for html <blockquote>
 902
 903 =over
 904
 905 =item element's object kind
 906
 907 =back
 908
 909 =for html </blockquote>
 910
 911 =cut
 912
 913   $self->updateElementInfo
 914     unless $self->{objkind};
 915
 916   return $self->{objkind};
 917 } # objkind
 918
 919 sub oid ($) {
 920   my ($version) = @_;
 921
 922 =pod
 923
 924 =head2 oid
 925
 926 Returns the element's OID
 927
 928 Parameters:
 929
 930 =for html <blockquote>
 931
 932 =over
 933
 934 =item none
 935
 936 =back
 937
 938 =for html </blockquote>
 939
 940 Returns:
 941
 942 =for html <blockquote>
 943
 944 =over
 945
 946 =item element's OID
 947
 948 =back
 949
 950 =for html </blockquote>
 951
 952 =cut
 953
 954   $version .= $Clearcase::SFX
 955     unless $version =~ /$Clearcase::SFX$/;
 956
 957   my ($status, @output) = $Clearcase::CC->execute ('dump "' . $version . '"');
 958
 959   return
 960     unless $status == 0;
 961
 962   @output = grep {/^oid=/} @output;
 963
 964   if ($output[0] =~ /oid=(.+?)\s+/) {
 965     return $1;
 966   } # if
 967 } # oid
 968
 969 sub user () {
 970   my ($self) = @_;
 971
 972 =pod
 973
 974 =head2 user
 975
 976 Returns the username of the owner of this element.
 977
 978 Parameters:
 979
 980 =for html <blockquote>
 981
 982 =over
 983
 984 =item none
 985
 986 =back
 987
 988 =for html </blockquote>
 989
 990 Returns:
 991
 992 =for html <blockquote>
 993
 994 =over
 995
 996 =item user name
 997
 998 =back
 999
1000 =for html </blockquote>
1001
1002 =cut
1003
1004   $self->updateElementInfo
1005     unless $self->{user};
1006
1007   return $self->{user};
1008 } # user
1009
1010 sub user_mode () {
1011   my ($self) = @_;
1012
1013 =pod
1014
1015 =head2 user_mode
1016
1017 Returns the mode for the user for the element.
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 A string repesenting the other mode
1038
1039 =back
1040
1041 =for html </blockquote>
1042
1043 =cut
1044
1045   $self->describe
1046     unless $self->{user_mode};
1047
1048   return $self->{user_mode};
1049 } # user_mode
1050
1051 sub version () {
1052   my ($self) = @_;
1053
1054 =pod
1055
1056 =head2 version
1057
1058 Returns this element's version
1059
1060 Parameters:
1061
1062 =for html <blockquote>
1063
1064 =over
1065
1066 =item none
1067
1068 =back
1069
1070 =for html </blockquote>
1071
1072 Returns:
1073
1074 =for html <blockquote>
1075
1076 =over
1077
1078 =item version
1079
1080 =back
1081
1082 =for html </blockquote>
1083
1084 =cut
1085
1086   return $self->{version};
1087 } # version
1088
1089 sub xname () {
1090   my ($self) = @_;
1091
1092 =pod
1093
1094 =head2 xname
1095
1096 Returns the view extended path name (xname) of an element version.
1097
1098 Parameters:
1099
1100 =for html <blockquote>
1101
1102 =over
1103
1104 =item none
1105
1106 =back
1107
1108 =for html </blockquote>
1109
1110 Returns:
1111
1112 =for html <blockquote>
1113
1114 =over
1115
1116 =item xname
1117
1118 =back
1119
1120 =for html </blockquote>
1121
1122 =cut
1123
1124   $self->updateElementInfo
1125     unless $self->{xname};
1126
1127   return $self->{xname};
1128 } # xname
1129
1130 sub mkelem (;$) {
1131   my ($self, $comment) = @_;
1132
1133 =pod
1134
1135 =head2 mkelem
1136
1137 Returns creates a new element
1138
1139 Parameters:
1140
1141 =for html <blockquote>
1142
1143 =over
1144
1145 =item Comment
1146
1147 Creation comment. Default -nc.
1148
1149 =back
1150
1151 =for html </blockquote>
1152
1153 Returns:
1154
1155 =for html <blockquote>
1156
1157 =over
1158
1159 =item $status
1160
1161 Status from cleartool
1162
1163 =item @output
1164
1165 Ouput from cleartool
1166
1167 =back
1168
1169 =for html </blockquote>
1170
1171 =cut
1172
1173   $comment = Clearcase::_setComment $comment;
1174
1175   return $Clearcase::CC->execute ("mkelem $comment $self->{pname}");
1176 } # mkelem
1177
1178 sub checkout (;$) {
1179   my ($self, $comment) = @_;
1180
1181 =pod
1182
1183 =head2 checkout
1184
1185 Checks out the element
1186
1187 Parameters:
1188
1189 =for html <blockquote>
1190
1191 =over
1192
1193 =item comment
1194
1195 Checkout comment. Default -nc.
1196
1197 =back
1198
1199 =for html </blockquote>
1200
1201 Returns:
1202
1203 =for html <blockquote>
1204
1205 =over
1206
1207 =item $status
1208
1209 Status from cleartool
1210
1211 =item @output
1212
1213 Ouput from cleartool
1214
1215 =back
1216
1217 =for html </blockquote>
1218
1219 =cut
1220
1221   $comment = Clearcase::_setComment $comment;
1222
1223   return $Clearcase::CC->execute ("checkout $comment $self->{pname}");
1224 } # checkout
1225
1226 sub checkin (;$) {
1227   my ($self, $comment) = @_;
1228
1229 =pod
1230
1231 =head2 checkin
1232
1233 Checks in the element
1234
1235 Parameters:
1236
1237 =for html <blockquote>
1238
1239 =over
1240
1241 =item comment
1242
1243 Check in comment. Default -nc.
1244
1245 =back
1246
1247 =for html </blockquote>
1248
1249 Returns:
1250
1251 =for html <blockquote>
1252
1253 =over
1254
1255 =item $status
1256
1257 Status from cleartool
1258
1259 =item @output
1260
1261 Ouput from cleartool
1262
1263 =back
1264
1265 =for html </blockquote>
1266
1267 =cut
1268
1269   $comment = Clearcase::_setComment $comment;
1270
1271   return $Clearcase::CC->execute ("checkin $comment $self->{pname}");
1272 } # checkout
1273
1274 sub updateElementInfo () {
1275   my ($self) = @_;
1276
1277   # Get all information that can be gotten using -fmt
1278   my $fmt = 'Attributes:%aEndAttributes:'
1279           . 'Comment:%cEndComment:'
1280           . 'Create_date:%dEndCreate_date:'
1281           . 'Group:%[group]pEndGroup:'
1282           . 'Labels:%NlEndLabels:'
1283           . 'Pred:%PSnEndPred:'
1284           . 'Type:%[type]pEndType:'
1285           . 'ObjectKind:%mEndObjectKind:'
1286           . 'User:%[owner]pEndUser:'
1287           . 'Xname:%XnEndXname:';
1288
1289   my ($status, @output) =
1290     $Clearcase::CC->execute ("describe -fmt \"$fmt\" $self->{pname}");
1291
1292   return
1293     unless $status == 0;
1294
1295   # We need to make sure that fields are filled in or empty because we are using
1296   # undef as an indication that we have not called updateElementInfo yet.
1297   $self->{attributes} =
1298   $self->{labels} = ();
1299
1300   $self->{comments}    =
1301   $self->{create_date} =
1302   $self->{group}       =
1303   $self->{pred}        =
1304   $self->{type}        =
1305   $self->{objkind}     =
1306   $self->{user}        =
1307   $self->{xname}       = '';
1308
1309   foreach (@output) {
1310     # This output is wrapped with parenthesis...
1311     if (/Attributes:\((.*)\)EndAttributes:/) {
1312       my @attributes = split ", ", $1;
1313       my %attributes;
1314
1315       foreach (@attributes) {
1316         if (/(\w+)=(\w+)/) {
1317           $attributes{$1}=$2;
1318         } # if
1319       } # foreach
1320
1321       $self->{attributes} = %attributes ? \%attributes : ();
1322     } # if
1323
1324     if (/Comments:(.*)EndComments:/) {
1325       $self->{comments} = $1;
1326     } # if
1327
1328     if (/Create_date:(.*)EndCreate_date:/) {
1329       $self->{create_date} = $1;
1330     } # if
1331
1332     if (/Group:(.*)EndGroup:/) {
1333       $self->{group} = $1;
1334     } # if
1335
1336     if (/Labels:(.*)EndLabels:/) {
1337       my @labels = split " ", $1;
1338       $self->{labels} = @labels ? \@labels : ();
1339     } # if
1340
1341     if (/Pred:(.*)EndPred:/) {
1342       $self->{pred} = $1;
1343     } # if
1344
1345     if (/Type:(.*)EndType:/) {
1346       $self->{type} = $1;
1347     } # if
1348
1349     if (/ObjectKind:(.*)EndObjectKind:/) {
1350       $self->{objkind} = $1;
1351     } # if
1352
1353     if (/User:(.*)EndUser:/) {
1354       $self->{user} = $1;
1355     } # if
1356
1357     if (/Xname:(.*)EndXname:/) {
1358       $self->{xname} = $1;
1359     } # if
1360   } # foreach
1361
1362   return;
1363 } # updateElementInfo
1364
1365 1;
1366
1367 =head2 DEPENDENCIES
1368
1369 =head3 ClearSCM Perl Modules
1370
1371 =for html <p><a href="/php/scm_man.php?file=lib/Clearcase.pm">Clearcase</a></p>
1372
1373 =head2 INCOMPATABILITIES
1374
1375 None
1376
1377 =head2 BUGS AND LIMITATIONS
1378
1379 There are no known bugs in this module.
1380
1381 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
1382
1383 =head2 LICENSE AND COPYRIGHT
1384
1385 Copyright (c) 2007, ClearSCM, Inc. All rights reserved.
1386
1387 =cut