lib/Clearcase/UCM/Activity.pm

   1 =pod
   2
   3 =head1 NAME $RCSfile: Activity.pm,v $
   4
   5 Object oriented interface to UCM Activities
   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.10 $
  18
  19 =item Created
  20
  21 Fri May 14 18:16:16 PDT 2010
  22
  23 =item Modified
  24
  25 $Date: 2011/11/15 01:56:40 $
  26
  27 =back
  28
  29 =head1 SYNOPSIS
  30
  31 Provides access to information about Clearcase Activites.
  32
  33  my $activity = new Clearcase::UCM::Activity ($name, $pvob);
  34
  35  my @changeset = $activity->changeset;
  36
  37  foreach my $element (@changeset) {
  38    display "Element name: "    . $element->pname;
  39    display "Element verison: " . $element->version;
  40  } # foreach
  41
  42 =head1 DESCRIPTION
  43
  44 This module implements a UCM Activity object
  45
  46 =head1 ROUTINES
  47
  48 The following routines are exported:
  49
  50 =cut
  51
  52 package Clearcase::UCM::Activity;
  53
  54 use strict;
  55 use warnings;
  56
  57 use lib '../..';
  58
  59 use Clearcase;
  60 use Clearcase::Element;
  61
  62 # We should really inherit these from a more generic super class...
  63 sub _processOpts (%) {
  64   my ($self, %opts) = @_;
  65
  66   my $opts;
  67
  68   foreach (keys %opts) {
  69     if ($_ eq 'cq' or $_ eq 'cqe' or $_ eq 'force' or $_ eq 'nc') {
  70       $opts .= "-$_ ";
  71     } elsif ($_ eq 'c' or $_ eq 'cfile') {
  72       $opts .= "-$_ $opts{$_}";
  73     } # if
  74   } # foreach
  75
  76   return $opts;
  77 } # _processOpts
  78
  79 sub new ($$) {
  80   my ($class, $activity, $pvob) = @_;
  81
  82 =pod
  83
  84 =head2 new
  85
  86 Construct a new Clearcase Activity object.
  87
  88 Parameters:
  89
  90 =for html <blockquote>
  91
  92 =over
  93
  94 =item activity name
  95
  96 Name of activity
  97
  98 =back
  99
 100 =for html </blockquote>
 101
 102 Returns:
 103
 104 =for html <blockquote>
 105
 106 =over
 107
 108 =item Clearcase Activity object
 109
 110 =back
 111
 112 =for html </blockquote>
 113
 114 =cut
 115
 116   my $self = bless {
 117     name => $activity,
 118     pvob => Clearcase::vobtag ($pvob),
 119     type => $activity =~ /^(deliver|rebase)./ ? 'integration' : 'regular',
 120   }, $class; # bless
 121
 122   return $self;
 123 } # new
 124
 125 sub name () {
 126   my ($self) = @_;
 127
 128 =pod
 129
 130 =head2 name
 131
 132 Returns the name of the activity
 133
 134 Parameters:
 135
 136 =for html <blockquote>
 137
 138 =over
 139
 140 =item none
 141
 142 =back
 143
 144 =for html </blockquote>
 145
 146 Returns:
 147
 148 =for html <blockquote>
 149
 150 =over
 151
 152 =item activity's name
 153
 154 =back
 155
 156 =for html </blockquote>
 157
 158 =cut
 159
 160   return $self->{name};
 161 } # name
 162
 163 sub pvob () {
 164   my ($self) = @_;
 165
 166 =pod
 167
 168 =head2 pvob
 169
 170 Returns the pvob of the activity
 171
 172 Parameters:
 173
 174 =for html <blockquote>
 175
 176 =over
 177
 178 =item none
 179
 180 =back
 181
 182 =for html </blockquote>
 183
 184 Returns:
 185
 186 =for html <blockquote>
 187
 188 =over
 189
 190 =item activity's pvob
 191
 192 =back
 193
 194 =for html </blockquote>
 195
 196 =cut
 197
 198   return $self->{pvob};
 199 } # pvob
 200
 201 sub type () {
 202   my ($self) = @_;
 203
 204 =pod
 205
 206 =head2 type
 207
 208 Returns the type of the activity
 209
 210 Parameters:
 211
 212 =for html <blockquote>
 213
 214 =over
 215
 216 =item none
 217
 218 =back
 219
 220 =for html </blockquote>
 221
 222 Returns:
 223
 224 =for html <blockquote>
 225
 226 =over
 227
 228 =item activity's type
 229
 230 =back
 231
 232 =for html </blockquote>
 233
 234 =cut
 235
 236   return $self->{type};
 237 } # type
 238
 239 sub contrib_acts () {
 240   my ($self) = @_;
 241
 242 =pod
 243
 244 =head2 contrib_acts
 245
 246 Returns the contributing activities
 247
 248 Parameters:
 249
 250 =for html <blockquote>
 251
 252 =over
 253
 254 =item none
 255
 256 =back
 257
 258 =for html </blockquote>
 259
 260 Returns:
 261
 262 =for html <blockquote>
 263
 264 =over
 265
 266 =item Array of contributing activities
 267
 268 =back
 269
 270 =for html </blockquote>
 271
 272 =cut
 273
 274   $self->updateActivityInfo () unless $self->{contrib_acts};
 275
 276   return $self->{contrib_acts};
 277 } # crm_record
 278
 279 sub crm_record_id () {
 280   my ($self) = @_;
 281
 282 =pod
 283
 284 =head2 crm_record_id
 285
 286 Returns the crm_record_id of the activity
 287
 288 Parameters:
 289
 290 =for html <blockquote>
 291
 292 =over
 293
 294 =item none
 295
 296 =back
 297
 298 =for html </blockquote>
 299
 300 Returns:
 301
 302 =for html <blockquote>
 303
 304 =over
 305
 306 =item activity's crm_record_id
 307
 308 =back
 309
 310 =for html </blockquote>
 311
 312 =cut
 313
 314   $self->updateActivityInfo () unless $self->{crm_record_id};
 315
 316   return $self->{crm_record_id};
 317 } # crm_record_id
 318
 319 sub crm_record_type () {
 320   my ($self) = @_;
 321
 322 =pod
 323
 324 =head2 crm_record_type
 325
 326 Returns the crm_record_type of the activity
 327
 328 Parameters:
 329
 330 =for html <blockquote>
 331
 332 =over
 333
 334 =item none
 335
 336 =back
 337
 338 =for html </blockquote>
 339
 340 Returns:
 341
 342 =for html <blockquote>
 343
 344 =over
 345
 346 =item activity's crm_record_type
 347
 348 =back
 349
 350 =for html </blockquote>
 351
 352 =cut
 353
 354   $self->updateActivityInfo () unless $self->{crm_record_type};
 355
 356   return $self->{crm_record_type};
 357 } # crm_record_type
 358
 359 sub crm_state () {
 360   my ($self) = @_;
 361
 362 =pod
 363
 364 =head2 crm_state
 365
 366 Returns the crm_state of the activity
 367
 368 Parameters:
 369
 370 =for html <blockquote>
 371
 372 =over
 373
 374 =item none
 375
 376 =back
 377
 378 =for html </blockquote>
 379
 380 Returns:
 381
 382 =for html <blockquote>
 383
 384 =over
 385
 386 =item activity's crm_state
 387
 388 =back
 389
 390 =for html </blockquote>
 391
 392 =cut
 393
 394   $self->updateActivityInfo () unless $self->{crm_state};
 395
 396   return $self->{crm_state};
 397 } # crm_state
 398
 399 sub headline () {
 400   my ($self) = @_;
 401
 402 =pod
 403
 404 =head2 headline
 405
 406 Returns the headline of the activity
 407
 408 Parameters:
 409
 410 =for html <blockquote>
 411
 412 =over
 413
 414 =item none
 415
 416 =back
 417
 418 =for html </blockquote>
 419
 420 Returns:
 421
 422 =for html <blockquote>
 423
 424 =over
 425
 426 =item activity's headline
 427
 428 =back
 429
 430 =for html </blockquote>
 431
 432 =cut
 433
 434   $self->updateActivityInfo () unless $self->{headline};
 435
 436   return $self->{headline};
 437 } # headline
 438
 439 sub name_resolver_view () {
 440   my ($self) = @_;
 441
 442 =pod
 443
 444 =head2 name_resolver_view
 445
 446 Returns the name_resolver_view of the activity
 447
 448 Parameters:
 449
 450 =for html <blockquote>
 451
 452 =over
 453
 454 =item none
 455
 456 =back
 457
 458 =for html </blockquote>
 459
 460 Returns:
 461
 462 =for html <blockquote>
 463
 464 =over
 465
 466 =item activity's name_resolver_view
 467
 468 =back
 469
 470 =for html </blockquote>
 471
 472 =cut
 473
 474   $self->updateActivityInfo () unless $self->{name_resolver_view};
 475
 476   return $self->{name_resolver_view};
 477 } # name_resolver_view
 478
 479 sub stream () {
 480   my ($self) = @_;
 481
 482 =pod
 483
 484 =head2 stream
 485
 486 Returns the stream of the activity
 487
 488 Parameters:
 489
 490 =for html <blockquote>
 491
 492 =over
 493
 494 =item none
 495
 496 =back
 497
 498 =for html </blockquote>
 499
 500 Returns:
 501
 502 =for html <blockquote>
 503
 504 =over
 505
 506 =item activity's stream
 507
 508 =back
 509
 510 =for html </blockquote>
 511
 512 =cut
 513
 514   $self->updateActivityInfo () unless $self->{stream};
 515
 516   return $self->{stream};
 517 } # stream
 518
 519 sub changeset (;$) {
 520   my ($self, $recalc) = @_;
 521
 522 =pod
 523
 524 =head2 changeset
 525
 526 Returns the changeset of the activity
 527
 528 Parameters:
 529
 530 =for html <blockquote>
 531
 532 =over
 533
 534 =item none
 535
 536 =back
 537
 538 =for html </blockquote>
 539
 540 Returns:
 541
 542 =for html <blockquote>
 543
 544 =over
 545
 546 =item An array containing Clearcase::Element objects.
 547
 548 =back
 549
 550 =for html </blockquote>
 551
 552 =cut
 553
 554   if ($self->{changeset}) {
 555     return $self->{changeset} unless ($recalc);
 556   } # if
 557
 558   my $pvob = Clearcase::vobtag $self->{pvob};
 559
 560   my $cmd = "lsact -fmt \"%[versions]CQp\" $self->{name}\@$pvob";
 561
 562   my ($status, @output) = $Clearcase::CC->execute ($cmd);
 563
 564   return ($status, @output)
 565     if $status;
 566
 567   # Need to split up change set. It's presented to us as quoted and space
 568   # separated however the change set elements themselves can have spaces in
 569   # them! e.g.:
 570   #
 571   #   "/vob/foo/file name with spaces@@/main/1", "/vob/foo/file name2@@/main/2"
 572   #
 573   # So we'll split on '", ""'! Note that this will leave us with the first
 574   # element with a leading '"' and the last element with a trailing '"' which
 575   # we will have to handle.
 576   #
 577   # Additionally we will call collapseOverExtendedViewPathname to normalize
 578   # the over extended pathnames to element hashes.
 579   my (@changeset);
 580
 581   @output = split /\", \"/, $output[0]
 582     if $output[0];
 583
 584   foreach (@output) {
 585     # Skip any cleartool warnings. We are getting warnings of the form:
 586     # "A version in the change set of activity "63332.4" is currently
 587     # unavailable". Probably some sort of subtle corruption that we can ignore.
 588     # (It should be fixed but we aren't going to be doing that here!)
 589     next if /cleartool: Warning/;
 590
 591     # Strip any remaining '"'s
 592     s/^\"//; s/\"$//;
 593
 594     my %element = Clearcase::Element::collapseOverExtendedVersionPathname $_;
 595     my $element = Clearcase::Element->new ($element{name});
 596
 597     # Sometimes $element{name} refers to a long path name we can't easily see
 598     # in our current view. In such cases the above Clearcase::Element->new will
 599     # return us an element where the version is missing. Since we already have
 600     # the version information we will replace it here.
 601     #
 602     # The following may look odd since we use similar names against different
 603     # Perl variables. $element->{version} means look into the $element object
 604     # returned from new above at the member version. $element{version} says
 605     # refer to the %element hash defined above for the version key. And finally
 606     # $element->version says call the method version of the element object.
 607     # So we are saying, if the version member of the element object is not
 608     # defined (i.e. $element->version) then set it (i.e. $element->{version})
 609     # by using the value of the hash %element with the key version.
 610     $element->{version} = $element{version}
 611       unless $element->version;
 612
 613     # Additionally we will set into the $element object the extended name. This
 614     # is the long pathname that we need to use from our current context to be
 615     # able to access the element.
 616     #$element->setExtendedName ($_);
 617
 618     push @changeset, $element;
 619   } # foreach
 620
 621   $self->{changeset} = \@changeset;
 622
 623   return @changeset;
 624 } # changeset
 625
 626 sub create ($$$;$) {
 627   my ($self, $stream, $pvob, $headline, $opts) = @_;
 628
 629 =pod
 630
 631 =head2 create
 632
 633 Creates a new UCM Activity
 634
 635 Parameters:
 636
 637 =for html <blockquote>
 638
 639 =over
 640
 641 =item UCM Stream (required)
 642
 643 UCM stream this activities is to be created on
 644
 645 =item PVOB (Required)
 646
 647 Project Vob
 648
 649 =item headline
 650
 651 Headline to associate with this activity
 652
 653 =back
 654
 655 =for html </blockquote>
 656
 657 Returns:
 658
 659 =for html <blockquote>
 660
 661 =over
 662
 663 =item $status
 664
 665 Status from cleartool
 666
 667 =item @output
 668
 669 Ouput from cleartool
 670
 671 =back
 672
 673 =for html </blockquote>
 674
 675 =cut
 676
 677   # Fill in members
 678   $self->{stream}   = $stream;
 679   $self->{pvob}     = $pvob;
 680
 681   # TODO: Should quote $headline to protect from special characters
 682   $self->{headline} = $headline;
 683
 684   # Fill in opts
 685   $opts ||= '';
 686   $opts .= " -headline '$headline'"
 687     if $headline;
 688
 689   # TODO: This should call the exists function
 690   # Return the stream name if the stream already exists
 691   my ($status, @output) =
 692     $Clearcase::CC->execute ('lsact -short ' . $self->{name});
 693
 694   return ($status, @output)
 695     unless $status;
 696
 697   # Need to create the stream
 698   return $Clearcase::CC->execute
 699     ("mkactivity $opts -in " . $stream .
 700      "\@"                    . $pvob   .
 701      ' '                     . $self->{name});
 702 } # create
 703
 704 sub remove () {
 705   my ($self) = @_;
 706
 707 =pod
 708
 709 =head2 remove
 710
 711 Removes UCM Activity
 712
 713 Parameters:
 714
 715 =for html <blockquote>
 716
 717 =over
 718
 719 =item none
 720
 721 =back
 722
 723 =for html </blockquote>
 724
 725 Returns:
 726
 727 =for html <blockquote>
 728
 729 =over
 730
 731 =item $status
 732
 733 Status from cleartool
 734
 735 =item @output
 736
 737 Ouput from cleartool
 738
 739 =back
 740
 741 =for html </blockquote>
 742
 743 =cut
 744
 745   return $Clearcase::CC->execute
 746     ('rmactivity -f ' . $self->{name} . "\@" . $self->{pvob});
 747 } # remove
 748
 749 sub attributes (;%) {
 750   my ($self, %newAttribs) = @_;
 751
 752 =pod
 753
 754 =head2 attributes
 755
 756 Returns a hash of the attributes associated with an activity
 757
 758 Parameters:
 759
 760 =for html <blockquote>
 761
 762 =over
 763
 764 =item none
 765
 766 =back
 767
 768 =for html </blockquote>
 769
 770 Returns:
 771
 772 =for html <blockquote>
 773
 774 =over
 775
 776 =item %attributes
 777
 778 Hash of attributes for this activity
 779
 780 =back
 781
 782 =for html </blockquote>
 783
 784 =cut
 785
 786   return $self->Clearcase::attributes (
 787     'activity',
 788     "$self->{name}\@" . Clearcase::vobtag ($self->{pvob}),
 789     %newAttribs,
 790   );
 791 } # attributes
 792
 793 sub updateActivityInfo () {
 794   my ($self) = @_;
 795
 796   # Get all information that can be gotten using -fmt
 797   my $fmt .= '%[crm_record_id]p==';
 798      $fmt .= '%[crm_record_type]p==';
 799      $fmt .= '%[crm_state]p==';
 800      $fmt .= '%[headline]p==';
 801      $fmt .= '%[name_resolver_view]p==';
 802      $fmt .= '%[stream]Xp==';
 803      $fmt .= '%[view]p';
 804
 805   if ($self->type eq 'integration') {
 806     $fmt  = '%[contrib_acts]CXp==';
 807   } # if
 808
 809   $Clearcase::CC->execute (
 810     "lsactivity -fmt \"$fmt\" $self->{name}@" . Clearcase::vobtag ($self->{pvob})
 811   );
 812
 813   # Assuming this activity is an empty shell of an object that the user may
 814   # possibly use the create method on, return our blessings...
 815   return if $Clearcase::CC->status;
 816
 817   # We need to make sure that fields are filled in or empty because we are using
 818   # undef as an indication that we have not called updateActivityInfo yet.
 819   my @fields = split '==', $Clearcase::CC->output;
 820
 821   $self->{crm_record_id}      = $fields[0];
 822   $self->{crm_record_type}    = $fields[1];
 823   $self->{crm_state}          = $fields[2];
 824   $self->{headline}           = $fields[3];
 825   $self->{name_resolver_view} = $fields[4];
 826   $self->{stream}             = $fields[5];
 827   $self->{view}               = $fields[6];
 828
 829   $self->{contrib_acts}       = ();
 830
 831   if ($self->type eq 'integration') {
 832     foreach (split ', ', $fields[7]) {
 833       push @{$self->{contrib_acts}}, Clearcase::UCM::Activity->new ($_);
 834     } # foreach
 835   } # if
 836
 837   return;
 838 } # updateActivityInfo
 839
 840 1;
 841
 842 =head1 DEPENDENCIES
 843
 844 =head2 ClearSCM Perl Modules
 845
 846 =for html <p><a href="/php/cvs_man.php?file=lib/Clearcase.pm">Clearcase</a></p>
 847
 848 =head1 INCOMPATABILITIES
 849
 850 None
 851
 852 =head1 BUGS AND LIMITATIONS
 853
 854 There are no known bugs in this module.
 855
 856 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
 857
 858 =head1 LICENSE AND COPYRIGHT
 859
 860 Copyright (c) 2007, ClearSCM, Inc. All rights reserved.
 861
 862 =cut