ACE/bin/cle.pl

   1 eval '(exit $?0)' && eval 'exec perl -S $0 ${1+"$@"}'
   2     & eval 'exec perl -S $0 $argv:q'
   3     if 0;
   4
   5 # ******************************************************************
   6 #      Author: Chad Elliott
   7 #        Date: 6/18/2002
   8 # ******************************************************************
   9
  10 use strict;
  11 use Cwd;
  12 use File::Basename;
  13 use Sys::Hostname;
  14
  15 if ( $^O eq 'VMS' ) {
  16   require VMS::Filespec;
  17   import VMS::Filespec qw(unixpath);
  18 }
  19
  20 unshift(@INC, getExecutePath($0) . 'ChangeLogEditor');
  21
  22 require ChangeLogEdit;
  23 require EmailTranslator;
  24
  25 # ************************************************************
  26 # Subroutine Section
  27 # ************************************************************
  28
  29 sub which {
  30   my($prog)   = shift;
  31   my($exec)   = $prog;
  32   my($part)   = '';
  33   if ( $^O eq 'VMS' ) {
  34     my($envSep) = ';';
  35     if (defined $ENV{'PATH'}) {
  36       foreach $part (split(/$envSep/, $ENV{'PATH'})) {
  37         $part .= "$prog";
  38         if ( -x $part ) {
  39           $exec = $part;
  40           last;
  41         }
  42       }
  43     }
  44   }
  45   else  {
  46     my($envSep) = ($^O eq 'MSWin32' ? ';' : ':');
  47     if (defined $ENV{'PATH'}) {
  48       foreach $part (split(/$envSep/, $ENV{'PATH'})) {
  49         $part .= "/$prog";
  50         if ( -x $part ) {
  51           $exec = $part;
  52           last;
  53         }
  54       }
  55     }
  56   }
  57
  58   return $exec;
  59 }
  60
  61
  62 sub getExecutePath {
  63   my($prog) = shift;
  64   my($loc)  = '';
  65
  66   if ( $^O eq 'VMS' ) {
  67     if ($prog ne basename($prog)) {
  68       my($dir) = unixpath( dirname($prog) );
  69       if ($prog =~ /^[\/\\]/) {
  70         $loc = $dir;
  71       }
  72       else {
  73         $loc = unixpath(getcwd()) . $dir;
  74       }
  75     }
  76     else {
  77       $loc = unixpath( dirname(which($prog)) );
  78     }
  79
  80     if ($loc eq '.') {
  81       $loc = unixpath( getcwd() );
  82     }
  83   } else {
  84     if ($prog ne basename($prog)) {
  85       if ($prog =~ /^[\/\\]/ ||
  86           $prog =~ /^[A-Za-z]:[\/\\]?/) {
  87         $loc = dirname($prog);
  88       }
  89       else {
  90         $loc = getcwd() . '/' . dirname($prog);
  91       }
  92     }
  93     else {
  94       $loc = dirname(which($prog));
  95     }
  96
  97     $loc =~ s/\/\.$//;
  98
  99     if ($loc eq '.') {
 100       $loc = getcwd();
 101     }
 102
 103     if ($loc ne '') {
 104       $loc .= '/';
 105     }
 106   }
 107
 108   return $loc;
 109 }
 110
 111 sub getDefaultDomain {
 112   my($domain) = undef;
 113   my($host)   = hostname();
 114
 115   if (defined $host) {
 116     ## First try the hostname
 117     if ($host =~ /[^\.]+\.(.*)/) {
 118       $domain = $1;
 119     }
 120     else {
 121       ## Next try the hosts file
 122       my($hosts) = ($^O eq 'MSWin32' ?
 123                       "$ENV{SystemRoot}/system32/drivers/etc/hosts" :
 124                       '/etc/hosts');
 125       my($fh)    = new FileHandle();
 126       if (open($fh, $hosts)) {
 127         while(<$fh>) {
 128           if (/$host\.([^\s]+)/) {
 129             $domain = $1;
 130             last;
 131           }
 132         }
 133         close($fh);
 134       }
 135
 136       if (!defined $domain) {
 137         ## Next try ipconfig on Windows
 138         if ($^O eq 'MSWin32') {
 139           if (open($fh, 'ipconfig /all |')) {
 140             while(<$fh>) {
 141               if (/Primary\s+DNS\s+Suffix[^:]+:\s+(.*)/) {
 142                 $domain = $1;
 143               }
 144               elsif (/DNS\s+Suffix\s+Search[^:]+:\s+(.*)/) {
 145                 $domain = $1;
 146               }
 147             }
 148             close($fh);
 149           }
 150         }
 151         else {
 152           ## Try /etc/resolv.conf on UNIX
 153           if (open($fh, '/etc/resolv.conf')) {
 154             while(<$fh>) {
 155               if (/search\s+(.*)/) {
 156                 $domain = $1;
 157                 last;
 158               }
 159             }
 160             close($fh);
 161           }
 162         }
 163       }
 164     }
 165   }
 166   return $domain;
 167 }
 168
 169
 170 sub usageAndExit {
 171   my($arg)  = shift;
 172   my($base) = basename($0);
 173   if (defined $arg) {
 174     print "$arg\n\n";
 175   }
 176   print "Usage: $base [ChangeLog File] [user name] [email address]\n" .
 177         "        " . (' ' x length($base)) . "[-d <dir1 dir2 ... dirN>]\n\n" .
 178         "       Uses cvs to determine which files are modified or added\n" .
 179         "       and generates a bare ChangeLog entry based on those files.\n" .
 180         "       This script should be run at the same directory level in\n" .
 181         "       which the ChangeLog exists.  The entry is prepended to the\n" .
 182         "       existing ChangeLog.\n" .
 183         "\n" .
 184         "       Email addresses are generated with a certain set of\n" .
 185         "       defaults and can be modified using various environment\n" .
 186         "       variables.  By default email addresses are generated\n" .
 187         "       using the user last name followed by an underscore and\n" .
 188         "       the first initial of the user first name followed by the\n" .
 189         "       email domain.\n" .
 190         "\n" .
 191         "       REPLYTO      If this environment variable is set, the value\n" .
 192         "                    is used as the email address.\n" .
 193         "       CL_USERNAME  This environment variable is used to override\n" .
 194         "                    the user name (obtained from the password file).\n" .
 195         "       CL_CHANGELOG_FILE  This environment variable is used as the\n".
 196         "                          [ChangeLog File] argument if none is given\n".
 197         "                          on the command line.\n".
 198         "\n" .
 199         "       The user name and email address can be passed as a parameter to\n" .
 200         "       this script.  If either is not passed, then the script will try\n" .
 201         "       to determine it automatically.\n" .
 202         "\n" .
 203         "       If -d is used, everything on the command line after it is\n" .
 204         "       considered a directory or file to be considered in the\n" .
 205         "       ChangeLog entry.\n";
 206   exit(0);
 207 }
 208
 209
 210 # ************************************************************
 211 # Subroutine Section
 212 # ************************************************************
 213
 214 my($file)     = undef;
 215 my($name)     = undef;
 216 my($email)    = undef;
 217 my(@dirs)     = ();
 218 my($restdirs) = 0;
 219
 220 foreach my $arg (@ARGV) {
 221   if ($restdirs) {
 222     push(@dirs, $arg);
 223   }
 224   elsif ($arg eq '-h') {
 225     usageAndExit();
 226   }
 227   elsif ($arg eq '-d') {
 228     $restdirs = 1;
 229   }
 230   elsif ($arg =~ /^\-/) {
 231     usageAndExit("Unrecognized parameter: $arg");
 232   }
 233   elsif (!defined $file) {
 234     $file = $arg;
 235   }
 236   elsif (!defined $name) {
 237     $name = $arg;
 238   }
 239   elsif (!defined $email) {
 240     $email = $arg;
 241   }
 242 }
 243
 244 if (!defined $file) {
 245   if (defined $ENV{CL_CHANGELOG_FILE}) {
 246     $file = $ENV{CL_CHANGELOG_FILE};
 247   }
 248   else {
 249     $file = 'ChangeLog';
 250   }
 251 }
 252 if (!defined $name) {
 253   my(@pwd)    = ();
 254   if (defined $ENV{CL_USERNAME}) {
 255     $pwd[6] = $ENV{CL_USERNAME};
 256   }
 257   else {
 258     if ($^O eq 'MSWin32' || $^O eq 'cygwin') {
 259       $pwd[6] = 'unknown';
 260     }
 261     else {
 262       @pwd = getpwuid($<);
 263       $pwd[6] =~ s/,//g;
 264     }
 265   }
 266   $name = $pwd[6];
 267 }
 268
 269 if (!defined $email) {
 270   my($trans) = new EmailTranslator(getDefaultDomain());
 271   $email = $trans->translate($name);
 272 }
 273
 274 my($editor) = new ChangeLogEdit($name, $email);
 275 my($status, $error, $unknown) = $editor->edit($file, @dirs);
 276
 277 if (defined $unknown) {
 278   my(@uarray) = @$unknown;
 279   if ($#uarray >= 0) {
 280     print "WARNING: The following files are unknown to the ",
 281           "revision control system:\n";
 282     foreach my $unk (@uarray) {
 283       print "$unk\n";
 284     }
 285     print "\n";
 286   }
 287 }
 288
 289 if ($status) {
 290   print "You are now ready to edit the $file.\n";
 291 }
 292 else {
 293   print "$error\n";
 294 }
 295
 296 exit($status ? 0 : 1);