CCDB/lib/CCDB.pm

   1 =pod
   2
   3 =head1 NAME $RCSfile: CCDB.pm,v $
   4
   5 Object oriented interface to CCDB.
   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.4 $
  18
  19 =item Created
  20
  21 Wed Mar  9 17:03:48 PST 2011
  22
  23 =item Modified
  24
  25 $Date: 2011/04/15 22:27:45 $
  26
  27 =back
  28
  29 =head1 SYNOPSIS
  30
  31 Provides the CCDB object which handles all interaction with the CCDB
  32 database. Similar add/change/delete/update methods for other record types. In
  33 general you must orient your record hashs to have the appropriately named
  34 keys that correspond to the database. Also see method documentation for
  35 specifics about the method you are envoking.
  36
  37  # Create new CCDB object
  38  my $ccdb= new CCDB;
  39
  40  # Add a new system
  41  my %project= (
  42   name        => 'The Next Thing',
  43   pvob        => '8800_projects',
  44   description => 'This is the greatest thing since sliced bread',
  45  );
  46
  47  my ($err, $msg) = $CCDB->AddProject (%project);
  48
  49  # Find projects matching '8800'
  50  my @projects = $ccdb->FindProject ('8800');
  51
  52  # Get a project by name
  53  my %project = $ccdb->GetProject ('8800_projects');
  54
  55  # Update project
  56  my %update = (
  57   'description' => 'Greatest thing since the net!',
  58  );
  59
  60  my ($err, $msg) = $ccdb->UpdateProject ('8800_projects', %update);
  61
  62  # Delete project (Warning: will delete all related records regarding this
  63  # project).
  64  my ($err, $msg) = $ccdb->DeleteProject ('8800_projects');
  65
  66 =head1 DESCRIPTION
  67
  68 This package provides and object oriented interface to the CCDB database.
  69 Methods are provided to manipulate records by adding, updating and deleting
  70 them. In general you need to specify a hash which contains keys and values
  71 corresponding to the database field names and values.
  72
  73 =head1 ROUTINES
  74
  75 The following methods are available:
  76
  77 =cut
  78
  79 package CCDB;
  80
  81 use strict;
  82 use warnings;
  83
  84 use Carp;
  85 use DBI;
  86
  87 use FindBin;
  88
  89 use lib "$FindBin::Bin/../../lib";
  90
  91 use Clearcase;
  92 use DateUtils;
  93 use Display;
  94 use GetConfig;
  95
  96 our %CCDBOPTS = GetConfig ("$FindBin::Bin/../etc/ccdb.conf");
  97
  98 $CCDBOPTS{CCDB_MY_CNF} = "$FindBin::Bin/etc/$CCDBOPTS{CCDB_MY_CNF}";
  99
 100 # Globals
 101 our $VERSION  = '$Revision: 1.4 $';
 102    ($VERSION) = ($VERSION =~ /\$Revision: (.*) /);
 103
 104 $CCDBOPTS{CCDB_USERNAME} = $ENV{CCDB_USERNAME}
 105                          ? $ENV{CCDB_USERNAME}
 106                          : $CCDBOPTS{CCDB_USERNAME}
 107                          ? $CCDBOPTS{CCDB_USERNAME}
 108                          : '<specify username>';
 109 $CCDBOPTS{CCDB_PASSWORD} = $ENV{CCDB_PASSWORD}
 110                          ? $ENV{CCDB_PASSWORD}
 111                          : $CCDBOPTS{CCDB_PASSWORD}
 112                          ? $CCDBOPTS{CCDB_PASSWORD}
 113                          : '<specify password>';
 114 $CCDBOPTS{CCDB_SERVER}   = $ENV{CCDB_SERVER}
 115                          ? $ENV{CCDB_SERVER}
 116                          : $CCDBOPTS{CCDB_SERVER}
 117                          ? $CCDBOPTS{CCDB_SERVER}
 118                          : '<specify server>';
 119
 120 # Internal methods
 121 sub _dberror ($$) {
 122   my ($self, $msg, $statement) = @_;
 123
 124   my $dberr    = $self->{db}->err;
 125   my $dberrmsg = $self->{db}->errstr;
 126
 127   $dberr    ||= 0;
 128   $dberrmsg ||= 'Success';
 129
 130   my $message = '';
 131
 132   if ($dberr) {
 133     my $function = (caller (1)) [3];
 134
 135     $message = "$function: $msg\nError #$dberr: $dberrmsg\n"
 136              . "SQL Statement: $statement";
 137   } # if
 138
 139   return $dberr, $message;
 140 } # _dberror
 141
 142 sub _formatValues (@) {
 143   my ($self, @values) = @_;
 144
 145   my @returnValues;
 146
 147   # Quote data values
 148   foreach (@values) {
 149     if ($_) {
 150       unless ($_ eq '') {
 151         push @returnValues, $self->{db}->quote ($_);
 152         next;
 153       } # unless
 154     } # if
 155
 156     push @returnValues, 'null';
 157   } # foreach
 158
 159   return @returnValues;
 160 } # _formatValues
 161
 162 sub _formatNameValues (%) {
 163   my ($self, %rec) = @_;
 164
 165   my @nameValueStrs;
 166
 167   push @nameValueStrs, "$_=" . $self->{db}->quote ($rec{$_})
 168     foreach (keys %rec);
 169
 170   return @nameValueStrs;
 171 } # _formatNameValues
 172
 173 sub _addRecord ($%) {
 174   my ($self, $table, %rec) = @_;
 175
 176   my $statement  = "insert into $table (";
 177      $statement .= join ',', keys %rec;
 178      $statement .= ') values (';
 179      $statement .= join ',', $self->_formatValues (values %rec);
 180      $statement .= ')';
 181
 182   $self->{db}->do ($statement);
 183
 184   return $self->_dberror ("Unable to add record to $table", $statement);
 185 } # _addRecord
 186
 187 sub _deleteRecord ($;$) {
 188   my ($self, $table, $condition) = @_;
 189
 190   my $count;
 191
 192   my $statement  = "select count(*) from $table ";
 193      $statement .= "where $condition"
 194       if $condition;
 195
 196   my $sth = $self->{db}->prepare ($statement)
 197     or return $self->_dberror ('Unable to prepare statement', $statement);
 198
 199   $sth->execute
 200     or return $self->_dberror ('Unable to execute statement', $statement);
 201
 202   my @row = $sth->fetchrow_array;
 203
 204   $sth->finish;
 205
 206   if ($row[0]) {
 207     $count = $row[0];
 208   } else {
 209     $count = 0;
 210   } # if
 211
 212   return ($count, 'Records deleted')
 213     if $count == 0;
 214
 215   $statement  = "delete from $table ";
 216   $statement .= "where $condition"
 217     if $condition;
 218
 219   $self->{db}->do ($statement);
 220
 221   if ($self->{db}->err) {
 222     return $self->_dberror ("Unable to delete record from $table", $statement);
 223   } else {
 224     return $count, 'Records deleted';
 225   } # if
 226 } # _deleteRecord
 227
 228 sub _updateRecord ($$%) {
 229   my ($self, $table, $condition, %rec) = @_;
 230
 231   my $statement  = "update $table set ";
 232      $statement .= join ',', $self->_formatNameValues (%rec);
 233      $statement .= " where $condition"
 234        if $condition;
 235
 236   $self->{db}->do ($statement);
 237
 238   return $self->_dberror ("Unable to update record in $table", $statement);
 239 } # _updateRecord
 240
 241 sub _checkRequiredFields ($$) {
 242   my ($fields, $rec) = @_;
 243
 244   foreach my $fieldname (@$fields) {
 245     my $found = 0;
 246
 247     foreach (keys %$rec) {
 248       if ($fieldname eq $_) {
 249          $found = 1;
 250          last;
 251       } # if
 252     } # foreach
 253
 254     return "$fieldname is required"
 255       unless $found;
 256   } # foreach
 257
 258   return;
 259 } # _checkRequiredFields
 260
 261 sub _getRecords ($$) {
 262   my ($self, $table, $condition) = @_;
 263
 264   my ($err, $msg);
 265
 266   my $statement = "select * from $table where $condition";
 267
 268   my $sth = $self->{db}->prepare ($statement);
 269
 270   unless ($sth) {
 271     ($err, $msg) = $self->_dberror ('Unable to prepare statement', $statement);
 272
 273     croak $msg;
 274   } # if
 275
 276   my $status = $sth->execute;
 277
 278   unless ($status) {
 279     ($err, $msg) = $self->_dberror ('Unable to execute statement', $statement);
 280
 281     croak $msg;
 282   } # if
 283
 284   my @records;
 285
 286   while (my $row = $sth->fetchrow_hashref) {
 287     push @records, $row;
 288   } # while
 289
 290   return @records;
 291 } # _getRecord
 292
 293 sub _getLastID () {
 294   my ($self) = @_;
 295
 296   my $statement = 'select last_insert_id()';
 297
 298   my $sth = $self->{db}->prepare ($statement);
 299
 300   my ($err, $msg);
 301
 302   unless ($sth) {
 303     ($err, $msg) = $self->_dberror ('Unable to prepare statement', $statement);
 304
 305     croak $msg;
 306   } # if
 307
 308   my $status = $sth->execute;
 309
 310   unless ($status) {
 311     ($err, $msg) = $self->_dberror ('Unable to execute statement', $statement);
 312
 313     croak $msg;
 314   } # if
 315
 316   my @records;
 317
 318   my @row = $sth->fetchrow_array;
 319
 320   return $row[0];
 321 } # _getLastID
 322
 323 sub new (;$) {
 324   my ($class, $dbserver) = @_;
 325
 326   $dbserver ||= $CCDBOPTS{CCDB_SERVER};
 327
 328   my $self = bless {}, $class;
 329
 330   my $dbname   = 'ccdb';
 331   my $dbdriver = 'mysql';
 332
 333   $self->{db} = DBI->connect (
 334     "DBI:$dbdriver:$dbname:$dbserver;"
 335   . "mysql_read_default_file=$CCDBOPTS{CCDB_MY_CNF}",
 336     $CCDBOPTS{CCDB_USERNAME},
 337     $CCDBOPTS{CCDB_PASSWORD},
 338     {PrintError => 0},
 339   ) or croak (
 340     "Couldn't connect to $dbname database "
 341   . "as $CCDBOPTS{CCDB_USERNAME}\@$dbserver\nDBERR: $DBI::errstr"
 342   );
 343
 344   return $self;
 345 } # new
 346
 347 sub AddRecord ($$$) {
 348   my ($self, $record, $required, $data) = @_;
 349
 350   my $Record         = ucfirst $record;
 351   my @requiredFields = @$required;
 352
 353   unless (ref $data eq 'HASH') {
 354     my $VAR1;
 355
 356     eval $data;
 357
 358     $data = $VAR1;
 359   } # unless
 360
 361   my %data = %$data;
 362
 363   # Determine oid if necessary
 364   unless ($data{oid}) {
 365     if ($record eq 'activity'
 366      or $record eq 'baseline'
 367      or $record eq 'folder',
 368      or $record eq 'project'
 369      or $record eq 'stream'
 370      or $record eq 'replica'
 371      or $record eq 'vob') {
 372
 373       if ($record eq 'vob') {
 374         $data{oid} = $Clearcase::CC->name2oid (
 375           'vob:' . Clearcase::vobtag ($data{name})
 376         );
 377       } elsif ($record eq 'replica') {
 378         $data{oid} = $Clearcase::CC->name2oid (
 379           "replica:$data{replica}", $data{vob}
 380         );
 381       } else {
 382         $data{oid} = $Clearcase::CC->name2oid (
 383           "$record:$data{name}", $data{pvob}
 384         );
 385       } # if
 386     } # if
 387   } # unless
 388
 389   my $result = _checkRequiredFields \@requiredFields, \%data;
 390
 391   return -1, "Add$Record: $result"
 392     if $result;
 393
 394   return $self->_addRecord ($record, %data);
 395 } # AddRecord
 396
 397 sub DeleteRecord ($$$) {
 398   my ($self, $table, $keyname, $keyvalue) = @_;
 399
 400   # If $keyname is an array then we have multiple keys in the database. When
 401   # this is the case we assume that both $keyname and $keyvalue are references
 402   # to equal sized name/value pairs and we construct the condition in the form
 403   # of "<keyname1>=<keyvalue1> and <keyname2>=<keyvalue2>..."
 404   my $condition;
 405
 406   if (ref $keyname eq 'ARRAY') {
 407     for (my $i = 0; $i < @$keyname; $i++) {
 408       unless ($condition) {
 409         $condition = "$$keyname[$i]='$$keyvalue[$i]'"
 410       } else {
 411         $condition .= " and $$keyname[$i]='$$keyvalue[$i]'"
 412       } # if
 413     } # for
 414   } else {
 415     $condition = "$keyname='$keyvalue'";
 416   } # if
 417
 418   return $self->_deleteRecord ($table, $condition);
 419 } # DeleteRecord
 420
 421 sub UpdateRecord ($$$$) {
 422   my ($self, $table, $keyname, $keyvalue, $update) = @_;
 423
 424   # If $keyname is an array then we have multiple keys in the database. When
 425   # this is the case we assume that both $keyname and $keyvalue are references
 426   # to equal sized name/value pairs and we construct the condition in the form
 427   # of "<keyname1>=<keyvalue1> and <keyname2>=<keyvalue2>..."
 428   my $condition;
 429
 430   if (ref $keyname eq 'ARRAY') {
 431     for (my $i = 0; $i < @$keyname; $i++) {
 432       unless ($condition) {
 433         $condition = "$$keyname[$i] like '$$keyvalue[$i]'"
 434       } else {
 435         $condition .= " and $$keyname[$i] like '$$keyvalue[$i]'"
 436       } # if
 437     } # for
 438   } else {
 439     $condition = "$keyname like '$keyvalue'";
 440   } # if
 441
 442   unless (ref $update eq 'HASH') {
 443     my $VAR1;
 444
 445     eval $update;
 446
 447     $update = $VAR1;
 448   } # unless
 449
 450   my %update = %$update;
 451
 452   return $self->_updateRecord ($table, $condition, %update);
 453 } # UpdateRecord
 454
 455 sub GetRecord ($$$) {
 456   my ($self, $table, $keyname, $keyvalue) = @_;
 457
 458   # If $keyname is an array then we have multiple keys in the database. When
 459   # this is the case we assume that both $keyname and $keyvalue are references
 460   # to equal sized name/value pairs and we construct the condition in the form
 461   # of "<keyname1>=<keyvalue1> and <keyname2>=<keyvalue2>..."
 462   my $condition;
 463
 464   if (ref $keyname eq 'ARRAY') {
 465     for (my $i = 0; $i < @$keyname; $i++) {
 466       $$keyvalue[$i] ||= '';
 467
 468       unless ($condition) {
 469         $condition = "$$keyname[$i]='$$keyvalue[$i]'"
 470       } else {
 471         $condition .= " and $$keyname[$i]='$$keyvalue[$i]'"
 472       } # if
 473     } # for
 474   } else {
 475     $condition = "$keyname='$keyvalue'";
 476   } # if
 477
 478   my @records = $self->_getRecords ($table, $condition);
 479
 480   if ($records[0]) {
 481     return %{$records[0]};
 482   } else {
 483     return;
 484   } # if
 485 } # GetRecord
 486
 487 sub FindRecord ($$$;$) {
 488   my ($self, $table, $keyname, $keyvalue, $additional) = @_;
 489
 490   # If $keyname is an array then we have multiple keys in the database. When
 491   # this is the case we assume that both $keyname and $keyvalue are references
 492   # to equal sized name/value pairs and we construct the condition in the form
 493   # of "<keyname1> like <keyvalue1> and <keyname2> like <keyvalue2>..."
 494   my $condition;
 495
 496   if (ref $keyname eq 'ARRAY') {
 497     for (my $i = 0; $i < @$keyname; $i++) {
 498       $$keyvalue[$i] ||= '';
 499       $$keyvalue[$i] = '' if $$keyvalue[$i] eq '*';
 500
 501       unless ($condition) {
 502         $condition = "$$keyname[$i] like '%$$keyvalue[$i]%'"
 503       } else {
 504         $condition .= " and $$keyname[$i] like '%$$keyvalue[$i]%'"
 505       } # if
 506     } # for
 507   } else {
 508     $keyvalue ||= '';
 509     $keyvalue = '' if $keyvalue eq '*';
 510     $condition = "$keyname like '%$keyvalue%'";
 511   } # if
 512
 513   return $self->_getRecords ($table, $condition);
 514 } # FindRecord
 515
 516 sub AddProject ($) {
 517   my ($self, $data) = @_;
 518
 519   return $self->AddRecord (
 520     'project',
 521     ['name', 'folder', 'pvob'],
 522     $data
 523   );
 524 } # AddProject
 525
 526 sub DeleteProject ($$$) {
 527   my ($self, $name, $folder, $pvob) = @_;
 528
 529   return $self->DeleteRecord (
 530     'project',
 531     ['name', 'folder', 'pvob'],
 532     [$name, $folder, $pvob]
 533   );
 534 } # DeleteProject
 535
 536 sub UpdateProject ($$$$) {
 537   my ($self, $name, $folder, $pvob, $update) = @_;
 538
 539   return $self->UpdateRecord (
 540     'project',
 541     ['name', 'folder', 'pvob'],
 542     [$name, $folder, $pvob],
 543     $update
 544   );
 545 } # UpdateRegistry
 546
 547 sub GetProject ($) {
 548   my ($self, $name, $folder, $pvob) = @_;
 549
 550   return $self->GetRecord (
 551     'project',
 552     ['name', 'folder', 'pvob'],
 553     [$name, $folder, $pvob]
 554   );
 555 } # GetProject
 556
 557 sub FindProject (;$$$) {
 558   my ($self, $name, $folder, $project, $pvob) = @_;
 559
 560   return $self->FindRecord (
 561     'project',
 562     ['name', 'folder', 'pvob'],
 563     [$name, $folder, $pvob]
 564   );
 565 } # FindProject
 566
 567 sub AddRegistry ($) {
 568   my ($self, $data) = @_;
 569
 570   return $self->AddRecord (
 571     'registry',
 572     ['name'],
 573     $data
 574   );
 575 } # AddRegistry
 576
 577 sub DeleteRegistry ($) {
 578   my ($self, $name) = @_;
 579
 580   return $self->DeleteRecord ('registry', 'name', $name);
 581 } # DeleteRegistry
 582
 583 sub UpdateRegistry ($$) {
 584   my ($self, $name, $update) = @_;
 585
 586   return $self->UpdateRecord ('registry', 'name', $name, $update);
 587 } # UpdateRegistry
 588
 589 sub GetRegistry ($) {
 590   my ($self, $name) = @_;
 591
 592   return $self->GetRecord ('registry', 'name', $name);
 593 } # GetRegistry
 594
 595 sub FindRegistry (;$) {
 596   my ($self, $name) = @_;
 597
 598   return $self->FindRecord ('registry', 'name', $name);
 599 } # FindRegistry
 600
 601 sub AddStream ($) {
 602   my ($self, $data) = @_;
 603
 604   # TODO: We should probably make sure that things like $$data{pvob} and
 605   # $$data{name} exist in $data first. Maybe add the record (which checks for
 606   # required fields) then perform an update to update the type to intergration
 607   # IFF this is an intergration stream.
 608
 609   # Determine the integration stream for this stream's project. First get
 610   # project for the stream.
 611   my $pvobTag = Clearcase::vobtag ($$data{pvob});
 612   my $cmd     = "lsstream -fmt \"%[project]p\" $$data{name}\@$pvobTag";
 613
 614   my ($status, @output) = $Clearcase::CC->execute ($cmd);
 615
 616   if ($status == 0) {
 617     my $project = $output[0];
 618
 619     # Now get the intergration stream for this project
 620     $cmd = "lsproject -fmt \"%[istream]p\" $project\@$pvobTag";
 621
 622     ($status, @output) = $Clearcase::CC->execute ($cmd);
 623
 624     if ($status == 0) {
 625       $$data{type} = 'integration'
 626         if $$data{name} eq $output[0];
 627     } # if
 628   } # if
 629
 630   return $self->AddRecord (
 631     'stream',
 632     ['name', 'pvob'],
 633     $data
 634   );
 635 } # AddStream
 636
 637 sub DeleteStream ($$) {
 638   my ($self, $name, $pvob) = @_;
 639
 640   return $self->DeleteRecord (
 641     'stream',
 642     ['name', 'pvob'],
 643     [$name, $pvob],
 644   );
 645 } # DeleteStream
 646
 647 sub DeleteStreamOID ($) {
 648   my ($self, $oid) = @_;
 649
 650   return $self->DeleteRecord (
 651     'stream',
 652     'oid',
 653     $oid
 654   );
 655 } # DeleteStreamOID
 656
 657 sub UpdateStream ($$$) {
 658   my ($self, $name, $pvob, $update) = @_;
 659
 660   return $self->UpdateRecord (
 661     'stream',
 662     ['name', 'pvob'],
 663     [$name, $pvob],
 664     $update
 665   );
 666 } # UpdateStream
 667
 668 sub GetStream ($$) {
 669   my ($self, $name, $pvob) = @_;
 670
 671   return $self->GetRecord (
 672     'stream',
 673     ['name', 'pvob'],
 674     [$name, $pvob],
 675   );
 676 } # GetRegistry
 677
 678 sub FindStream (;$$) {
 679   my ($self, $name, $pvob) = @_;
 680
 681   return $self->FindRecord (
 682     'stream',
 683     ['name', 'pvob'],
 684     [$name, $pvob]
 685   );
 686 } # FindRegistry
 687
 688 sub AddSubfolder ($) {
 689   my ($self, $data) = @_;
 690
 691   return $self->AddRecord (
 692     'subfolder',
 693     ['parent', 'subfolder', 'pvob'],
 694     $data
 695   );
 696 } # AddSubfolder
 697
 698 sub DeleteSubfolder ($$$) {
 699   my ($self, $parent, $subfolder, $pvob) = @_;
 700
 701   return $self->DeleteRecord (
 702     'subfolder',
 703     ['parent', 'subfolder', 'pvob'],
 704     [$parent, $subfolder, $pvob],
 705   );
 706 } # DeleteSubfolder
 707
 708 sub UpdateSubfolder ($$$$) {
 709   my ($self, $parent, $subfolder, $pvob, $update) = @_;
 710
 711   return $self->UpdateRecord (
 712     'subfolder',
 713     ['parent', 'subfolder', 'pvob'],
 714     [$parent, $subfolder, $pvob],
 715     $update
 716   );
 717 } # UpdateSubfolder
 718
 719 sub GetSubfolder ($$$) {
 720   my ($self, $parent, $subfolder, $pvob) = @_;
 721
 722   return $self->GetRecord (
 723     'subfolder',
 724     ['parent', 'subfolder', 'pvob'],
 725     [$parent, $subfolder, $pvob],
 726   );
 727 } # GetSubfolder
 728
 729 sub FindSubfolder (;$$$) {
 730   my ($self, $parent, $subfolder, $pvob) = @_;
 731
 732   return $self->FindRecord (
 733     'subfolder',
 734     ['parent', 'subfolder', 'pvob'],
 735     [$parent, $subfolder, $pvob]
 736   );
 737 } # FindFolder
 738
 739 sub AddActivity ($) {
 740   my ($self, $data) = @_;
 741
 742   if ($$data{name}) {
 743     $$data{type} = 'integration'
 744       if $$data{name} =~ /^(deliver|rebase|integrate|revert|tlmerge)/i;
 745   } # if
 746
 747   return $self->AddRecord (
 748     'activity',
 749     ['name', 'pvob'],
 750     $data
 751   );
 752 } # AddActivity
 753
 754 sub DeleteActivity ($$) {
 755   my ($self, $name, $pvob) = @_;
 756
 757   return $self->DeleteRecord (
 758     'activity',
 759     ['name', 'pvob'],
 760     [$name, $pvob],
 761   );
 762 } # DeleteActivity
 763
 764 sub DeleteActivityOID ($) {
 765   my ($self, $oid) = @_;
 766
 767   return $self->DeleteRecord (
 768     'activity',
 769     'name',
 770     $oid
 771   );
 772 } # DeleteActivityOID
 773
 774 sub UpdateActivity ($$$) {
 775   my ($self, $name, $pvob, $update) = @_;
 776
 777   return $self->UpdateRecord (
 778     'activity',
 779     ['name', 'pvob'],
 780     [$name, $pvob],
 781     $update
 782   );
 783 } # UpdateActivity
 784
 785 sub GetActivity ($$) {
 786   my ($self, $name, $pvob) = @_;
 787
 788   return $self->GetRecord (
 789     'activity',
 790     ['name', 'pvob'],
 791     [$name, $pvob],
 792   );
 793 } # GetActivity
 794
 795 sub FindActivity (;$$) {
 796   my ($self, $name, $pvob) = @_;
 797
 798   return $self->FindRecord (
 799     'activity',
 800     ['name', 'pvob'],
 801     [$name, $pvob]
 802   );
 803 } # FindActivity
 804
 805 sub AddBaseline ($) {
 806   my ($self, $data) = @_;
 807
 808   return $self->AddRecord (
 809     'baseline',
 810     ['name', 'pvob'],
 811     $data
 812   );
 813 } # AddBaseline
 814
 815 sub DeleteBaseline ($$) {
 816   my ($self, $name, $pvob) = @_;
 817
 818   return $self->DeleteRecord (
 819     'baseline',
 820     ['name', 'pvob'],
 821     [$name, $pvob],
 822   );
 823 } # DeleteBaseline
 824
 825 sub DeleteBaselineOID ($) {
 826   my ($self, $oid) = @_;
 827
 828   return $self->DeleteRecord (
 829     'baseline',
 830     'oid',
 831     $oid,
 832   );
 833 } # DeleteBaselineOID
 834
 835 sub UpdateBaseline ($$$) {
 836   my ($self, $name, $pvob, $update) = @_;
 837
 838   return $self->UpdateRecord (
 839     'baseline',
 840     ['name', 'pvob'],
 841     [$name, $pvob],
 842     $update
 843   );
 844 } # UpdateBaseline
 845
 846 sub GetBaseline ($$) {
 847   my ($self, $name, $pvob) = @_;
 848
 849   return $self->GetRecord (
 850     'baseline',
 851     ['name', 'pvob'],
 852     [$name, $pvob],
 853   );
 854 } # GetBaseline
 855
 856 sub FindBaseline (;$$) {
 857   my ($self, $name, $pvob) = @_;
 858
 859   return $self->FindRecord (
 860     'baseline',
 861     ['name', 'pvob'],
 862     [$name, $pvob]
 863   );
 864 } # FindBaseline
 865
 866 sub DeleteElementAll ($) {
 867   my ($self, $name) = @_;
 868
 869   my ($total, $err, $msg);
 870
 871   foreach ($self->FindChangeset (undef, $name)) {
 872     my %changeset = %$_;
 873
 874     ($err, $msg) = $self->DeleteChangeset (
 875       $changeset{activity},
 876       $changeset{name},
 877       $changeset{version},
 878       $changeset{pvob},
 879     );
 880
 881     return ($err, $msg)
 882       if $msg ne 'Records deleted';
 883
 884     $total += $err;
 885   } # foreach
 886
 887   return ($total, $msg);
 888 } # DeleteElementAll
 889
 890 sub AddChangeset ($) {
 891   my ($self, $data) = @_;
 892
 893   return $self->AddRecord (
 894     'changeset',
 895     ['activity', 'element', 'version', 'pvob'],
 896     $data
 897   );
 898 } # AddChangeset
 899
 900 sub DeleteChangeset ($$$$) {
 901   my ($self, $activity, $element, $version, $pvob) = @_;
 902
 903   return $self->DeleteRecord (
 904     'changeset',
 905     ['activity', 'element', 'version', 'pvob'],
 906     [$activity, $element, $version, $pvob],
 907   );
 908 } # DeleteChangeset
 909
 910 sub UpdateChangeset ($$$$$) {
 911   my ($self, $activity, $element, $version, $pvob, $update) = @_;
 912
 913   return $self->UpdateRecord (
 914     'changeset',
 915     ['activity', 'element', 'version', 'pvob'],
 916     [$activity, $element, $version, $pvob],
 917     $update
 918   );
 919 } # UpdateChangeset
 920
 921 sub GetChangeset ($$$$) {
 922   my ($self, $activity, $element, $version, $pvob) = @_;
 923
 924   return $self->GetRecord (
 925     'changeset',
 926     ['activity', 'element', 'version', 'pvob'],
 927     [$activity, $element, $version, $pvob],
 928   );
 929 } # GetChangeset
 930
 931 sub FindChangeset (;$$$$) {
 932   my ($self, $activity, $element, $version, $pvob) = @_;
 933
 934   return $self->FindRecord (
 935     'changeset',
 936     ['activity', 'element', 'version', 'pvob'],
 937     [$activity, $element, $version, $pvob]
 938   );
 939 } # FindChangeset
 940
 941 sub AddFolder ($) {
 942   my ($self, $data) = @_;
 943
 944   return $self->AddRecord (
 945     'folder',
 946     ['name', 'pvob'],
 947     $data
 948   );
 949 } # AddFolder
 950
 951 sub DeleteFolder ($$) {
 952   my ($self, $folder, $pvob) = @_;
 953
 954   return $self->DeleteRecord (
 955     'folder',
 956     ['name', 'pvob'],
 957     [$folder, $pvob],
 958   );
 959 } # DeleteFolder
 960
 961 sub UpdateFolder ($$$) {
 962   my ($self, $name, $pvob, $update) = @_;
 963
 964   return $self->UpdateRecord (
 965     'folder',
 966     ['name', 'pvob'],
 967     [$name, $pvob],
 968     $update
 969   );
 970 } # UpdateFolder
 971
 972 sub GetFolder ($$) {
 973   my ($self, $name, $pvob) = @_;
 974
 975   return $self->GetRecord (
 976     'folder',
 977     ['name', 'pvob'],
 978     [$name, $pvob],
 979   );
 980 } # GetFolder
 981
 982 sub FindFolder (;$$) {
 983   my ($self, $name, $pvob) = @_;
 984
 985   return $self->FindRecord (
 986     'folder',
 987     ['name', 'pvob'],
 988     [$name, $pvob]
 989   );
 990 } # FindFolder
 991
 992 sub AddVob ($) {
 993   my ($self, $data) = @_;
 994
 995   return $self->AddRecord (
 996     'vob',
 997     ['name'],
 998     $data
 999   );
1000 } # AddVob
1001
1002 sub DeleteVob ($) {
1003   my ($self, $name) = @_;
1004
1005   return $self->DeleteRecord (
1006     'vob',
1007     ['name'],
1008     $name,
1009   );
1010 } # DeleteVob
1011
1012 sub UpdateVob ($$) {
1013   my ($self, $name, $update) = @_;
1014
1015   return $self->UpdateRecord ('vob', 'name', $name, $update);
1016 } # UpdateVob
1017
1018 sub GetVob ($) {
1019   my ($self, $name) = @_;
1020
1021   return $self->GetRecord (
1022     'vob',
1023     'name',
1024     $name,
1025   );
1026 } # GetVob
1027
1028 sub FindVob (;$$) {
1029   my ($self, $name, $type) = @_;
1030
1031   $type ||= '';
1032
1033   return $self->FindRecord (
1034     'vob',
1035     ['name', 'type'],
1036     [$name, $type],
1037   );
1038 } # FindVob
1039
1040 sub AddStreamActivityXref ($) {
1041   my ($self, $data) = @_;
1042
1043   return $self->AddRecord (
1044     'stream_activity_xref',
1045     ['stream', 'activity', 'pvob'],
1046     $data
1047   );
1048 } # AddStreamActivityXref
1049
1050 sub DeleteStreamActivityXref ($$$) {
1051   my ($self, $stream, $activity, $pvob) = @_;
1052
1053   return $self->DeleteRecord (
1054     'stream_activity_xref',
1055     ['stream', 'activity', 'pvob'],
1056     [$stream, $activity, $pvob],
1057   );
1058 } # DeleteStreamActivityXref
1059
1060 sub UpdateStreamActivityXref ($$$$) {
1061   my ($self, $stream, $activity, $pvob, $update) = @_;
1062
1063   return $self->UpdateRecord (
1064     'stream_activity_xref',
1065     ['stream', 'activity', 'pvob'],
1066     [$stream, $activity, $pvob],
1067     $update
1068   );
1069 } # UpdateStreamActivityXref
1070
1071 sub GetStreamActivityXref ($$$) {
1072   my ($self, $stream, $activity, $pvob) = @_;
1073
1074   return $self->GetRecord (
1075     'stream_activity_xref',
1076     ['stream', 'activity', 'pvob'],
1077     [$stream, $activity, $pvob],
1078   );
1079 } # GetStreamActivityXref
1080
1081 sub FindStreamActivityXref (;$$$) {
1082   my ($self, $stream, $activity, $pvob) = @_;
1083
1084   return $self->FindRecord (
1085     'stream_activity_xref',
1086     ['stream', 'activity', 'pvob'],
1087     [$stream, $activity, $pvob]
1088   );
1089 } # FindStreamActivityXref
1090
1091 sub AddStreamBaselineXref ($) {
1092   my ($self, $data) = @_;
1093
1094   return $self->AddRecord (
1095     'stream_baseline_xref',
1096     ['stream', 'baseline', 'pvob'],
1097     $data
1098   );
1099 } # AddStreamBaselineXref
1100
1101 sub DeleteStreamBaselineXref ($$$) {
1102   my ($self, $stream, $baseline, $pvob) = @_;
1103
1104   return $self->DeleteRecord (
1105     'stream_baseline_xref',
1106     ['stream', 'baseline', 'pvob'],
1107     [$stream, $baseline, $pvob],
1108   );
1109 } # DeleteStreamBaselineXref
1110
1111 sub UpdateStreamBaselineXref ($$$$) {
1112   my ($self, $stream, $baseline, $pvob, $update) = @_;
1113
1114   return $self->UpdateRecord (
1115     'stream_baseline_xref',
1116     ['stream', 'baseline', 'pvob'],
1117     [$stream, $baseline, $pvob],
1118     $update
1119   );
1120 } # UpdateStreamBaselineXref
1121
1122 sub GetStreamBaselineXref ($$$) {
1123   my ($self, $stream, $baseline, $pvob) = @_;
1124
1125   return $self->GetRecord (
1126     'stream_baseline_xref',
1127     ['stream', 'baseline', 'pvob'],
1128     [$stream, $baseline, $pvob],
1129   );
1130 } # GetStreamBaselineXref
1131
1132 sub FindStreamBaselineXref (;$$$) {
1133   my ($self, $stream, $baseline, $pvob) = @_;
1134
1135   return $self->FindRecord (
1136     'stream_baseline_xref',
1137     ['stream', 'baseline', 'pvob'],
1138     [$stream, $baseline, $pvob]
1139   );
1140 } # FindStreamBaselineXref
1141
1142 sub AddBaselineActivityXref ($) {
1143   my ($self, $data) = @_;
1144
1145   return $self->AddRecord (
1146     'baseline_activity_xref',
1147     ['baseline', 'activity', 'pvob'],
1148     $data
1149   );
1150 } # AddBaselineActivityXref
1151
1152 sub DeleteBaselineActivityXref ($$$) {
1153   my ($self, $baseline, $activity, $pvob) = @_;
1154
1155   return $self->DeleteRecord (
1156     'baseline_activity_xref',
1157     ['baseline', 'activity', 'pvob'],
1158     [$baseline, $activity, $pvob],
1159   );
1160 } # DeleteBaselineActivityXref
1161
1162 sub UpdateBaselineActivityXref ($$$$) {
1163   my ($self, $baseline, $activity, $pvob, $update) = @_;
1164
1165   return $self->UpdateRecord (
1166     'baseline_activity_xref',
1167     ['baseline', 'activity', 'pvob'],
1168     [$baseline, $activity, $pvob],
1169     $update
1170   );
1171 } # UpdateBaselineActivityXref
1172
1173 sub GetBaselineActivityXref ($$$$) {
1174   my ($self, $baseline, $activity, $pvob) = @_;
1175
1176   return $self->GetRecord (
1177     'baseline_activity_xref',
1178     ['baseline', 'activity', 'pvob'],
1179     [$baseline, $activity, $pvob],
1180   );
1181 } # GetBaselineActivityXref
1182
1183 sub FindBaselineActivityXref (;$$$$) {
1184   my ($self, $baseline, $activity, $pvob) = @_;
1185
1186   return $self->FindRecord (
1187     'baseline_activity_xref',
1188     ['baseline', 'activity', 'pvob'],
1189     [$baseline, $activity, $pvob]
1190   );
1191 } # FindBaselineActivityXref
1192
1193 sub FindActivities ($$$) {
1194   my ($self, $pvob, $stream, $element) = @_;
1195
1196   my $statement = <<"END";
1197 select
1198   aex.activity
1199 from
1200   changeset             as cs,
1201   stream_activity_xref  as sax
1202 where
1203   cs.pvob     =    sax.pvob     and
1204   cs.activity =    sax.activity and
1205   cs.pvob     =    '$pvob'      and
1206   sax.stream  =    '$stream'    and
1207   cs.element  like '$element%'
1208 group by
1209   cs.activity
1210 END
1211
1212   my $sth = $self->{db}->prepare ($statement);
1213
1214   my ($err, $msg);
1215
1216   unless ($sth) {
1217     ($err, $msg) = $self->_dberror ('Unable to prepare statement', $statement);
1218
1219     croak $msg;
1220   } # if
1221
1222   my $status = $sth->execute;
1223
1224   unless ($status) {
1225     ($err, $msg) = $self->_dberror ('Unable to execute statement', $statement);
1226
1227     croak $msg;
1228   } # if
1229
1230   my @records;
1231
1232   while (my $row = $sth->fetchrow_hashref) {
1233     push @records, $row;
1234   } # while
1235
1236   return @records;
1237 } # FindActivities
1238
1239 1;
1240
1241 =pod
1242
1243 =head1 CONFIGURATION AND ENVIRONMENT
1244
1245 DEBUG: If set then $debug is set to this level.
1246
1247 VERBOSE: If set then $verbose is set to this level.
1248
1249 TRACE: If set then $trace is set to this level.
1250
1251 =head1 DEPENDENCIES
1252
1253 =head2 Perl Modules
1254
1255 L<Carp>
1256
1257 L<DBI>
1258
1259 L<FindBin>
1260
1261 L<DBI>
1262
1263 =head2 ClearSCM Perl Modules
1264
1265 =begin man
1266
1267  DateUtils
1268  Display
1269  GetConfig
1270
1271 =end man
1272
1273 =begin html
1274
1275 <blockquote>
1276 <a href="http://clearscm.com/php/cvs_man.php?file=lib/DateUtils.pm">DateUtils</a><br>
1277 <a href="http://clearscm.com/php/cvs_man.php?file=lib/Display.pm">Display</a><br>
1278 <a href="http://clearscm.com/php/cvs_man.php?file=lib/GetConfig.pm">GetConfig</a><br>
1279 </blockquote>
1280
1281 =end html
1282
1283 =head1 BUGS AND LIMITATIONS
1284
1285 There are no known bugs in this module
1286
1287 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
1288
1289 =head1 LICENSE AND COPYRIGHT
1290
1291 Copyright (c) 2011, ClearSCM, Inc. All rights reserved.
1292
1293 =cut