Add CVS 1.12.11.
[dragonfly.git] / 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;