contrib/cvs-1.12.11/contrib/log.in

   1 #! @PERL@
   2 # -*-Perl-*-
   3 #
   4 # XXX: FIXME: handle multiple '-f logfile' arguments
   5 #
   6 # XXX -- I HATE Perl!  This *will* be re-written in shell/awk/sed soon!
   7 #
   8
   9 # Usage:  log.pl [-u user] [[-m mailto] ...] [-s] [-V] -f logfile 'dirname file ...'
  10 #
  11 #       -u user         - $USER passed from loginfo
  12 #       -m mailto       - for each user to receive cvs log reports
  13 #                       (multiple -m's permitted)
  14 #       -s              - to prevent "cvs status -v" messages
  15 #       -V              - without '-s', don't pass '-v' to cvs status
  16 #       -f logfile      - for the logfile to append to (mandatory,
  17 #                       but only one logfile can be specified).
  18
  19 # here is what the output looks like:
  20 #
  21 #    From: woods@kuma.domain.top
  22 #    Subject: CVS update: testmodule
  23 #
  24 #    Date: Wednesday November 23, 1994 @ 14:15
  25 #    Author: woods
  26 #
  27 #    Update of /local/src-CVS/testmodule
  28 #    In directory kuma:/home/kuma/woods/work.d/testmodule
  29 #
  30 #    Modified Files:
  31 #       test3
  32 #    Added Files:
  33 #       test6
  34 #    Removed Files:
  35 #       test4
  36 #    Log Message:
  37 #    - wow, what a test
  38 #
  39 # (and for each file the "cvs status -v" output is appended unless -s is used)
  40 #
  41 #    ==================================================================
  42 #    File: test3                Status: Up-to-date
  43 #
  44 #       Working revision:       1.41    Wed Nov 23 14:15:59 1994
  45 #       Repository revision:    1.41    /local/src-CVS/cvs/testmodule/test3,v
  46 #       Sticky Options: -ko
  47 #
  48 #       Existing Tags:
  49 #       local-v2                        (revision: 1.7)
  50 #       local-v1                        (revision: 1.1.1.2)
  51 #       CVS-1_4A2                       (revision: 1.1.1.2)
  52 #       local-v0                        (revision: 1.2)
  53 #       CVS-1_4A1                       (revision: 1.1.1.1)
  54 #       CVS                             (branch: 1.1.1)
  55
  56 use strict;
  57 use IO::File;
  58
  59 my $cvsroot = $ENV{'CVSROOT'};
  60
  61 # turn off setgid
  62 #
  63 $) = $(;
  64
  65 my $dostatus = 1;
  66 my $verbosestatus = 1;
  67 my $users;
  68 my $login;
  69 my $donefiles;
  70 my $logfile;
  71 my @files;
  72
  73 # parse command line arguments
  74 #
  75 while (@ARGV) {
  76         my $arg = shift @ARGV;
  77
  78         if ($arg eq '-m') {
  79                 $users = "$users " . shift @ARGV;
  80         } elsif ($arg eq '-u') {
  81                 $login = shift @ARGV;
  82         } elsif ($arg eq '-f') {
  83                 ($logfile) && die "Too many '-f' args";
  84                 $logfile = shift @ARGV;
  85         } elsif ($arg eq '-s') {
  86                 $dostatus = 0;
  87         } elsif ($arg eq '-V') {
  88                 $verbosestatus = 0;
  89         } else {
  90                 ($donefiles) && die "Too many arguments!\n";
  91                 $donefiles = 1;
  92                 @files = split(/ /, $arg);
  93         }
  94 }
  95
  96 # the first argument is the module location relative to $CVSROOT
  97 #
  98 my $modulepath = shift @files;
  99
 100 my $mailcmd = "| Mail -s 'CVS update: $modulepath'";
 101
 102 # Initialise some date and time arrays
 103 #
 104 my @mos = ('January','February','March','April','May','June','July',
 105         'August','September','October','November','December');
 106 my @days = ('Sunday','Monday','Tuesday','Wednesday','Thursday','Friday','Saturday');
 107
 108 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
 109 $year += 1900;
 110
 111 # get a login name for the guy doing the commit....
 112 #
 113 if ($login eq '') {
 114         $login = getlogin || (getpwuid($<))[0] || "nobody";
 115 }
 116
 117 # open log file for appending
 118 #
 119 my $logfh = new IO::File ">>" . $logfile
 120         or die "Could not open(" . $logfile . "): $!\n";
 121
 122 # send mail, if there's anyone to send to!
 123 #
 124 my $mailfh;
 125 if ($users) {
 126         $mailcmd = "$mailcmd $users";
 127         $mailfh = new IO::File $mailcmd
 128                 or die "Could not Exec($mailcmd): $!\n";
 129 }
 130
 131 # print out the log Header
 132 #
 133 $logfh->print ("\n");
 134 $logfh->print ("****************************************\n");
 135 $logfh->print ("Date:\t$days[$wday] $mos[$mon] $mday, $year @ $hour:" . sprintf("%02d", $min) . "\n");
 136 $logfh->print ("Author:\t$login\n\n");
 137
 138 if ($mailfh) {
 139         $mailfh->print ("\n");
 140         $mailfh->print ("Date:\t$days[$wday] $mos[$mon] $mday, $year @ $hour:" . sprintf("%02d", $min) . "\n");
 141         $mailfh->print ("Author:\t$login\n\n");
 142 }
 143
 144 # print the stuff from logmsg that comes in on stdin to the logfile
 145 #
 146 my $infh = new IO::File "< -";
 147 foreach ($infh->getlines) {
 148         $logfh->print;
 149         if ($mailfh) {
 150                 $mailfh->print ($_);
 151         }
 152 }
 153 undef $infh;
 154
 155 $logfh->print ("\n");
 156
 157 # after log information, do an 'cvs -Qq status -v' on each file in the arguments.
 158 #
 159 if ($dostatus != 0) {
 160         while (@files) {
 161                 my $file = shift @files;
 162                 if ($file eq "-") {
 163                         $logfh->print ("[input file was '-']\n");
 164                         if ($mailfh) {
 165                                 $mailfh->print ("[input file was '-']\n");
 166                         }
 167                         last;
 168                 }
 169                 my $rcsfh = new IO::File;
 170                 my $pid = $rcsfh->open ("-|");
 171                 if ( !defined $pid )
 172                 {
 173                         die "fork failed: $!";
 174                 }
 175                 if ($pid == 0)
 176                 {
 177                         my @command = ('cvs', '-nQq', 'status');
 178                         if ($verbosestatus)
 179                         {
 180                                 push @command, '-v';
 181                         }
 182                         push @command, $file;
 183                         exec @command;
 184                         die "cvs exec failed: $!";
 185                 }
 186                 my $line;
 187                 while ($line = $rcsfh->getline) {
 188                         $logfh->print ($line);
 189                         if ($mailfh) {
 190                                 $mailfh->print ($line);
 191                         }
 192                 }
 193                 undef $rcsfh;
 194         }
 195 }
 196
 197 $logfh->close()
 198         or die "Write to $logfile failed: $!";
 199
 200 if ($mailfh)
 201 {
 202         $mailfh->close;
 203         die "Pipe to $mailcmd failed" if $?;
 204 }
 205
 206 ## must exit cleanly
 207 ##
 208 exit 0;