CCDB/triggers/TriggerUtils.pm

   1 =pod
   2
   3 =head1 NAME $RCSfile: TriggerUtils.pm,v $
   4
   5 Trigger Utilities
   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.3 $
  18
  19 =item Created
  20
  21 Fri Mar 11 15:37:34 PST 2011
  22
  23 =item Modified
  24
  25 $Date: 2011/03/26 06:24:30 $
  26
  27 =back
  28
  29 =head1 SYNOPSIS
  30
  31 Provides an some utilities for the CCDB Triggers.
  32
  33 =cut
  34
  35 package TriggerUtils;
  36
  37 use strict;
  38 use warnings;
  39
  40 use Carp;
  41 use FindBin;
  42
  43 use lib "$FindBin::Bin/../../lib";
  44
  45 use DateUtils;
  46
  47 use base 'Exporter';
  48
  49 our $VIEW_DRIVE     = 'M';
  50 our $VIEWTAG_PREFIX = ($^O =~ /mswin/i or $^O =~ /cygwin/)
  51                     ? "$VIEW_DRIVE:/"
  52                     : "/view/";
  53
  54 our @EXPORT = qw (
  55   trigmsg
  56   triglog
  57   triglogmsg
  58   trigdie
  59   vobname
  60 );
  61
  62 our $logfile;
  63
  64 my $logfileName = "$FindBin::Bin/trigger.log";
  65
  66 sub trigmsg ($){
  67   # Display a message to the user using clearprompt
  68   my ($msg) = @_;
  69
  70   my $cmd  = "clearprompt proceed -newline -type error -prompt \"$msg\" ";
  71      $cmd .= "-mask abort -default abort";
  72
  73   `$cmd`;
  74
  75   return;
  76 } # trigmsg
  77
  78 sub triglog ($) {
  79   # Log a message to the log file
  80   my ($msg) = @_;
  81
  82   return unless $ENV{CCDB_TRIGGER_DEBUG};
  83
  84   unless ($logfile) {
  85     open $logfile, '>>', $logfileName
  86       or die "Unable to open logfile $logfile - $!\n";
  87
  88     $logfile->autoflush (1);
  89   } # unless
  90
  91   my $timestamp = timestamp;
  92
  93   print $logfile "$FindBin::Script: $timestamp: $msg\n";
  94
  95   return;
  96 } # triglog
  97
  98 sub triglogmsg ($) {
  99   my ($msg) = @_;
 100
 101   # Log message to log file then display it to user
 102   triglog $msg;
 103   trigmsg $msg;
 104
 105   return;
 106 } # triglogmsg
 107
 108 sub trigdie ($$) {
 109   my ($msg, $err) = @_;
 110
 111   $err ||= 0;
 112
 113   triglog $msg;
 114   die "$msg\n";
 115 } # trigdie
 116
 117 sub vobname ($) {
 118   my ($pvob) = @_;
 119
 120   # CCDB stores pvob's in the database with the VOBTAG_PREFIX removed. This
 121   # makes a vob name OS independent as on Windows it's \$pvob and Unix/Linux
 122   # it's /vob/$pvob (or sometimes /vobs/$pvob! This is site specific). Now we
 123   # have a handy method in Clearcase.pm for this but we want speed here. Doing a
 124   # "use Clearcase;" will invoke a cleartool subproccess ($Clearcase::CC) and we
 125   # don't want that overhead. So we are replicating that code here. We are
 126   # hinging off of the first character of the vob name (either '\', or '/') to
 127   # indicate if we are Windows or non-Windows. Additionally we are hardcoding
 128   # '/vob/' as the vob tag prefix for the Unix/Linux case.
 129   if (substr ($pvob, 0, 1) eq '\\') {
 130     $pvob = substr $pvob, 1;
 131   } elsif (substr ($pvob, 0, 1) eq '/') {
 132     if ($pvob =~ /\/vob\/(.+)/) {
 133       $pvob = $1;
 134     } # if
 135   } # if
 136
 137   return $pvob;
 138 } # vobname
 139
 140 sub dumpenv () {
 141   triglog 'Dumping CLEARCASE_* environment';
 142
 143   foreach (keys %ENV) {
 144     next unless /CLEARCASE_/;
 145
 146     triglog "$_: $ENV{$_}";
 147   } # foreach
 148
 149   return;
 150 } # dumpenv
 151
 152 1;
 153
 154 =pod
 155
 156 =head1 CONFIGURATION AND ENVIRONMENT
 157
 158 DEBUG: If set then $debug is set to this level.
 159
 160 VERBOSE: If set then $verbose is set to this level.
 161
 162 TRACE: If set then $trace is set to this level.
 163
 164 =head1 DEPENDENCIES
 165
 166 =head2 Perl Modules
 167
 168 L<Carp>
 169
 170 L<FindBin>
 171
 172 =head2 ClearSCM Perl Modules
 173
 174 =begin man
 175
 176  DateUtils
 177
 178 =end man
 179
 180 =begin html
 181
 182 <blockquote>
 183 <a href="http://clearscm.com/php/scm_man.php?file=lib/DateUtils.pm">DateUtils</a><br>
 184 </blockquote>
 185
 186 =end html
 187
 188 =head1 BUGS AND LIMITATIONS
 189
 190 There are no known bugs in this module
 191
 192 Please report problems to Andrew DeFaria <Andrew@ClearSCM.com>.
 193
 194 =head1 LICENSE AND COPYRIGHT
 195
 196 Copyright (c) 2011, ClearSCM, Inc. All rights reserved.
 197
 198 =cut