Work around MinGW mangling of "host:/path"
[msysgit/historical-msysgit.git] / lib / cvs / contrib / log
blob2b8ad86b5c257ed86b563b81fe9a16df6fed54bb
1 #! /bin/perl
2 # -*-Perl-*-
4 # XXX: FIXME: handle multiple '-f logfile' arguments
6 # XXX -- I HATE Perl! This *will* be re-written in shell/awk/sed soon!
9 # Usage: log.pl [-u user] [[-m mailto] ...] [-s] -f logfile 'dirname file ...'
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 # -f logfile - for the logfile to append to (mandatory,
16 # but only one logfile can be specified).
18 # here is what the output looks like:
20 # From: woods@kuma.domain.top
21 # Subject: CVS update: testmodule
23 # Date: Wednesday November 23, 1994 @ 14:15
24 # Author: woods
26 # Update of /local/src-CVS/testmodule
27 # In directory kuma:/home/kuma/woods/work.d/testmodule
29 # Modified Files:
30 # test3
31 # Added Files:
32 # test6
33 # Removed Files:
34 # test4
35 # Log Message:
36 # - wow, what a test
38 # (and for each file the "cvs status -v" output is appended unless -s is used)
40 # ==================================================================
41 # File: test3 Status: Up-to-date
43 # Working revision: 1.41 Wed Nov 23 14:15:59 1994
44 # Repository revision: 1.41 /local/src-CVS/cvs/testmodule/test3,v
45 # Sticky Options: -ko
47 # Existing Tags:
48 # local-v2 (revision: 1.7)
49 # local-v1 (revision: 1.1.1.2)
50 # CVS-1_4A2 (revision: 1.1.1.2)
51 # local-v0 (revision: 1.2)
52 # CVS-1_4A1 (revision: 1.1.1.1)
53 # CVS (branch: 1.1.1)
55 $cvsroot = $ENV{'CVSROOT'};
57 # turn off setgid
59 $) = $(;
61 $dostatus = 1;
63 # parse command line arguments
65 while (@ARGV) {
66 $arg = shift @ARGV;
68 if ($arg eq '-m') {
69 $users = "$users " . shift @ARGV;
70 } elsif ($arg eq '-u') {
71 $login = shift @ARGV;
72 } elsif ($arg eq '-f') {
73 ($logfile) && die "Too many '-f' args";
74 $logfile = shift @ARGV;
75 } elsif ($arg eq '-s') {
76 $dostatus = 0;
77 } else {
78 ($donefiles) && die "Too many arguments!\n";
79 $donefiles = 1;
80 @files = split(/ /, $arg);
84 # the first argument is the module location relative to $CVSROOT
86 $modulepath = shift @files;
88 $mailcmd = "| Mail -s 'CVS update: $modulepath'";
90 # Initialise some date and time arrays
92 @mos = (January,February,March,April,May,June,July,August,September,
93 October,November,December);
94 @days = (Sunday,Monday,Tuesday,Wednesday,Thursday,Friday,Saturday);
96 ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
97 $year += 1900;
99 # get a login name for the guy doing the commit....
101 if ($login eq '') {
102 $login = getlogin || (getpwuid($<))[0] || "nobody";
105 # open log file for appending
107 open(OUT, ">>" . $logfile) || die "Could not open(" . $logfile . "): $!\n";
109 # send mail, if there's anyone to send to!
111 if ($users) {
112 $mailcmd = "$mailcmd $users";
113 open(MAIL, $mailcmd) || die "Could not Exec($mailcmd): $!\n";
116 # print out the log Header
118 print OUT "\n";
119 print OUT "****************************************\n";
120 print OUT "Date:\t$days[$wday] $mos[$mon] $mday, $year @ $hour:" . sprintf("%02d", $min) . "\n";
121 print OUT "Author:\t$login\n\n";
123 if (MAIL) {
124 print MAIL "\n";
125 print MAIL "Date:\t$days[$wday] $mos[$mon] $mday, $year @ $hour:" . sprintf("%02d", $min) . "\n";
126 print MAIL "Author:\t$login\n\n";
129 # print the stuff from logmsg that comes in on stdin to the logfile
131 open(IN, "-");
132 while (<IN>) {
133 print OUT $_;
134 if (MAIL) {
135 print MAIL $_;
138 close(IN);
140 print OUT "\n";
142 # after log information, do an 'cvs -Qq status -v' on each file in the arguments.
144 if ($dostatus != 0) {
145 while (@files) {
146 $file = shift @files;
147 if ($file eq "-") {
148 print OUT "[input file was '-']\n";
149 if (MAIL) {
150 print MAIL "[input file was '-']\n";
152 last;
154 $pid = open(RCS, "-|");
155 if ( !defined $pid )
157 die "fork failed: $!";
159 if ($pid == 0)
161 exec 'cvs', '-nQq', 'status', '-v', $file;
162 die "cvs exec failed: $!";
164 while (<RCS>) {
165 print OUT;
166 if (MAIL) {
167 print MAIL;
170 close(RCS);
174 close(OUT);
175 die "Write to $logfile failed" if $?;
177 close(MAIL);
178 die "Pipe to $mailcmd failed" if $?;
180 ## must exit cleanly
182 exit 0;