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