1 |
#!/bin/sh |
2 |
exec perl -w -x $0 ${1+"$@"} # -*- mode: perl; perl-indent-level: 2; -*- |
3 |
#!perl -w |
4 |
|
5 |
|
6 |
############################################################## |
7 |
### ### |
8 |
### cvs2cl.pl: produce ChangeLog(s) from `cvs log` output. ### |
9 |
### ### |
10 |
############################################################## |
11 |
|
12 |
## $Id: cvs2cl.pl,v 1.1 2004/11/23 12:30:21 paultcochrane Exp $ |
13 |
## $Revision: 1.1 $ |
14 |
## $Date: 2004/11/23 12:30:21 $ |
15 |
## $Author: paultcochrane $ |
16 |
## |
17 |
## (C) 2001,2002,2003 Martyn J. Pearce <fluffy@cpan.org>, under the GNU GPL. |
18 |
## (C) 1999 Karl Fogel <kfogel@red-bean.com>, under the GNU GPL. |
19 |
## |
20 |
## (Extensively hacked on by Melissa O'Neill <oneill@cs.sfu.ca>.) |
21 |
## (Gecos hacking by Robin Johnson <robbat2@orbis-terrarum.net>.) |
22 |
## |
23 |
## cvs2cl.pl is free software; you can redistribute it and/or modify |
24 |
## it under the terms of the GNU General Public License as published by |
25 |
## the Free Software Foundation; either version 2, or (at your option) |
26 |
## any later version. |
27 |
## |
28 |
## cvs2cl.pl is distributed in the hope that it will be useful, |
29 |
## but WITHOUT ANY WARRANTY; without even the implied warranty of |
30 |
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
31 |
## GNU General Public License for more details. |
32 |
## |
33 |
## You may have received a copy of the GNU General Public License |
34 |
## along with cvs2cl.pl; see the file COPYING. If not, write to the |
35 |
## Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
36 |
## Boston, MA 02111-1307, USA. |
37 |
|
38 |
|
39 |
use strict; |
40 |
use Text::Wrap qw( ); |
41 |
use Time::Local; |
42 |
use File::Basename qw( fileparse ); |
43 |
use User::pwent; |
44 |
|
45 |
|
46 |
# The Plan: |
47 |
# |
48 |
# Read in the logs for multiple files, spit out a nice ChangeLog that |
49 |
# mirrors the information entered during `cvs commit'. |
50 |
# |
51 |
# The problem presents some challenges. In an ideal world, we could |
52 |
# detect files with the same author, log message, and checkin time -- |
53 |
# each <filelist, author, time, logmessage> would be a changelog entry. |
54 |
# We'd sort them; and spit them out. Unfortunately, CVS is *not atomic* |
55 |
# so checkins can span a range of times. Also, the directory structure |
56 |
# could be hierarchical. |
57 |
# |
58 |
# Another question is whether we really want to have the ChangeLog |
59 |
# exactly reflect commits. An author could issue two related commits, |
60 |
# with different log entries, reflecting a single logical change to the |
61 |
# source. GNU style ChangeLogs group these under a single author/date. |
62 |
# We try to do the same. |
63 |
# |
64 |
# So, we parse the output of `cvs log', storing log messages in a |
65 |
# multilevel hash that stores the mapping: |
66 |
# directory => author => time => message => filelist |
67 |
# As we go, we notice "nearby" commit times and store them together |
68 |
# (i.e., under the same timestamp), so they appear in the same log |
69 |
# entry. |
70 |
# |
71 |
# When we've read all the logs, we twist this mapping into |
72 |
# a time => author => message => filelist mapping for each directory. |
73 |
# |
74 |
# If we're not using the `--distributed' flag, the directory is always |
75 |
# considered to be `./', even as descend into subdirectories. |
76 |
|
77 |
|
78 |
############### Globals ################ |
79 |
|
80 |
use constant MAILNAME => "/etc/mailname"; |
81 |
|
82 |
# What we run to generate it: |
83 |
my $Log_Source_Command = "cvs log"; |
84 |
|
85 |
# In case we have to print it out: |
86 |
my $VERSION = '$Revision: 1.1 $'; |
87 |
$VERSION =~ s/\S+\s+(\S+)\s+\S+/$1/; |
88 |
|
89 |
## Vars set by options: |
90 |
|
91 |
# Print debugging messages? |
92 |
my $Debug = 0; |
93 |
|
94 |
# Just show version and exit? |
95 |
my $Print_Version = 0; |
96 |
|
97 |
# Just print usage message and exit? |
98 |
my $Print_Usage = 0; |
99 |
|
100 |
# Single top-level ChangeLog, or one per subdirectory? |
101 |
my $Distributed = 0; |
102 |
|
103 |
# What file should we generate (defaults to "ChangeLog")? |
104 |
my $Log_File_Name = "ChangeLog"; |
105 |
|
106 |
# Grab most recent entry date from existing ChangeLog file, just add |
107 |
# to that ChangeLog. |
108 |
my $Cumulative = 0; |
109 |
|
110 |
# `cvs log -d`, this will repeat the last entry in the old log. This is OK, |
111 |
# as it guarantees at least one entry in the update changelog, which means |
112 |
# that there will always be a date to extract for the next update. The repeat |
113 |
# entry can be removed in postprocessing, if necessary. |
114 |
my $Update = 0; |
115 |
|
116 |
# Expand usernames to email addresses based on a map file? |
117 |
my $User_Map_File = ""; |
118 |
my $User_Passwd_File; |
119 |
my $Mail_Domain; |
120 |
|
121 |
# Output log in chronological order? [default is reverse chronological order] |
122 |
my $Chronological_Order = 0; |
123 |
|
124 |
# Grab user details via gecos |
125 |
my $Gecos = 0; |
126 |
|
127 |
# User domain for gecos email addresses |
128 |
my $Domain; |
129 |
|
130 |
# Output to a file or to stdout? |
131 |
my $Output_To_Stdout = 0; |
132 |
|
133 |
# Eliminate empty log messages? |
134 |
my $Prune_Empty_Msgs = 0; |
135 |
|
136 |
# Tags of which not to output |
137 |
my %ignore_tags; |
138 |
|
139 |
# Show only revisions with Tags |
140 |
my %show_tags; |
141 |
|
142 |
# Don't call Text::Wrap on the body of the message |
143 |
my $No_Wrap = 0; |
144 |
|
145 |
# Don't do any pretty print processing |
146 |
my $Summary = 0; |
147 |
|
148 |
# Separates header from log message. Code assumes it is either " " or |
149 |
# "\n\n", so if there's ever an option to set it to something else, |
150 |
# make sure to go through all conditionals that use this var. |
151 |
my $After_Header = " "; |
152 |
|
153 |
# XML Encoding |
154 |
my $XML_Encoding = ''; |
155 |
|
156 |
# Format more for programs than for humans. |
157 |
my $XML_Output = 0; |
158 |
|
159 |
# Do some special tweaks for log data that was written in FSF |
160 |
# ChangeLog style. |
161 |
my $FSF_Style = 0; |
162 |
|
163 |
# Show times in UTC instead of local time |
164 |
my $UTC_Times = 0; |
165 |
|
166 |
# Show times in output? |
167 |
my $Show_Times = 1; |
168 |
|
169 |
# Show day of week in output? |
170 |
my $Show_Day_Of_Week = 0; |
171 |
|
172 |
# Show revision numbers in output? |
173 |
my $Show_Revisions = 0; |
174 |
|
175 |
# Show dead files in output? |
176 |
my $Show_Dead = 0; |
177 |
|
178 |
# Hide dead trunk files which were created as a result of additions on a |
179 |
# branch? |
180 |
my $Hide_Branch_Additions = 1; |
181 |
|
182 |
# Show tags (symbolic names) in output? |
183 |
my $Show_Tags = 0; |
184 |
|
185 |
# Show tags separately in output? |
186 |
my $Show_Tag_Dates = 0; |
187 |
|
188 |
# Show branches by symbolic name in output? |
189 |
my $Show_Branches = 0; |
190 |
|
191 |
# Show only revisions on these branches or their ancestors. |
192 |
my @Follow_Branches; |
193 |
|
194 |
# Don't bother with files matching this regexp. |
195 |
my @Ignore_Files; |
196 |
|
197 |
# How exactly we match entries. We definitely want "o", |
198 |
# and user might add "i" by using --case-insensitive option. |
199 |
my $Case_Insensitive = 0; |
200 |
|
201 |
# Maybe only show log messages matching a certain regular expression. |
202 |
my $Regexp_Gate = ""; |
203 |
|
204 |
# Pass this global option string along to cvs, to the left of `log': |
205 |
my $Global_Opts = ""; |
206 |
|
207 |
# Pass this option string along to the cvs log subcommand: |
208 |
my $Command_Opts = ""; |
209 |
|
210 |
# Read log output from stdin instead of invoking cvs log? |
211 |
my $Input_From_Stdin = 0; |
212 |
|
213 |
# Don't show filenames in output. |
214 |
my $Hide_Filenames = 0; |
215 |
|
216 |
# Don't shorten directory names from filenames. |
217 |
my $Common_Dir = 1; |
218 |
|
219 |
# Max checkin duration. CVS checkin is not atomic, so we may have checkin |
220 |
# times that span a range of time. We assume that checkins will last no |
221 |
# longer than $Max_Checkin_Duration seconds, and that similarly, no |
222 |
# checkins will happen from the same users with the same message less |
223 |
# than $Max_Checkin_Duration seconds apart. |
224 |
my $Max_Checkin_Duration = 180; |
225 |
|
226 |
# What to put at the front of [each] ChangeLog. |
227 |
my $ChangeLog_Header = ""; |
228 |
|
229 |
# Whether to enable 'delta' mode, and for what start/end tags. |
230 |
my $Delta_Mode = 0; |
231 |
my $Delta_From = ""; |
232 |
my $Delta_To = ""; |
233 |
|
234 |
my $TestCode; |
235 |
|
236 |
# Whether to parse filenames from the RCS filename, and if so what |
237 |
# prefix to strip. |
238 |
my $RCS_Mode = 0; |
239 |
my $RCS_Root = ""; |
240 |
|
241 |
## end vars set by options. |
242 |
|
243 |
# latest observed times for the start/end tags in delta mode |
244 |
my $Delta_StartTime = 0; |
245 |
my $Delta_EndTime = 0; |
246 |
|
247 |
# In 'cvs log' output, one long unbroken line of equal signs separates |
248 |
# files: |
249 |
my $file_separator = "=======================================" |
250 |
. "======================================"; |
251 |
|
252 |
# In 'cvs log' output, a shorter line of dashes separates log messages |
253 |
# within a file: |
254 |
my $logmsg_separator = "----------------------------"; |
255 |
|
256 |
my $No_Ancestors = 0; |
257 |
|
258 |
############### End globals ############ |
259 |
|
260 |
|
261 |
|
262 |
&parse_options (); |
263 |
if ( defined $TestCode ) { |
264 |
eval $TestCode; |
265 |
die "Eval failed: '$@'\n" |
266 |
if $@; |
267 |
} else { |
268 |
&derive_change_log (); |
269 |
} |
270 |
|
271 |
|
272 |
### Everything below is subroutine definitions. ### |
273 |
|
274 |
sub run_ext { |
275 |
my ($cmd) = @_; |
276 |
$cmd = [$cmd] |
277 |
unless ref $cmd; |
278 |
local $" = ' '; |
279 |
my $out = qx"@$cmd 2>&1"; |
280 |
my $rv = $?; |
281 |
my ($sig, $core, $exit) = ($? & 127, $? & 128, $? >> 8); |
282 |
return $out, $exit, $sig, $core; |
283 |
} |
284 |
|
285 |
# If accumulating, grab the boundary date from pre-existing ChangeLog. |
286 |
sub maybe_grab_accumulation_date () |
287 |
{ |
288 |
if (! $Cumulative || $Update) { |
289 |
return ""; |
290 |
} |
291 |
|
292 |
# else |
293 |
|
294 |
open (LOG, "$Log_File_Name") |
295 |
or die ("trouble opening $Log_File_Name for reading ($!)"); |
296 |
|
297 |
my $boundary_date; |
298 |
while (<LOG>) |
299 |
{ |
300 |
if (/^(\d\d\d\d-\d\d-\d\d\s+\d\d:\d\d)/) |
301 |
{ |
302 |
$boundary_date = "$1"; |
303 |
last; |
304 |
} |
305 |
} |
306 |
|
307 |
close (LOG); |
308 |
|
309 |
# convert time from utc to local timezone if the ChangeLog has |
310 |
# dates/times in utc |
311 |
if ($UTC_Times && $boundary_date) |
312 |
{ |
313 |
# convert the utc time to a time value |
314 |
my ($year,$mon,$mday,$hour,$min) = $boundary_date =~ |
315 |
m#(\d+)-(\d+)-(\d+)\s+(\d+):(\d+)#; |
316 |
my $time = timegm(0,$min,$hour,$mday,$mon-1,$year-1900); |
317 |
# print the timevalue in the local timezone |
318 |
my ($ignore,$wday); |
319 |
($ignore,$min,$hour,$mday,$mon,$year,$wday) = localtime($time); |
320 |
$boundary_date=sprintf ("%4u-%02u-%02u %02u:%02u", |
321 |
$year+1900,$mon+1,$mday,$hour,$min); |
322 |
} |
323 |
|
324 |
return $boundary_date; |
325 |
} |
326 |
|
327 |
sub wrap { |
328 |
my ($indent1, $indent2, @text) = @_; |
329 |
my $text = Text::Wrap::wrap($indent1, $indent2, @text); |
330 |
# If incoming text looks preformatted, don't get clever |
331 |
if ( grep /^\s+/m, @text ) { |
332 |
return $text; |
333 |
} |
334 |
my @lines = split /\n/, $text; |
335 |
$indent2 =~ s!^((?: {8})+)!"\t" x (length($1)/8)!e; |
336 |
$lines[0] =~ s/^$indent1\s+/$indent1/; |
337 |
s/^$indent2\s+/$indent2/ |
338 |
for @lines[1..$#lines]; |
339 |
my $newtext = join "\n", @lines; |
340 |
$newtext .= "\n" |
341 |
if substr($text, -1) eq "\n"; |
342 |
return $newtext; |
343 |
} |
344 |
|
345 |
# Fills up a ChangeLog structure in the current directory. |
346 |
sub derive_change_log () |
347 |
{ |
348 |
# See "The Plan" above for a full explanation. |
349 |
|
350 |
my %grand_poobah; |
351 |
|
352 |
my $file_full_path; |
353 |
my $time; |
354 |
my $revision; |
355 |
my $author; |
356 |
my $state; |
357 |
my $lines; |
358 |
my $cvsstate; |
359 |
my $msg_txt; |
360 |
my $detected_file_separator; |
361 |
|
362 |
my %tag_date_printed; |
363 |
|
364 |
# Might be adding to an existing ChangeLog |
365 |
my $accumulation_date = &maybe_grab_accumulation_date (); |
366 |
if ($accumulation_date) { |
367 |
# Insert -d immediately after 'cvs log' |
368 |
my $Log_Date_Command = "-d\'>${accumulation_date}\'"; |
369 |
$Log_Source_Command =~ s/(^.*log\S*)/$1 $Log_Date_Command/; |
370 |
&debug ("(adding log msg starting from $accumulation_date)\n"); |
371 |
} |
372 |
|
373 |
# We might be expanding usernames |
374 |
my %usermap; |
375 |
|
376 |
# In general, it's probably not very maintainable to use state |
377 |
# variables like this to tell the loop what it's doing at any given |
378 |
# moment, but this is only the first one, and if we never have more |
379 |
# than a few of these, it's okay. |
380 |
my $collecting_symbolic_names = 0; |
381 |
my %symbolic_names; # Where tag names get stored. |
382 |
my %branch_names; # We'll grab branch names while we're at it. |
383 |
my %branch_numbers; # Save some revisions for @Follow_Branches |
384 |
my @branch_roots; # For showing which files are branch ancestors. |
385 |
|
386 |
# Bleargh. Compensate for a deficiency of custom wrapping. |
387 |
if (($After_Header ne " ") and $FSF_Style) |
388 |
{ |
389 |
$After_Header .= "\t"; |
390 |
} |
391 |
|
392 |
if (! $Input_From_Stdin) { |
393 |
&debug ("(run \"${Log_Source_Command}\")\n"); |
394 |
open (LOG_SOURCE, "$Log_Source_Command |") |
395 |
or die "unable to run \"${Log_Source_Command}\""; |
396 |
} |
397 |
else { |
398 |
open (LOG_SOURCE, "-") or die "unable to open stdin for reading"; |
399 |
} |
400 |
|
401 |
binmode LOG_SOURCE; |
402 |
|
403 |
%usermap = &maybe_read_user_map_file (); |
404 |
|
405 |
while (<LOG_SOURCE>) |
406 |
{ |
407 |
# Canonicalize line endings |
408 |
s/\r$//; |
409 |
my $new_full_path; |
410 |
|
411 |
# If on a new file and don't see filename, skip until we find it, and |
412 |
# when we find it, grab it. |
413 |
if (! (defined $file_full_path)) |
414 |
{ |
415 |
if (/^Working file: (.*)/) { |
416 |
$new_full_path = $1; |
417 |
} elsif ($RCS_Mode && m|^RCS file: $RCS_Root[/\\](.*),v$|) { |
418 |
$new_full_path = $1; |
419 |
} |
420 |
} |
421 |
|
422 |
if (defined $new_full_path) |
423 |
{ |
424 |
$file_full_path = $new_full_path; |
425 |
if (@Ignore_Files) |
426 |
{ |
427 |
my $base; |
428 |
($base, undef, undef) = fileparse ($file_full_path); |
429 |
# Ouch, I wish trailing operators in regexps could be |
430 |
# evaluated on the fly! |
431 |
if ($Case_Insensitive) { |
432 |
if (grep ($file_full_path =~ m|$_|i, @Ignore_Files)) { |
433 |
undef $file_full_path; |
434 |
} |
435 |
} |
436 |
elsif (grep ($file_full_path =~ m|$_|, @Ignore_Files)) { |
437 |
undef $file_full_path; |
438 |
} |
439 |
} |
440 |
next; |
441 |
} |
442 |
|
443 |
# Just spin wheels if no file defined yet. |
444 |
next if (! $file_full_path); |
445 |
|
446 |
# Collect tag names in case we're asked to print them in the output. |
447 |
if (/^symbolic names:$/) { |
448 |
$collecting_symbolic_names = 1; |
449 |
next; # There's no more info on this line, so skip to next |
450 |
} |
451 |
if ($collecting_symbolic_names) |
452 |
{ |
453 |
# All tag names are listed with whitespace in front in cvs log |
454 |
# output; so if see non-whitespace, then we're done collecting. |
455 |
if (/^\S/) { |
456 |
$collecting_symbolic_names = 0; |
457 |
} |
458 |
else # we're looking at a tag name, so parse & store it |
459 |
{ |
460 |
# According to the Cederqvist manual, in node "Tags", tag |
461 |
# names must start with an uppercase or lowercase letter and |
462 |
# can contain uppercase and lowercase letters, digits, `-', |
463 |
# and `_'. However, it's not our place to enforce that, so |
464 |
# we'll allow anything CVS hands us to be a tag: |
465 |
/^\s+([^:]+): ([\d.]+)$/; |
466 |
my $tag_name = $1; |
467 |
my $tag_rev = $2; |
468 |
|
469 |
# A branch number either has an odd number of digit sections |
470 |
# (and hence an even number of dots), or has ".0." as the |
471 |
# second-to-last digit section. Test for these conditions. |
472 |
my $real_branch_rev = ""; |
473 |
if (($tag_rev =~ /^(\d+\.\d+\.)+\d+$/) # Even number of dots... |
474 |
and (! ($tag_rev =~ /^(1\.)+1$/))) # ...but not "1.[1.]1" |
475 |
{ |
476 |
$real_branch_rev = $tag_rev; |
477 |
} |
478 |
elsif ($tag_rev =~ /(\d+\.(\d+\.)+)0.(\d+)/) # Has ".0." |
479 |
{ |
480 |
$real_branch_rev = $1 . $3; |
481 |
} |
482 |
# If we got a branch, record its number. |
483 |
if ($real_branch_rev) |
484 |
{ |
485 |
$branch_names{$real_branch_rev} = $tag_name; |
486 |
if (@Follow_Branches) { |
487 |
if (grep ($_ eq $tag_name, @Follow_Branches)) { |
488 |
$branch_numbers{$tag_name} = $real_branch_rev; |
489 |
} |
490 |
} |
491 |
} |
492 |
else { |
493 |
# Else it's just a regular (non-branch) tag. |
494 |
push (@{$symbolic_names{$tag_rev}}, $tag_name); |
495 |
} |
496 |
} |
497 |
} |
498 |
# End of code for collecting tag names. |
499 |
|
500 |
# If have file name, but not revision, and see revision, then grab |
501 |
# it. (We collect unconditionally, even though we may or may not |
502 |
# ever use it.) |
503 |
if ((! (defined $revision)) and (/^revision (\d+\.[\d.]+)/)) |
504 |
{ |
505 |
$revision = $1; |
506 |
|
507 |
if (@Follow_Branches) |
508 |
{ |
509 |
foreach my $branch (@Follow_Branches) |
510 |
{ |
511 |
# Special case for following trunk revisions |
512 |
if (($branch =~ /^trunk$/i) and ($revision =~ /^[0-9]+\.[0-9]+$/)) |
513 |
{ |
514 |
goto dengo; |
515 |
} |
516 |
|
517 |
my $branch_number = $branch_numbers{$branch}; |
518 |
if ($branch_number) |
519 |
{ |
520 |
# Are we on one of the follow branches or an ancestor of |
521 |
# same? |
522 |
# |
523 |
# If this revision is a prefix of the branch number, or |
524 |
# possibly is less in the minormost number, OR if this |
525 |
# branch number is a prefix of the revision, then yes. |
526 |
# Otherwise, no. |
527 |
# |
528 |
# So below, we determine if any of those conditions are |
529 |
# met. |
530 |
|
531 |
# Trivial case: is this revision on the branch? |
532 |
# (Compare this way to avoid regexps that screw up Emacs |
533 |
# indentation, argh.) |
534 |
if ((substr ($revision, 0, ((length ($branch_number)) + 1))) |
535 |
eq ($branch_number . ".")) |
536 |
{ |
537 |
goto dengo; |
538 |
} |
539 |
# Non-trivial case: check if rev is ancestral to branch |
540 |
elsif ((length ($branch_number)) > (length ($revision)) |
541 |
and |
542 |
$No_Ancestors) |
543 |
{ |
544 |
$revision =~ /^((?:\d+\.)+)(\d+)$/; |
545 |
my $r_left = $1; # still has the trailing "." |
546 |
my $r_end = $2; |
547 |
|
548 |
$branch_number =~ /^((?:\d+\.)+)(\d+)\.\d+$/; |
549 |
my $b_left = $1; # still has trailing "." |
550 |
my $b_mid = $2; # has no trailing "." |
551 |
|
552 |
if (($r_left eq $b_left) |
553 |
&& ($r_end <= $b_mid)) |
554 |
{ |
555 |
goto dengo; |
556 |
} |
557 |
} |
558 |
} |
559 |
} |
560 |
} |
561 |
else # (! @Follow_Branches) |
562 |
{ |
563 |
next; |
564 |
} |
565 |
|
566 |
# Else we are following branches, but this revision isn't on the |
567 |
# path. So skip it. |
568 |
undef $revision; |
569 |
dengo: |
570 |
next; |
571 |
} |
572 |
|
573 |
# If we don't have a revision right now, we couldn't possibly |
574 |
# be looking at anything useful. |
575 |
if (! (defined ($revision))) { |
576 |
$detected_file_separator = /^$file_separator$/o; |
577 |
if ($detected_file_separator) { |
578 |
# No revisions for this file; can happen, e.g. "cvs log -d DATE" |
579 |
goto CLEAR; |
580 |
} |
581 |
else { |
582 |
next; |
583 |
} |
584 |
} |
585 |
|
586 |
# If have file name but not date and author, and see date or |
587 |
# author, then grab them: |
588 |
unless (defined $time) |
589 |
{ |
590 |
if (/^date: .*/) |
591 |
{ |
592 |
($time, $author, $state, $lines) = |
593 |
&parse_date_author_and_state ($_); |
594 |
if (defined ($usermap{$author}) and $usermap{$author}) { |
595 |
$author = $usermap{$author}; |
596 |
} elsif(defined $Domain or $Gecos == 1) { |
597 |
my $email = $author; |
598 |
if(defined $Domain && $Domain ne '') { |
599 |
$email = $author."@".$Domain; |
600 |
} |
601 |
my $pw = getpwnam($author); |
602 |
my $fullname; |
603 |
my $office; |
604 |
my $workphone; |
605 |
my $homephone; |
606 |
for (($fullname, $office, $workphone, $homephone) = split /\s*,\s*/, $pw->gecos) { |
607 |
s/&/ucfirst(lc($pw->name))/ge; |
608 |
} |
609 |
if($fullname ne "") { |
610 |
$author = $fullname . " <" . $email . ">"; |
611 |
} |
612 |
} |
613 |
} |
614 |
else { |
615 |
$detected_file_separator = /^$file_separator$/o; |
616 |
if ($detected_file_separator) { |
617 |
# No revisions for this file; can happen, e.g. "cvs log -d DATE" |
618 |
goto CLEAR; |
619 |
} |
620 |
} |
621 |
# If the date/time/author hasn't been found yet, we couldn't |
622 |
# possibly care about anything we see. So skip: |
623 |
next; |
624 |
} |
625 |
|
626 |
# A "branches: ..." line here indicates that one or more branches |
627 |
# are rooted at this revision. If we're showing branches, then we |
628 |
# want to show that fact as well, so we collect all the branches |
629 |
# that this is the latest ancestor of and store them in |
630 |
# @branch_roots. Just for reference, the format of the line we're |
631 |
# seeing at this point is: |
632 |
# |
633 |
# branches: 1.5.2; 1.5.4; ...; |
634 |
# |
635 |
# Okay, here goes: |
636 |
|
637 |
if (/^branches:\s+(.*);$/) |
638 |
{ |
639 |
if ($Show_Branches) |
640 |
{ |
641 |
my $lst = $1; |
642 |
$lst =~ s/(1\.)+1;|(1\.)+1$//; # ignore the trivial branch 1.1.1 |
643 |
if ($lst) { |
644 |
@branch_roots = split (/;\s+/, $lst); |
645 |
} |
646 |
else { |
647 |
undef @branch_roots; |
648 |
} |
649 |
next; |
650 |
} |
651 |
else |
652 |
{ |
653 |
# Ugh. This really bothers me. Suppose we see a log entry |
654 |
# like this: |
655 |
# |
656 |
# ---------------------------- |
657 |
# revision 1.1 |
658 |
# date: 1999/10/17 03:07:38; author: jrandom; state: Exp; |
659 |
# branches: 1.1.2; |
660 |
# Intended first line of log message begins here. |
661 |
# ---------------------------- |
662 |
# |
663 |
# The question is, how we can tell the difference between that |
664 |
# log message and a *two*-line log message whose first line is |
665 |
# |
666 |
# "branches: 1.1.2;" |
667 |
# |
668 |
# See the problem? The output of "cvs log" is inherently |
669 |
# ambiguous. |
670 |
# |
671 |
# For now, we punt: we liberally assume that people don't |
672 |
# write log messages like that, and just toss a "branches:" |
673 |
# line if we see it but are not showing branches. I hope no |
674 |
# one ever loses real log data because of this. |
675 |
next; |
676 |
} |
677 |
} |
678 |
|
679 |
# If have file name, time, and author, then we're just grabbing |
680 |
# log message texts: |
681 |
$detected_file_separator = /^$file_separator$/o; |
682 |
if ($detected_file_separator && ! (defined $revision)) { |
683 |
# No revisions for this file; can happen, e.g. "cvs log -d DATE" |
684 |
goto CLEAR; |
685 |
} |
686 |
unless ($detected_file_separator || /^$logmsg_separator$/o) |
687 |
{ |
688 |
$msg_txt .= $_; # Normally, just accumulate the message... |
689 |
next; |
690 |
} |
691 |
# ... until a msg separator is encountered: |
692 |
# Ensure the message contains something: |
693 |
if ((! $msg_txt) |
694 |
|| ($msg_txt =~ /^\s*\.\s*$|^\s*$/) |
695 |
|| ($msg_txt =~ /\*\*\* empty log message \*\*\*/)) |
696 |
{ |
697 |
if ($Prune_Empty_Msgs) { |
698 |
goto CLEAR; |
699 |
} |
700 |
# else |
701 |
$msg_txt = "[no log message]\n"; |
702 |
} |
703 |
|
704 |
### Store it all in the Grand Poobah: |
705 |
{ |
706 |
my $dir_key; # key into %grand_poobah |
707 |
my %qunk; # complicated little jobbie, see below |
708 |
|
709 |
# Each revision of a file has a little data structure (a `qunk') |
710 |
# associated with it. That data structure holds not only the |
711 |
# file's name, but any additional information about the file |
712 |
# that might be needed in the output, such as the revision |
713 |
# number, tags, branches, etc. The reason to have these things |
714 |
# arranged in a data structure, instead of just appending them |
715 |
# textually to the file's name, is that we may want to do a |
716 |
# little rearranging later as we write the output. For example, |
717 |
# all the files on a given tag/branch will go together, followed |
718 |
# by the tag in parentheses (so trunk or otherwise non-tagged |
719 |
# files would go at the end of the file list for a given log |
720 |
# message). This rearrangement is a lot easier to do if we |
721 |
# don't have to reparse the text. |
722 |
# |
723 |
# A qunk looks like this: |
724 |
# |
725 |
# { |
726 |
# filename => "hello.c", |
727 |
# revision => "1.4.3.2", |
728 |
# time => a timegm() return value (moment of commit) |
729 |
# tags => [ "tag1", "tag2", ... ], |
730 |
# branch => "branchname" # There should be only one, right? |
731 |
# branchroots => [ "branchtag1", "branchtag2", ... ] |
732 |
# } |
733 |
|
734 |
if ($Distributed) { |
735 |
# Just the basename, don't include the path. |
736 |
($qunk{'filename'}, $dir_key, undef) = fileparse ($file_full_path); |
737 |
} |
738 |
else { |
739 |
$dir_key = "./"; |
740 |
$qunk{'filename'} = $file_full_path; |
741 |
} |
742 |
|
743 |
# This may someday be used in a more sophisticated calculation |
744 |
# of what other files are involved in this commit. For now, we |
745 |
# don't use it much except for delta mode, because the |
746 |
# common-commit-detection algorithm is hypothesized to be |
747 |
# "good enough" as it stands. |
748 |
$qunk{'time'} = $time; |
749 |
|
750 |
# We might be including revision numbers and/or tags and/or |
751 |
# branch names in the output. Most of the code from here to |
752 |
# loop-end deals with organizing these in qunk. |
753 |
|
754 |
$qunk{'revision'} = $revision; |
755 |
$qunk{'state'} = $state; |
756 |
if ( defined( $lines )) { |
757 |
$qunk{'lines'} = $lines; |
758 |
} |
759 |
|
760 |
# Grab the branch, even though we may or may not need it: |
761 |
$qunk{'revision'} =~ /((?:\d+\.)+)\d+/; |
762 |
my $branch_prefix = $1; |
763 |
$branch_prefix =~ s/\.$//; # strip off final dot |
764 |
if ($branch_names{$branch_prefix}) { |
765 |
$qunk{'branch'} = $branch_names{$branch_prefix}; |
766 |
} |
767 |
|
768 |
# Keep a record of the file's cvs state. |
769 |
$qunk{'cvsstate'} = $state; |
770 |
|
771 |
# If there's anything in the @branch_roots array, then this |
772 |
# revision is the root of at least one branch. We'll display |
773 |
# them as branch names instead of revision numbers, the |
774 |
# substitution for which is done directly in the array: |
775 |
if (@branch_roots) { |
776 |
my @roots = map { $branch_names{$_} } @branch_roots; |
777 |
$qunk{'branchroots'} = \@roots; |
778 |
} |
779 |
|
780 |
# Save tags too. |
781 |
if (defined ($symbolic_names{$revision})) { |
782 |
$qunk{'tags'} = $symbolic_names{$revision}; |
783 |
delete $symbolic_names{$revision}; |
784 |
|
785 |
# If we're in 'delta' mode, update the latest observed |
786 |
# times for the beginning and ending tags, and |
787 |
# when we get around to printing output, we will simply restrict |
788 |
# ourselves to that timeframe... |
789 |
|
790 |
if ($Delta_Mode) { |
791 |
if (($time > $Delta_StartTime) && |
792 |
(grep { $_ eq $Delta_From } @{$qunk{'tags'}})) |
793 |
{ |
794 |
$Delta_StartTime = $time; |
795 |
} |
796 |
|
797 |
if (($time > $Delta_EndTime) && |
798 |
(grep { $_ eq $Delta_To } @{$qunk{'tags'}})) |
799 |
{ |
800 |
$Delta_EndTime = $time; |
801 |
} |
802 |
} |
803 |
} |
804 |
|
805 |
unless ($Hide_Branch_Additions and $msg_txt =~ /file \S+ was initially added on branch \S+./) { |
806 |
# Add this file to the list |
807 |
# (We use many spoonfuls of autovivication magic. Hashes and arrays |
808 |
# will spring into existence if they aren't there already.) |
809 |
|
810 |
&debug ("(pushing log msg for ${dir_key}$qunk{'filename'})\n"); |
811 |
|
812 |
# Store with the files in this commit. Later we'll loop through |
813 |
# again, making sure that revisions with the same log message |
814 |
# and nearby commit times are grouped together as one commit. |
815 |
push (@{$grand_poobah{$dir_key}{$author}{$time}{$msg_txt}}, \%qunk); |
816 |
} |
817 |
} |
818 |
|
819 |
CLEAR: |
820 |
# Make way for the next message |
821 |
undef $msg_txt; |
822 |
undef $time; |
823 |
undef $revision; |
824 |
undef $author; |
825 |
undef @branch_roots; |
826 |
|
827 |
# Maybe even make way for the next file: |
828 |
if ($detected_file_separator) { |
829 |
undef $file_full_path; |
830 |
undef %branch_names; |
831 |
undef %branch_numbers; |
832 |
undef %symbolic_names; |
833 |
} |
834 |
} |
835 |
|
836 |
close (LOG_SOURCE); |
837 |
|
838 |
### Process each ChangeLog |
839 |
|
840 |
while (my ($dir,$authorhash) = each %grand_poobah) |
841 |
{ |
842 |
&debug ("DOING DIR: $dir\n"); |
843 |
|
844 |
# Here we twist our hash around, from being |
845 |
# author => time => message => filelist |
846 |
# in %$authorhash to |
847 |
# time => author => message => filelist |
848 |
# in %changelog. |
849 |
# |
850 |
# This is also where we merge entries. The algorithm proceeds |
851 |
# through the timeline of the changelog with a sliding window of |
852 |
# $Max_Checkin_Duration seconds; within that window, entries that |
853 |
# have the same log message are merged. |
854 |
# |
855 |
# (To save space, we zap %$authorhash after we've copied |
856 |
# everything out of it.) |
857 |
|
858 |
my %changelog; |
859 |
while (my ($author,$timehash) = each %$authorhash) |
860 |
{ |
861 |
my $lasttime; |
862 |
my %stamptime; |
863 |
foreach my $time (sort {$main::a <=> $main::b} (keys %$timehash)) |
864 |
{ |
865 |
my $msghash = $timehash->{$time}; |
866 |
while (my ($msg,$qunklist) = each %$msghash) |
867 |
{ |
868 |
my $stamptime = $stamptime{$msg}; |
869 |
if ((defined $stamptime) |
870 |
and (($time - $stamptime) < $Max_Checkin_Duration) |
871 |
and (defined $changelog{$stamptime}{$author}{$msg})) |
872 |
{ |
873 |
push(@{$changelog{$stamptime}{$author}{$msg}}, @$qunklist); |
874 |
} |
875 |
else { |
876 |
$changelog{$time}{$author}{$msg} = $qunklist; |
877 |
$stamptime{$msg} = $time; |
878 |
} |
879 |
} |
880 |
} |
881 |
} |
882 |
undef (%$authorhash); |
883 |
|
884 |
### Now we can write out the ChangeLog! |
885 |
|
886 |
my ($logfile_here, $logfile_bak, $tmpfile); |
887 |
|
888 |
if (! $Output_To_Stdout) { |
889 |
$logfile_here = $dir . $Log_File_Name; |
890 |
$logfile_here =~ s/^\.\/\//\//; # fix any leading ".//" problem |
891 |
$tmpfile = "${logfile_here}.cvs2cl$$.tmp"; |
892 |
$logfile_bak = "${logfile_here}.bak"; |
893 |
|
894 |
open (LOG_OUT, ">$tmpfile") or die "Unable to open \"$tmpfile\""; |
895 |
} |
896 |
else { |
897 |
open (LOG_OUT, ">-") or die "Unable to open stdout for writing"; |
898 |
} |
899 |
|
900 |
print LOG_OUT $ChangeLog_Header; |
901 |
|
902 |
if ($XML_Output) { |
903 |
my $encoding = |
904 |
length $XML_Encoding ? qq'encoding="$XML_Encoding"' : ''; |
905 |
my $version = 'version="1.0"'; |
906 |
my $declaration = |
907 |
sprintf '<?xml %s?>', join ' ', grep length, $version, $encoding; |
908 |
my $root = |
909 |
'<changelog xmlns="http://www.red-bean.com/xmlns/cvs2cl/">'; |
910 |
print LOG_OUT "$declaration\n\n$root\n\n"; |
911 |
} |
912 |
|
913 |
my @key_list = (); |
914 |
if($Chronological_Order) { |
915 |
@key_list = sort {$main::a <=> $main::b} (keys %changelog); |
916 |
} else { |
917 |
@key_list = sort {$main::b <=> $main::a} (keys %changelog); |
918 |
} |
919 |
foreach my $time (@key_list) |
920 |
{ |
921 |
next if ($Delta_Mode && |
922 |
(($time <= $Delta_StartTime) || |
923 |
($time > $Delta_EndTime && $Delta_EndTime))); |
924 |
|
925 |
# Set up the date/author line. |
926 |
# kff todo: do some more XML munging here, on the header |
927 |
# part of the entry: |
928 |
my ($ignore,$min,$hour,$mday,$mon,$year,$wday) |
929 |
= $UTC_Times ? gmtime($time) : localtime($time); |
930 |
|
931 |
# XML output includes everything else, we might as well make |
932 |
# it always include Day Of Week too, for consistency. |
933 |
if ($Show_Day_Of_Week or $XML_Output) { |
934 |
$wday = ("Sunday", "Monday", "Tuesday", "Wednesday", |
935 |
"Thursday", "Friday", "Saturday")[$wday]; |
936 |
$wday = ($XML_Output) ? "<weekday>${wday}</weekday>\n" : " $wday"; |
937 |
} |
938 |
else { |
939 |
$wday = ""; |
940 |
} |
941 |
|
942 |
my $authorhash = $changelog{$time}; |
943 |
if ($Show_Tag_Dates) { |
944 |
my %tags; |
945 |
while (my ($author,$mesghash) = each %$authorhash) { |
946 |
while (my ($msg,$qunk) = each %$mesghash) { |
947 |
foreach my $qunkref2 (@$qunk) { |
948 |
if (defined ($$qunkref2{'tags'})) { |
949 |
foreach my $tag (@{$$qunkref2{'tags'}}) { |
950 |
$tags{$tag} = 1; |
951 |
} |
952 |
} |
953 |
} |
954 |
} |
955 |
} |
956 |
foreach my $tag (keys %tags) { |
957 |
if (!defined $tag_date_printed{$tag}) { |
958 |
$tag_date_printed{$tag} = $time; |
959 |
if ($XML_Output) { |
960 |
# NOT YET DONE |
961 |
} |
962 |
else { |
963 |
if ($Show_Times) { |
964 |
printf LOG_OUT ("%4u-%02u-%02u${wday} %02u:%02u tag %s\n\n", |
965 |
$year+1900, $mon+1, $mday, $hour, $min, $tag); |
966 |
} else { |
967 |
printf LOG_OUT ("%4u-%02u-%02u${wday} tag %s\n\n", |
968 |
$year+1900, $mon+1, $mday, $tag); |
969 |
} |
970 |
} |
971 |
} |
972 |
} |
973 |
} |
974 |
while (my ($author,$mesghash) = each %$authorhash) |
975 |
{ |
976 |
# If XML, escape in outer loop to avoid compound quoting: |
977 |
if ($XML_Output) { |
978 |
$author = &xml_escape ($author); |
979 |
} |
980 |
|
981 |
FOOBIE: |
982 |
# We sort here to enable predictable ordering for the testing porpoises |
983 |
for my $msg (sort keys %$mesghash) |
984 |
{ |
985 |
my $qunklist = $mesghash->{$msg}; |
986 |
|
987 |
## MJP: 19.xii.01 : Exclude @ignore_tags |
988 |
for my $ignore_tag (keys %ignore_tags) { |
989 |
next FOOBIE |
990 |
if grep($_ eq $ignore_tag, map(@{$_->{tags}}, |
991 |
grep(defined $_->{tags}, |
992 |
@$qunklist))); |
993 |
} |
994 |
## MJP: 19.xii.01 : End exclude @ignore_tags |
995 |
|
996 |
# show only files with tag --show-tag $show_tag |
997 |
if ( keys %show_tags ) { |
998 |
next FOOBIE |
999 |
if !grep(exists $show_tags{$_}, map(@{$_->{tags}}, |
1000 |
grep(defined $_->{tags}, |
1001 |
@$qunklist))); |
1002 |
} |
1003 |
|
1004 |
my $files = &pretty_file_list ($qunklist); |
1005 |
my $header_line; # date and author |
1006 |
my $body; # see below |
1007 |
my $wholething; # $header_line + $body |
1008 |
|
1009 |
if ($XML_Output) { |
1010 |
$header_line = |
1011 |
sprintf ("<date>%4u-%02u-%02u</date>\n" |
1012 |
. "${wday}" |
1013 |
. "<time>%02u:%02u</time>\n" |
1014 |
. "<author>%s</author>\n", |
1015 |
$year+1900, $mon+1, $mday, $hour, $min, $author); |
1016 |
} |
1017 |
else { |
1018 |
if ($Show_Times) { |
1019 |
$header_line = |
1020 |
sprintf ("%4u-%02u-%02u${wday} %02u:%02u %s\n\n", |
1021 |
$year+1900, $mon+1, $mday, $hour, $min, $author); |
1022 |
} else { |
1023 |
$header_line = |
1024 |
sprintf ("%4u-%02u-%02u${wday} %s\n\n", |
1025 |
$year+1900, $mon+1, $mday, $author); |
1026 |
} |
1027 |
} |
1028 |
|
1029 |
$Text::Wrap::huge = 'overflow' |
1030 |
if $Text::Wrap::VERSION >= 2001.0130; |
1031 |
# Reshape the body according to user preferences. |
1032 |
if ($XML_Output) |
1033 |
{ |
1034 |
$msg = &preprocess_msg_text ($msg); |
1035 |
$body = $files . $msg; |
1036 |
} |
1037 |
elsif ($No_Wrap && !$Summary) |
1038 |
{ |
1039 |
$msg = &preprocess_msg_text ($msg); |
1040 |
$files = wrap ("\t", "\t", "* $files"); |
1041 |
$msg =~ s/\n(.+)/\n\t$1/g; |
1042 |
unless ($After_Header eq " ") { |
1043 |
$msg =~ s/^(.+)/\t$1/g; |
1044 |
} |
1045 |
$body = $files . $After_Header . $msg; |
1046 |
} |
1047 |
elsif ($Summary) |
1048 |
{ |
1049 |
my( $filelist, $qunk ); |
1050 |
my( @DeletedQunks, @AddedQunks, @ChangedQunks ); |
1051 |
|
1052 |
$msg = &preprocess_msg_text ($msg); |
1053 |
# |
1054 |
# Sort the files (qunks) according to the operation that was |
1055 |
# performed. Files which were added have no line change |
1056 |
# indicator, whereas deleted files have state dead. |
1057 |
# |
1058 |
foreach $qunk ( @$qunklist ) |
1059 |
{ |
1060 |
if ( "dead" eq $qunk->{'state'}) |
1061 |
{ |
1062 |
push( @DeletedQunks, $qunk ); |
1063 |
} |
1064 |
elsif ( !exists( $qunk->{'lines'})) |
1065 |
{ |
1066 |
push( @AddedQunks, $qunk ); |
1067 |
} |
1068 |
else |
1069 |
{ |
1070 |
push( @ChangedQunks, $qunk ); |
1071 |
} |
1072 |
} |
1073 |
# |
1074 |
# The qunks list was originally in tree search order. Let's |
1075 |
# get that back. The lists, if they exist, will be reversed upon |
1076 |
# processing. |
1077 |
# |
1078 |
|
1079 |
# |
1080 |
# Now write the three sections onto $filelist |
1081 |
# |
1082 |
if ( @DeletedQunks ) |
1083 |
{ |
1084 |
$filelist .= "\tDeleted:\n"; |
1085 |
foreach $qunk ( @DeletedQunks ) |
1086 |
{ |
1087 |
$filelist .= "\t\t" . $qunk->{'filename'}; |
1088 |
$filelist .= " (" . $qunk->{'revision'} . ")"; |
1089 |
$filelist .= "\n"; |
1090 |
} |
1091 |
undef( @DeletedQunks ); |
1092 |
} |
1093 |
if ( @AddedQunks ) |
1094 |
{ |
1095 |
$filelist .= "\tAdded:\n"; |
1096 |
foreach $qunk ( @AddedQunks ) |
1097 |
{ |
1098 |
$filelist .= "\t\t" . $qunk->{'filename'}; |
1099 |
$filelist .= " (" . $qunk->{'revision'} . ")"; |
1100 |
$filelist .= "\n"; |
1101 |
} |
1102 |
undef( @AddedQunks ); |
1103 |
} |
1104 |
if ( @ChangedQunks ) |
1105 |
{ |
1106 |
$filelist .= "\tChanged:\n"; |
1107 |
foreach $qunk ( @ChangedQunks ) |
1108 |
{ |
1109 |
$filelist .= "\t\t" . $qunk->{'filename'}; |
1110 |
$filelist .= " (" . $qunk->{'revision'} . ")"; |
1111 |
$filelist .= ", \"" . $qunk->{'state'} . "\""; |
1112 |
$filelist .= ", lines: " . $qunk->{'lines'}; |
1113 |
$filelist .= "\n"; |
1114 |
} |
1115 |
undef( @ChangedQunks ); |
1116 |
} |
1117 |
chomp( $filelist ); |
1118 |
$msg =~ s/\n(.*)/\n\t$1/g; |
1119 |
unless ($After_Header eq " ") { |
1120 |
$msg =~ s/^(.*)/\t$1/g; |
1121 |
} |
1122 |
$body = $filelist . $After_Header . $msg; |
1123 |
} |
1124 |
else # do wrapping, either FSF-style or regular |
1125 |
{ |
1126 |
if ($FSF_Style) |
1127 |
{ |
1128 |
$files = wrap ("\t", "\t", "* $files"); |
1129 |
|
1130 |
my $files_last_line_len = 0; |
1131 |
if ($After_Header eq " ") |
1132 |
{ |
1133 |
$files_last_line_len = &last_line_len ($files); |
1134 |
$files_last_line_len += 1; # for $After_Header |
1135 |
} |
1136 |
|
1137 |
$msg = &wrap_log_entry |
1138 |
($msg, "\t", 69 - $files_last_line_len, 69); |
1139 |
$body = $files . $After_Header . $msg; |
1140 |
} |
1141 |
else # not FSF-style |
1142 |
{ |
1143 |
$msg = &preprocess_msg_text ($msg); |
1144 |
$body = $files . $After_Header . $msg; |
1145 |
$body = wrap ("\t", "\t ", "* $body"); |
1146 |
$body =~ s/[ \t]+\n/\n/g; |
1147 |
} |
1148 |
} |
1149 |
|
1150 |
$body =~ s/[ \t]+\n/\n/g; |
1151 |
$wholething = $header_line . $body; |
1152 |
|
1153 |
if ($XML_Output) { |
1154 |
$wholething = "<entry>\n${wholething}</entry>\n"; |
1155 |
} |
1156 |
|
1157 |
# One last check: make sure it passes the regexp test, if the |
1158 |
# user asked for that. We have to do it here, so that the |
1159 |
# test can match against information in the header as well |
1160 |
# as in the text of the log message. |
1161 |
|
1162 |
# How annoying to duplicate so much code just because I |
1163 |
# can't figure out a way to evaluate scalars on the trailing |
1164 |
# operator portion of a regular expression. Grrr. |
1165 |
if ($Case_Insensitive) { |
1166 |
unless ($Regexp_Gate && ($wholething !~ /$Regexp_Gate/oi)) { |
1167 |
print LOG_OUT "${wholething}\n"; |
1168 |
} |
1169 |
} |
1170 |
else { |
1171 |
unless ($Regexp_Gate && ($wholething !~ /$Regexp_Gate/o)) { |
1172 |
print LOG_OUT "${wholething}\n"; |
1173 |
} |
1174 |
} |
1175 |
} |
1176 |
} |
1177 |
} |
1178 |
|
1179 |
if ($XML_Output) { |
1180 |
print LOG_OUT "</changelog>\n"; |
1181 |
} |
1182 |
|
1183 |
close (LOG_OUT); |
1184 |
|
1185 |
if (! $Output_To_Stdout) |
1186 |
{ |
1187 |
# If accumulating, append old data to new before renaming. But |
1188 |
# don't append the most recent entry, since it's already in the |
1189 |
# new log due to CVS's idiosyncratic interpretation of "log -d". |
1190 |
if ($Cumulative && -f $logfile_here) |
1191 |
{ |
1192 |
open (NEW_LOG, ">>$tmpfile") |
1193 |
or die "trouble appending to $tmpfile ($!)"; |
1194 |
|
1195 |
open (OLD_LOG, "<$logfile_here") |
1196 |
or die "trouble reading from $logfile_here ($!)"; |
1197 |
|
1198 |
my $started_first_entry = 0; |
1199 |
my $passed_first_entry = 0; |
1200 |
while (<OLD_LOG>) |
1201 |
{ |
1202 |
if (! $passed_first_entry) |
1203 |
{ |
1204 |
if ((! $started_first_entry) |
1205 |
&& /^(\d\d\d\d-\d\d-\d\d\s+\d\d:\d\d)/) { |
1206 |
$started_first_entry = 1; |
1207 |
} |
1208 |
elsif (/^(\d\d\d\d-\d\d-\d\d\s+\d\d:\d\d)/) { |
1209 |
$passed_first_entry = 1; |
1210 |
print NEW_LOG $_; |
1211 |
} |
1212 |
} |
1213 |
else { |
1214 |
print NEW_LOG $_; |
1215 |
} |
1216 |
} |
1217 |
|
1218 |
close (NEW_LOG); |
1219 |
close (OLD_LOG); |
1220 |
} |
1221 |
|
1222 |
if (-f $logfile_here) { |
1223 |
rename ($logfile_here, $logfile_bak); |
1224 |
} |
1225 |
rename ($tmpfile, $logfile_here); |
1226 |
} |
1227 |
} |
1228 |
} |
1229 |
|
1230 |
sub parse_date_author_and_state () |
1231 |
{ |
1232 |
# Parses the date/time and author out of a line like: |
1233 |
# |
1234 |
# date: 1999/02/19 23:29:05; author: apharris; state: Exp; |
1235 |
|
1236 |
my $line = shift; |
1237 |
|
1238 |
my ($year, $mon, $mday, $hours, $min, $secs, $author, $state, $rest) = |
1239 |
$line =~ |
1240 |
m#(\d+)/(\d+)/(\d+)\s+(\d+):(\d+):(\d+);\s+author:\s+([^;]+);\s+state:\s+([^;]+);(.*)# |
1241 |
or die "Couldn't parse date ``$line''"; |
1242 |
die "Bad date or Y2K issues" unless ($year > 1969 and $year < 2258); |
1243 |
# Kinda arbitrary, but useful as a sanity check |
1244 |
my $time = timegm($secs,$min,$hours,$mday,$mon-1,$year-1900); |
1245 |
my $lines; |
1246 |
if ( $rest =~ m#\s+lines:\s+(.*)# ) |
1247 |
{ |
1248 |
$lines =$1; |
1249 |
} |
1250 |
return ($time, $author, $state, $lines); |
1251 |
} |
1252 |
|
1253 |
# Here we take a bunch of qunks and convert them into printed |
1254 |
# summary that will include all the information the user asked for. |
1255 |
sub pretty_file_list () |
1256 |
{ |
1257 |
if ($Hide_Filenames and (! $XML_Output)) { |
1258 |
return ""; |
1259 |
} |
1260 |
|
1261 |
my $qunksref = shift; |
1262 |
|
1263 |
my @qunkrefs = |
1264 |
grep +((! exists $_->{'tags'} or |
1265 |
! grep exists $ignore_tags{$_}, @{$_->{'tags'}}) and |
1266 |
(! keys %show_tags or |
1267 |
(exists $_->{'tags'} and |
1268 |
grep exists $show_tags{$_}, @{$_->{'tags'}})) |
1269 |
), |
1270 |
@$qunksref; |
1271 |
my @filenames; |
1272 |
my $beauty = ""; # The accumulating header string for this entry. |
1273 |
my %non_unanimous_tags; # Tags found in a proper subset of qunks |
1274 |
my %unanimous_tags; # Tags found in all qunks |
1275 |
my %all_branches; # Branches found in any qunk |
1276 |
my $common_dir = undef; # Dir prefix common to all files ("" if none) |
1277 |
my $fbegun = 0; # Did we begin printing filenames yet? |
1278 |
|
1279 |
# First, loop over the qunks gathering all the tag/branch names. |
1280 |
# We'll put them all in non_unanimous_tags, and take out the |
1281 |
# unanimous ones later. |
1282 |
QUNKREF: |
1283 |
foreach my $qunkref (@qunkrefs) |
1284 |
{ |
1285 |
# Keep track of whether all the files in this commit were in the |
1286 |
# same directory, and memorize it if so. We can make the output a |
1287 |
# little more compact by mentioning the directory only once. |
1288 |
if ($Common_Dir && (scalar (@qunkrefs)) > 1) |
1289 |
{ |
1290 |
if (! (defined ($common_dir))) |
1291 |
{ |
1292 |
my ($base, $dir); |
1293 |
($base, $dir, undef) = fileparse ($$qunkref{'filename'}); |
1294 |
|
1295 |
if ((! (defined ($dir))) # this first case is sheer paranoia |
1296 |
or ($dir eq "") |
1297 |
or ($dir eq "./") |
1298 |
or ($dir eq ".\\")) |
1299 |
{ |
1300 |
$common_dir = ""; |
1301 |
} |
1302 |
else |
1303 |
{ |
1304 |
$common_dir = $dir; |
1305 |
} |
1306 |
} |
1307 |
elsif ($common_dir ne "") |
1308 |
{ |
1309 |
# Already have a common dir prefix, so how much of it can we preserve? |
1310 |
$common_dir = &common_path_prefix ($$qunkref{'filename'}, $common_dir); |
1311 |
} |
1312 |
} |
1313 |
else # only one file in this entry anyway, so common dir not an issue |
1314 |
{ |
1315 |
$common_dir = ""; |
1316 |
} |
1317 |
|
1318 |
if (defined ($$qunkref{'branch'})) { |
1319 |
$all_branches{$$qunkref{'branch'}} = 1; |
1320 |
} |
1321 |
if (defined ($$qunkref{'tags'})) { |
1322 |
foreach my $tag (@{$$qunkref{'tags'}}) { |
1323 |
$non_unanimous_tags{$tag} = 1; |
1324 |
} |
1325 |
} |
1326 |
} |
1327 |
|
1328 |
# Any tag held by all qunks will be printed specially... but only if |
1329 |
# there are multiple qunks in the first place! |
1330 |
if ((scalar (@qunkrefs)) > 1) { |
1331 |
foreach my $tag (keys (%non_unanimous_tags)) { |
1332 |
my $everyone_has_this_tag = 1; |
1333 |
foreach my $qunkref (@qunkrefs) { |
1334 |
if ((! (defined ($$qunkref{'tags'}))) |
1335 |
or (! (grep ($_ eq $tag, @{$$qunkref{'tags'}})))) { |
1336 |
$everyone_has_this_tag = 0; |
1337 |
} |
1338 |
} |
1339 |
if ($everyone_has_this_tag) { |
1340 |
$unanimous_tags{$tag} = 1; |
1341 |
delete $non_unanimous_tags{$tag}; |
1342 |
} |
1343 |
} |
1344 |
} |
1345 |
|
1346 |
if ($XML_Output) |
1347 |
{ |
1348 |
# If outputting XML, then our task is pretty simple, because we |
1349 |
# don't have to detect common dir, common tags, branch prefixing, |
1350 |
# etc. We just output exactly what we have, and don't worry about |
1351 |
# redundancy or readability. |
1352 |
|
1353 |
foreach my $qunkref (@qunkrefs) |
1354 |
{ |
1355 |
my $filename = $$qunkref{'filename'}; |
1356 |
my $cvsstate = $$qunkref{'cvsstate'}; |
1357 |
my $revision = $$qunkref{'revision'}; |
1358 |
my $tags = $$qunkref{'tags'}; |
1359 |
my $branch = $$qunkref{'branch'}; |
1360 |
my $branchroots = $$qunkref{'branchroots'}; |
1361 |
|
1362 |
$filename = &xml_escape ($filename); # probably paranoia |
1363 |
$revision = &xml_escape ($revision); # definitely paranoia |
1364 |
|
1365 |
$beauty .= "<file>\n"; |
1366 |
$beauty .= "<name>${filename}</name>\n"; |
1367 |
$beauty .= "<cvsstate>${cvsstate}</cvsstate>\n"; |
1368 |
$beauty .= "<revision>${revision}</revision>\n"; |
1369 |
if ($branch) { |
1370 |
$branch = &xml_escape ($branch); # more paranoia |
1371 |
$beauty .= "<branch>${branch}</branch>\n"; |
1372 |
} |
1373 |
foreach my $tag (@$tags) { |
1374 |
$tag = &xml_escape ($tag); # by now you're used to the paranoia |
1375 |
$beauty .= "<tag>${tag}</tag>\n"; |
1376 |
} |
1377 |
foreach my $root (@$branchroots) { |
1378 |
$root = &xml_escape ($root); # which is good, because it will continue |
1379 |
$beauty .= "<branchroot>${root}</branchroot>\n"; |
1380 |
} |
1381 |
$beauty .= "</file>\n"; |
1382 |
} |
1383 |
|
1384 |
# Theoretically, we could go home now. But as long as we're here, |
1385 |
# let's print out the common_dir and utags, as a convenience to |
1386 |
# the receiver (after all, earlier code calculated that stuff |
1387 |
# anyway, so we might as well take advantage of it). |
1388 |
|
1389 |
if ((scalar (keys (%unanimous_tags))) > 1) { |
1390 |
foreach my $utag ((keys (%unanimous_tags))) { |
1391 |
$utag = &xml_escape ($utag); # the usual paranoia |
1392 |
$beauty .= "<utag>${utag}</utag>\n"; |
1393 |
} |
1394 |
} |
1395 |
if ($common_dir) { |
1396 |
$common_dir = &xml_escape ($common_dir); |
1397 |
$beauty .= "<commondir>${common_dir}</commondir>\n"; |
1398 |
} |
1399 |
|
1400 |
# That's enough for XML, time to go home: |
1401 |
return $beauty; |
1402 |
} |
1403 |
|
1404 |
# Else not XML output, so complexly compactify for chordate |
1405 |
# consumption. At this point we have enough global information |
1406 |
# about all the qunks to organize them non-redundantly for output. |
1407 |
|
1408 |
if ($common_dir) { |
1409 |
# Note that $common_dir still has its trailing slash |
1410 |
$beauty .= "$common_dir: "; |
1411 |
} |
1412 |
|
1413 |
if ($Show_Branches) |
1414 |
{ |
1415 |
# For trailing revision numbers. |
1416 |
my @brevisions; |
1417 |
|
1418 |
foreach my $branch (keys (%all_branches)) |
1419 |
{ |
1420 |
foreach my $qunkref (@qunkrefs) |
1421 |
{ |
1422 |
if ((defined ($$qunkref{'branch'})) |
1423 |
and ($$qunkref{'branch'} eq $branch)) |
1424 |
{ |
1425 |
if ($fbegun) { |
1426 |
# kff todo: comma-delimited in XML too? Sure. |
1427 |
$beauty .= ", "; |
1428 |
} |
1429 |
else { |
1430 |
$fbegun = 1; |
1431 |
} |
1432 |
my $fname = substr ($$qunkref{'filename'}, length ($common_dir)); |
1433 |
$beauty .= $fname; |
1434 |
$$qunkref{'printed'} = 1; # Just setting a mark bit, basically |
1435 |
|
1436 |
if ($Show_Tags && (defined @{$$qunkref{'tags'}})) { |
1437 |
my @tags = grep ($non_unanimous_tags{$_}, @{$$qunkref{'tags'}}); |
1438 |
|
1439 |
if (@tags) { |
1440 |
$beauty .= " (tags: "; |
1441 |
$beauty .= join (', ', @tags); |
1442 |
$beauty .= ")"; |
1443 |
} |
1444 |
} |
1445 |
|
1446 |
if ($Show_Revisions) { |
1447 |
# Collect the revision numbers' last components, but don't |
1448 |
# print them -- they'll get printed with the branch name |
1449 |
# later. |
1450 |
$$qunkref{'revision'} =~ /.+\.([\d]+)$/; |
1451 |
push (@brevisions, $1); |
1452 |
|
1453 |
# todo: we're still collecting branch roots, but we're not |
1454 |
# showing them anywhere. If we do show them, it would be |
1455 |
# nifty to just call them revision "0" on a the branch. |
1456 |
# Yeah, that's the ticket. |
1457 |
} |
1458 |
} |
1459 |
} |
1460 |
$beauty .= " ($branch"; |
1461 |
if (@brevisions) { |
1462 |
if ((scalar (@brevisions)) > 1) { |
1463 |
$beauty .= ".["; |
1464 |
$beauty .= (join (',', @brevisions)); |
1465 |
$beauty .= "]"; |
1466 |
} |
1467 |
else { |
1468 |
# Square brackets are spurious here, since there's no range to |
1469 |
# encapsulate |
1470 |
$beauty .= ".$brevisions[0]"; |
1471 |
} |
1472 |
} |
1473 |
$beauty .= ")"; |
1474 |
} |
1475 |
} |
1476 |
|
1477 |
# Okay; any qunks that were done according to branch are taken care |
1478 |
# of, and marked as printed. Now print everyone else. |
1479 |
|
1480 |
my %fileinfo_printed; |
1481 |
foreach my $qunkref (@qunkrefs) |
1482 |
{ |
1483 |
next if (defined ($$qunkref{'printed'})); # skip if already printed |
1484 |
|
1485 |
my $b = substr ($$qunkref{'filename'}, length ($common_dir)); |
1486 |
# todo: Shlomo's change was this: |
1487 |
# $beauty .= substr ($$qunkref{'filename'}, |
1488 |
# (($common_dir eq "./") ? "" : length ($common_dir))); |
1489 |
$$qunkref{'printed'} = 1; # Set a mark bit. |
1490 |
|
1491 |
if ($Show_Revisions || $Show_Tags || $Show_Dead) |
1492 |
{ |
1493 |
my $started_addendum = 0; |
1494 |
|
1495 |
if ($Show_Revisions) { |
1496 |
$started_addendum = 1; |
1497 |
$b .= " ("; |
1498 |
$b .= "$$qunkref{'revision'}"; |
1499 |
} |
1500 |
if ($Show_Dead && $$qunkref{'cvsstate'} =~ /dead/) |
1501 |
{ |
1502 |
# Deliberately not using $started_addendum. Keeping it simple. |
1503 |
$b .= "[DEAD]"; |
1504 |
} |
1505 |
if ($Show_Tags && (defined $$qunkref{'tags'})) { |
1506 |
my @tags = grep ($non_unanimous_tags{$_}, @{$$qunkref{'tags'}}); |
1507 |
if ((scalar (@tags)) > 0) { |
1508 |
if ($started_addendum) { |
1509 |
$b .= ", "; |
1510 |
} |
1511 |
else { |
1512 |
$b .= " (tags: "; |
1513 |
} |
1514 |
$b .= join (', ', @tags); |
1515 |
$started_addendum = 1; |
1516 |
} |
1517 |
} |
1518 |
if ($started_addendum) { |
1519 |
$b .= ")"; |
1520 |
} |
1521 |
} |
1522 |
|
1523 |
unless ( exists $fileinfo_printed{$b} ) { |
1524 |
if ($fbegun) { |
1525 |
$beauty .= ", "; |
1526 |
} else { |
1527 |
$fbegun = 1; |
1528 |
} |
1529 |
$beauty .= $b, $fileinfo_printed{$b} = 1; |
1530 |
} |
1531 |
} |
1532 |
|
1533 |
# Unanimous tags always come last. |
1534 |
if ($Show_Tags && %unanimous_tags) |
1535 |
{ |
1536 |
$beauty .= " (utags: "; |
1537 |
$beauty .= join (', ', sort keys (%unanimous_tags)); |
1538 |
$beauty .= ")"; |
1539 |
} |
1540 |
|
1541 |
# todo: still have to take care of branch_roots? |
1542 |
|
1543 |
$beauty = "$beauty:"; |
1544 |
|
1545 |
return $beauty; |
1546 |
} |
1547 |
|
1548 |
sub min ($$) { $_[0] < $_[1] ? $_[0] : $_[1] } |
1549 |
|
1550 |
sub common_path_prefix ($$) |
1551 |
{ |
1552 |
my ($path1, $path2) = @_; |
1553 |
|
1554 |
# For compatibility (with older versions of cvs2cl.pl), we think in UN*X |
1555 |
# terms, and mould windoze filenames to match. Is this really appropriate? |
1556 |
# If a file is checked in under UN*X, and cvs log run on windoze, which way |
1557 |
# do the path separators slope? Can we use fileparse as per the local |
1558 |
# conventions? If so, we should probably have a user option to specify an |
1559 |
# OS to emulate to handle stdin-fed logs. If we did this, we could avoid |
1560 |
# the nasty \-/ transmogrification below. |
1561 |
|
1562 |
my ($dir1, $dir2) = map +(fileparse($_))[1], $path1, $path2; |
1563 |
|
1564 |
# Transmogrify Windows filenames to look like Unix. |
1565 |
# (It is far more likely that someone is running cvs2cl.pl under |
1566 |
# Windows than that they would genuinely have backslashes in their |
1567 |
# filenames.) |
1568 |
tr!\\!/! |
1569 |
for $dir1, $dir2; |
1570 |
|
1571 |
my ($accum1, $accum2, $last_common_prefix) = ('') x 3; |
1572 |
|
1573 |
my @path1 = grep length($_), split qr!/!, $dir1; |
1574 |
my @path2 = grep length($_), split qr!/!, $dir2; |
1575 |
|
1576 |
my @common_path; |
1577 |
for (0..min($#path1,$#path2)) { |
1578 |
if ( $path1[$_] eq $path2[$_]) { |
1579 |
push @common_path, $path1[$_]; |
1580 |
} else { |
1581 |
last; |
1582 |
} |
1583 |
} |
1584 |
|
1585 |
return join '', map "$_/", @common_path; |
1586 |
} |
1587 |
|
1588 |
sub preprocess_msg_text () |
1589 |
{ |
1590 |
my $text = shift; |
1591 |
|
1592 |
# Strip out carriage returns (as they probably result from DOSsy editors). |
1593 |
$text =~ s/\r\n/\n/g; |
1594 |
|
1595 |
# If it *looks* like two newlines, make it *be* two newlines: |
1596 |
$text =~ s/\n\s*\n/\n\n/g; |
1597 |
|
1598 |
if ($XML_Output) |
1599 |
{ |
1600 |
$text = &xml_escape ($text); |
1601 |
$text = "<msg>${text}</msg>\n"; |
1602 |
} |
1603 |
elsif (! $No_Wrap) |
1604 |
{ |
1605 |
# Strip off lone newlines, but only for lines that don't begin with |
1606 |
# whitespace or a mail-quoting character, since we want to preserve |
1607 |
# that kind of formatting. Also don't strip newlines that follow a |
1608 |
# period; we handle those specially next. And don't strip |
1609 |
# newlines that precede an open paren. |
1610 |
1 while ($text =~ s/(^|\n)([^>\s].*[^.\n])\n([^>\n])/$1$2 $3/g); |
1611 |
|
1612 |
# If a newline follows a period, make sure that when we bring up the |
1613 |
# bottom sentence, it begins with two spaces. |
1614 |
1 while ($text =~ s/(^|\n)([^>\s].*)\n([^>\n])/$1$2 $3/g); |
1615 |
} |
1616 |
|
1617 |
return $text; |
1618 |
} |
1619 |
|
1620 |
sub last_line_len () |
1621 |
{ |
1622 |
my $files_list = shift; |
1623 |
my @lines = split (/\n/, $files_list); |
1624 |
my $last_line = pop (@lines); |
1625 |
return length ($last_line); |
1626 |
} |
1627 |
|
1628 |
# A custom wrap function, sensitive to some common constructs used in |
1629 |
# log entries. |
1630 |
sub wrap_log_entry () |
1631 |
{ |
1632 |
my $text = shift; # The text to wrap. |
1633 |
my $left_pad_str = shift; # String to pad with on the left. |
1634 |
|
1635 |
# These do NOT take left_pad_str into account: |
1636 |
my $length_remaining = shift; # Amount left on current line. |
1637 |
my $max_line_length = shift; # Amount left for a blank line. |
1638 |
|
1639 |
my $wrapped_text = ""; # The accumulating wrapped entry. |
1640 |
my $user_indent = ""; # Inherited user_indent from prev line. |
1641 |
|
1642 |
my $first_time = 1; # First iteration of the loop? |
1643 |
my $suppress_line_start_match = 0; # Set to disable line start checks. |
1644 |
|
1645 |
my @lines = split (/\n/, $text); |
1646 |
while (@lines) # Don't use `foreach' here, it won't work. |
1647 |
{ |
1648 |
my $this_line = shift (@lines); |
1649 |
chomp $this_line; |
1650 |
|
1651 |
if ($this_line =~ /^(\s+)/) { |
1652 |
$user_indent = $1; |
1653 |
} |
1654 |
else { |
1655 |
$user_indent = ""; |
1656 |
} |
1657 |
|
1658 |
# If it matches any of the line-start regexps, print a newline now... |
1659 |
if ($suppress_line_start_match) |
1660 |
{ |
1661 |
$suppress_line_start_match = 0; |
1662 |
} |
1663 |
elsif (($this_line =~ /^(\s*)\*\s+[a-zA-Z0-9]/) |
1664 |
|| ($this_line =~ /^(\s*)\* [a-zA-Z0-9_\.\/\+-]+/) |
1665 |
|| ($this_line =~ /^(\s*)\([a-zA-Z0-9_\.\/\+-]+(\)|,\s*)/) |
1666 |
|| ($this_line =~ /^(\s+)(\S+)/) |
1667 |
|| ($this_line =~ /^(\s*)- +/) |
1668 |
|| ($this_line =~ /^()\s*$/) |
1669 |
|| ($this_line =~ /^(\s*)\*\) +/) |
1670 |
|| ($this_line =~ /^(\s*)[a-zA-Z0-9](\)|\.|\:) +/)) |
1671 |
{ |
1672 |
# Make a line break immediately, unless header separator is set |
1673 |
# and this line is the first line in the entry, in which case |
1674 |
# we're getting the blank line for free already and shouldn't |
1675 |
# add an extra one. |
1676 |
unless (($After_Header ne " ") and ($first_time)) |
1677 |
{ |
1678 |
if ($this_line =~ /^()\s*$/) { |
1679 |
$suppress_line_start_match = 1; |
1680 |
$wrapped_text .= "\n${left_pad_str}"; |
1681 |
} |
1682 |
|
1683 |
$wrapped_text .= "\n${left_pad_str}"; |
1684 |
} |
1685 |
|
1686 |
$length_remaining = $max_line_length - (length ($user_indent)); |
1687 |
} |
1688 |
|
1689 |
# Now that any user_indent has been preserved, strip off leading |
1690 |
# whitespace, so up-folding has no ugly side-effects. |
1691 |
$this_line =~ s/^\s*//; |
1692 |
|
1693 |
# Accumulate the line, and adjust parameters for next line. |
1694 |
my $this_len = length ($this_line); |
1695 |
if ($this_len == 0) |
1696 |
{ |
1697 |
# Blank lines should cancel any user_indent level. |
1698 |
$user_indent = ""; |
1699 |
$length_remaining = $max_line_length; |
1700 |
} |
1701 |
elsif ($this_len >= $length_remaining) # Line too long, try breaking it. |
1702 |
{ |
1703 |
# Walk backwards from the end. At first acceptable spot, break |
1704 |
# a new line. |
1705 |
my $idx = $length_remaining - 1; |
1706 |
if ($idx < 0) { $idx = 0 }; |
1707 |
while ($idx > 0) |
1708 |
{ |
1709 |
if (substr ($this_line, $idx, 1) =~ /\s/) |
1710 |
{ |
1711 |
my $line_now = substr ($this_line, 0, $idx); |
1712 |
my $next_line = substr ($this_line, $idx); |
1713 |
$this_line = $line_now; |
1714 |
|
1715 |
# Clean whitespace off the end. |
1716 |
chomp $this_line; |
1717 |
|
1718 |
# The current line is ready to be printed. |
1719 |
$this_line .= "\n${left_pad_str}"; |
1720 |
|
1721 |
# Make sure the next line is allowed full room. |
1722 |
$length_remaining = $max_line_length - (length ($user_indent)); |
1723 |
|
1724 |
# Strip next_line, but then preserve any user_indent. |
1725 |
$next_line =~ s/^\s*//; |
1726 |
|
1727 |
# Sneak a peek at the user_indent of the upcoming line, so |
1728 |
# $next_line (which will now precede it) can inherit that |
1729 |
# indent level. Otherwise, use whatever user_indent level |
1730 |
# we currently have, which might be none. |
1731 |
my $next_next_line = shift (@lines); |
1732 |
if ((defined ($next_next_line)) && ($next_next_line =~ /^(\s+)/)) { |
1733 |
$next_line = $1 . $next_line if (defined ($1)); |
1734 |
# $length_remaining = $max_line_length - (length ($1)); |
1735 |
$next_next_line =~ s/^\s*//; |
1736 |
} |
1737 |
else { |
1738 |
$next_line = $user_indent . $next_line; |
1739 |
} |
1740 |
if (defined ($next_next_line)) { |
1741 |
unshift (@lines, $next_next_line); |
1742 |
} |
1743 |
unshift (@lines, $next_line); |
1744 |
|
1745 |
# Our new next line might, coincidentally, begin with one of |
1746 |
# the line-start regexps, so we temporarily turn off |
1747 |
# sensitivity to that until we're past the line. |
1748 |
$suppress_line_start_match = 1; |
1749 |
|
1750 |
last; |
1751 |
} |
1752 |
else |
1753 |
{ |
1754 |
$idx--; |
1755 |
} |
1756 |
} |
1757 |
|
1758 |
if ($idx == 0) |
1759 |
{ |
1760 |
# We bottomed out because the line is longer than the |
1761 |
# available space. But that could be because the space is |
1762 |
# small, or because the line is longer than even the maximum |
1763 |
# possible space. Handle both cases below. |
1764 |
|
1765 |
if ($length_remaining == ($max_line_length - (length ($user_indent)))) |
1766 |
{ |
1767 |
# The line is simply too long -- there is no hope of ever |
1768 |
# breaking it nicely, so just insert it verbatim, with |
1769 |
# appropriate padding. |
1770 |
$this_line = "\n${left_pad_str}${this_line}"; |
1771 |
} |
1772 |
else |
1773 |
{ |
1774 |
# Can't break it here, but may be able to on the next round... |
1775 |
unshift (@lines, $this_line); |
1776 |
$length_remaining = $max_line_length - (length ($user_indent)); |
1777 |
$this_line = "\n${left_pad_str}"; |
1778 |
} |
1779 |
} |
1780 |
} |
1781 |
else # $this_len < $length_remaining, so tack on what we can. |
1782 |
{ |
1783 |
# Leave a note for the next iteration. |
1784 |
$length_remaining = $length_remaining - $this_len; |
1785 |
|
1786 |
if ($this_line =~ /\.$/) |
1787 |
{ |
1788 |
$this_line .= " "; |
1789 |
$length_remaining -= 2; |
1790 |
} |
1791 |
else # not a sentence end |
1792 |
{ |
1793 |
$this_line .= " "; |
1794 |
$length_remaining -= 1; |
1795 |
} |
1796 |
} |
1797 |
|
1798 |
# Unconditionally indicate that loop has run at least once. |
1799 |
$first_time = 0; |
1800 |
|
1801 |
$wrapped_text .= "${user_indent}${this_line}"; |
1802 |
} |
1803 |
|
1804 |
# One last bit of padding. |
1805 |
$wrapped_text .= "\n"; |
1806 |
|
1807 |
return $wrapped_text; |
1808 |
} |
1809 |
|
1810 |
sub xml_escape () |
1811 |
{ |
1812 |
my $txt = shift; |
1813 |
$txt =~ s/&/&/g; |
1814 |
$txt =~ s/</</g; |
1815 |
$txt =~ s/>/>/g; |
1816 |
return $txt; |
1817 |
} |
1818 |
|
1819 |
sub maybe_read_user_map_file () |
1820 |
{ |
1821 |
my %expansions; |
1822 |
|
1823 |
if ($User_Map_File) |
1824 |
{ |
1825 |
open (MAPFILE, "<$User_Map_File") |
1826 |
or die ("Unable to open $User_Map_File ($!)"); |
1827 |
|
1828 |
while (<MAPFILE>) |
1829 |
{ |
1830 |
next if /^\s*#/; # Skip comment lines. |
1831 |
next if not /:/; # Skip lines without colons. |
1832 |
|
1833 |
# It is now safe to split on ':'. |
1834 |
my ($username, $expansion) = split ':'; |
1835 |
chomp $expansion; |
1836 |
$expansion =~ s/^'(.*)'$/$1/; |
1837 |
$expansion =~ s/^"(.*)"$/$1/; |
1838 |
|
1839 |
# If it looks like the expansion has a real name already, then |
1840 |
# we toss the username we got from CVS log. Otherwise, keep |
1841 |
# it to use in combination with the email address. |
1842 |
|
1843 |
if ($expansion =~ /^\s*<{0,1}\S+@.*/) { |
1844 |
# Also, add angle brackets if none present |
1845 |
if (! ($expansion =~ /<\S+@\S+>/)) { |
1846 |
$expansions{$username} = "$username <$expansion>"; |
1847 |
} |
1848 |
else { |
1849 |
$expansions{$username} = "$username $expansion"; |
1850 |
} |
1851 |
} |
1852 |
else { |
1853 |
$expansions{$username} = $expansion; |
1854 |
} |
1855 |
} # fi ($User_Map_File) |
1856 |
|
1857 |
close (MAPFILE); |
1858 |
} |
1859 |
|
1860 |
if (defined $User_Passwd_File) |
1861 |
{ |
1862 |
if ( ! defined $Domain ) { |
1863 |
if ( -e MAILNAME ) { |
1864 |
chomp($Domain = slurp_file(MAILNAME)); |
1865 |
} else { |
1866 |
MAILDOMAIN_CMD: |
1867 |
for ([qw(hostname -d)], 'dnsdomainname', 'domainname') { |
1868 |
my ($text, $exit, $sig, $core) = run_ext($_); |
1869 |
if ( $exit == 0 && $sig == 0 && $core == 0 ) { |
1870 |
chomp $text; |
1871 |
if ( length $text ) { |
1872 |
$Domain = $text; |
1873 |
last MAILDOMAIN_CMD; |
1874 |
} |
1875 |
} |
1876 |
} |
1877 |
} |
1878 |
} |
1879 |
|
1880 |
die "No mail domain found\n" |
1881 |
unless defined $Domain; |
1882 |
|
1883 |
open (MAPFILE, "<$User_Passwd_File") |
1884 |
or die ("Unable to open $User_Passwd_File ($!)"); |
1885 |
while (<MAPFILE>) |
1886 |
{ |
1887 |
# all lines are valid |
1888 |
my ($username, $pw, $uid, $gid, $gecos, $homedir, $shell) = split ':'; |
1889 |
my $expansion = ''; |
1890 |
($expansion) = split (',', $gecos) |
1891 |
if defined $gecos && length $gecos; |
1892 |
|
1893 |
my $mailname = $Domain eq '' ? $username : "$username\@$Domain"; |
1894 |
$expansions{$username} = "$expansion <$mailname>"; |
1895 |
} |
1896 |
close (MAPFILE); |
1897 |
} |
1898 |
|
1899 |
return %expansions; |
1900 |
} |
1901 |
|
1902 |
sub parse_options () |
1903 |
{ |
1904 |
# Check this internally before setting the global variable. |
1905 |
my $output_file; |
1906 |
|
1907 |
# If this gets set, we encountered unknown options and will exit at |
1908 |
# the end of this subroutine. |
1909 |
my $exit_with_admonishment = 0; |
1910 |
|
1911 |
my (@Global_Opts, @Local_Opts); |
1912 |
|
1913 |
while (my $arg = shift (@ARGV)) |
1914 |
{ |
1915 |
if ($arg =~ /^-h$|^-help$|^--help$|^--usage$|^-?$/) { |
1916 |
$Print_Usage = 1; |
1917 |
} |
1918 |
elsif ($arg =~ /^--delta$/) { |
1919 |
my $narg = shift(@ARGV) || die "$arg needs argument.\n"; |
1920 |
if ($narg =~ /^([A-Za-z][A-Za-z0-9_\-]*):([A-Za-z][A-Za-z0-9_\-]*)$/) { |
1921 |
$Delta_From = $1; |
1922 |
$Delta_To = $2; |
1923 |
$Delta_Mode = 1; |
1924 |
} else { |
1925 |
die "--delta FROM_TAG:TO_TAG is what you meant to say.\n"; |
1926 |
} |
1927 |
} |
1928 |
elsif ($arg =~ /^--debug$/) { # unadvertised option, heh |
1929 |
$Debug = 1; |
1930 |
} |
1931 |
elsif ($arg =~ /^--version$/) { |
1932 |
$Print_Version = 1; |
1933 |
} |
1934 |
elsif ($arg =~ /^-g$|^--global-opts$/) { |
1935 |
my $narg = shift (@ARGV) || die "$arg needs argument.\n"; |
1936 |
# Don't assume CVS is called "cvs" on the user's system: |
1937 |
push @Global_Opts, $narg; |
1938 |
$Log_Source_Command =~ s/(^\S*)/$1 $narg/; |
1939 |
} |
1940 |
elsif ($arg =~ /^-l$|^--log-opts$/) { |
1941 |
my $narg = shift (@ARGV) || die "$arg needs argument.\n"; |
1942 |
push @Local_Opts, $narg; |
1943 |
$Log_Source_Command .= " $narg"; |
1944 |
} |
1945 |
elsif ($arg =~ /^-f$|^--file$/) { |
1946 |
my $narg = shift (@ARGV) || die "$arg needs argument.\n"; |
1947 |
$output_file = $narg; |
1948 |
} |
1949 |
elsif ($arg =~ /^--accum$/) { |
1950 |
$Cumulative = 1; |
1951 |
} |
1952 |
elsif ($arg =~ /^--update$/) { |
1953 |
$Update = 1; |
1954 |
} |
1955 |
elsif ($arg =~ /^--fsf$/) { |
1956 |
$FSF_Style = 1; |
1957 |
} |
1958 |
elsif ($arg =~ /^--FSF$/) { |
1959 |
$Show_Times = 0; |
1960 |
$Common_Dir = 0; |
1961 |
} |
1962 |
elsif ($arg =~ /^--rcs/) { |
1963 |
my $narg = shift (@ARGV) || die "$arg needs argument.\n"; |
1964 |
$RCS_Root = $narg; |
1965 |
$RCS_Mode = 1; |
1966 |
} |
1967 |
elsif ($arg =~ /^-U$|^--usermap$/) { |
1968 |
my $narg = shift (@ARGV) || die "$arg needs argument.\n"; |
1969 |
$User_Map_File = $narg; |
1970 |
} |
1971 |
elsif ($arg =~ /^--gecos$/) { |
1972 |
$Gecos = 1; |
1973 |
} |
1974 |
elsif ($arg =~ /^--domain$/) { |
1975 |
my $narg = shift (@ARGV) || die "$arg needs argument.\n"; |
1976 |
$Domain = $narg; |
1977 |
} |
1978 |
elsif ($arg =~ /^--passwd$/) { |
1979 |
my $narg = shift (@ARGV) || die "$arg needs argument.\n"; |
1980 |
$User_Passwd_File = $narg; |
1981 |
} |
1982 |
elsif ($arg =~ /^--mailname$/) { |
1983 |
my $narg = shift (@ARGV) || die "$arg needs argument.\n"; |
1984 |
warn "--mailname is deprecated; please use --domain instead\n"; |
1985 |
$Domain = $narg; |
1986 |
} |
1987 |
elsif ($arg =~ /^-W$|^--window$/) { |
1988 |
defined(my $narg = shift (@ARGV)) || die "$arg needs argument.\n"; |
1989 |
$Max_Checkin_Duration = $narg; |
1990 |
} |
1991 |
elsif ($arg =~ /^--chrono$/) { |
1992 |
$Chronological_Order = 1; |
1993 |
} |
1994 |
elsif ($arg =~ /^-I$|^--ignore$/) { |
1995 |
my $narg = shift (@ARGV) || die "$arg needs argument.\n"; |
1996 |
push (@Ignore_Files, $narg); |
1997 |
} |
1998 |
elsif ($arg =~ /^-C$|^--case-insensitive$/) { |
1999 |
$Case_Insensitive = 1; |
2000 |
} |
2001 |
elsif ($arg =~ /^-R$|^--regexp$/) { |
2002 |
my $narg = shift (@ARGV) || die "$arg needs argument.\n"; |
2003 |
$Regexp_Gate = $narg; |
2004 |
} |
2005 |
elsif ($arg =~ /^--stdout$/) { |
2006 |
$Output_To_Stdout = 1; |
2007 |
} |
2008 |
elsif ($arg =~ /^--version$/) { |
2009 |
$Print_Version = 1; |
2010 |
} |
2011 |
elsif ($arg =~ /^-d$|^--distributed$/) { |
2012 |
$Distributed = 1; |
2013 |
} |
2014 |
elsif ($arg =~ /^-P$|^--prune$/) { |
2015 |
$Prune_Empty_Msgs = 1; |
2016 |
} |
2017 |
elsif ($arg =~ /^-S$|^--separate-header$/) { |
2018 |
$After_Header = "\n\n"; |
2019 |
} |
2020 |
elsif ($arg =~ /^--no-wrap$/) { |
2021 |
$No_Wrap = 1; |
2022 |
} |
2023 |
elsif ($arg =~ /^--summary$/) { |
2024 |
$Summary = 1; |
2025 |
$After_Header = "\n\n"; # Summary implies --separate-header |
2026 |
} |
2027 |
elsif ($arg =~ /^--gmt$|^--utc$/) { |
2028 |
$UTC_Times = 1; |
2029 |
} |
2030 |
elsif ($arg =~ /^-w$|^--day-of-week$/) { |
2031 |
$Show_Day_Of_Week = 1; |
2032 |
} |
2033 |
elsif ($arg =~ /^--no-times$/) { |
2034 |
$Show_Times = 0; |
2035 |
} |
2036 |
elsif ($arg =~ /^-r$|^--revisions$/) { |
2037 |
$Show_Revisions = 1; |
2038 |
} |
2039 |
elsif ($arg =~ /^--show-dead$/) { |
2040 |
$Show_Dead = 1; |
2041 |
} |
2042 |
elsif ($arg =~ /^--no-hide-branch-additions$/) { |
2043 |
$Hide_Branch_Additions = 0; |
2044 |
} |
2045 |
elsif ($arg =~ /^-t$|^--tags$/) { |
2046 |
$Show_Tags = 1; |
2047 |
} |
2048 |
elsif ($arg =~ /^-T$|^--tagdates$/) { |
2049 |
$Show_Tag_Dates = 1; |
2050 |
} |
2051 |
elsif ($arg =~ /^-b$|^--branches$/) { |
2052 |
$Show_Branches = 1; |
2053 |
} |
2054 |
elsif ($arg =~ /^-F$|^--follow$/) { |
2055 |
my $narg = shift (@ARGV) || die "$arg needs argument.\n"; |
2056 |
push (@Follow_Branches, $narg); |
2057 |
} |
2058 |
elsif ($arg =~ /^--stdin$/) { |
2059 |
$Input_From_Stdin = 1; |
2060 |
} |
2061 |
elsif ($arg =~ /^--header$/) { |
2062 |
my $narg = shift (@ARGV) || die "$arg needs argument.\n"; |
2063 |
$ChangeLog_Header = &slurp_file ($narg); |
2064 |
if (! defined ($ChangeLog_Header)) { |
2065 |
$ChangeLog_Header = ""; |
2066 |
} |
2067 |
} |
2068 |
elsif ($arg =~ /^--xml-encoding$/) { |
2069 |
my $narg = shift (@ARGV) || die "$arg needs argument.\n"; |
2070 |
$XML_Encoding = $narg ; |
2071 |
} |
2072 |
elsif ($arg =~ /^--xml$/) { |
2073 |
$XML_Output = 1; |
2074 |
} |
2075 |
elsif ($arg =~ /^--hide-filenames$/) { |
2076 |
$Hide_Filenames = 1; |
2077 |
$After_Header = ""; |
2078 |
} |
2079 |
elsif ($arg =~ /^--no-common-dir$/) { |
2080 |
$Common_Dir = 0; |
2081 |
} |
2082 |
elsif ($arg =~ /^--ignore-tag$/ ) { |
2083 |
die "$arg needs argument.\n" |
2084 |
unless @ARGV; |
2085 |
$ignore_tags{shift @ARGV} = 1; |
2086 |
} |
2087 |
elsif ($arg =~ /^--show-tag$/ ) { |
2088 |
die "$arg needs argument.\n" |
2089 |
unless @ARGV; |
2090 |
$show_tags{shift @ARGV} = 1; |
2091 |
} |
2092 |
elsif ( lc ($arg) eq '--test-code' ) { |
2093 |
# Deliberately undocumented. This is not a public interface, |
2094 |
# and may change/disappear at any time. |
2095 |
die "$arg needs argument.\n" |
2096 |
unless @ARGV; |
2097 |
$TestCode = shift @ARGV; |
2098 |
} |
2099 |
elsif ($arg =~ /^--no-ancestors$/) { |
2100 |
$No_Ancestors = 1; |
2101 |
} |
2102 |
else { |
2103 |
# Just add a filename as argument to the log command |
2104 |
$Log_Source_Command .= " '$arg'"; |
2105 |
} |
2106 |
} |
2107 |
|
2108 |
## Check for contradictions... |
2109 |
|
2110 |
if ($Output_To_Stdout && $Distributed) { |
2111 |
print STDERR "cannot pass both --stdout and --distributed\n"; |
2112 |
$exit_with_admonishment = 1; |
2113 |
} |
2114 |
|
2115 |
if ($Output_To_Stdout && $output_file) { |
2116 |
print STDERR "cannot pass both --stdout and --file\n"; |
2117 |
$exit_with_admonishment = 1; |
2118 |
} |
2119 |
|
2120 |
if ($Input_From_Stdin && @Global_Opts) { |
2121 |
print STDERR "cannot pass both --stdin and -g\n"; |
2122 |
$exit_with_admonishment = 1; |
2123 |
} |
2124 |
|
2125 |
if ($Input_From_Stdin && @Local_Opts) { |
2126 |
print STDERR "cannot pass both --stdin and -l\n"; |
2127 |
$exit_with_admonishment = 1; |
2128 |
} |
2129 |
|
2130 |
if ($XML_Output && $Cumulative) { |
2131 |
print STDERR "cannot pass both --xml and --accum\n"; |
2132 |
$exit_with_admonishment = 1; |
2133 |
} |
2134 |
|
2135 |
# Or if any other error message has already been printed out, we |
2136 |
# just leave now: |
2137 |
if ($exit_with_admonishment) { |
2138 |
&usage (); |
2139 |
exit (1); |
2140 |
} |
2141 |
elsif ($Print_Usage) { |
2142 |
&usage (); |
2143 |
exit (0); |
2144 |
} |
2145 |
elsif ($Print_Version) { |
2146 |
&version (); |
2147 |
exit (0); |
2148 |
} |
2149 |
|
2150 |
## Else no problems, so proceed. |
2151 |
|
2152 |
if ($output_file) { |
2153 |
$Log_File_Name = $output_file; |
2154 |
} |
2155 |
} |
2156 |
|
2157 |
sub slurp_file () |
2158 |
{ |
2159 |
my $filename = shift || die ("no filename passed to slurp_file()"); |
2160 |
my $retstr; |
2161 |
|
2162 |
open (SLURPEE, "<${filename}") or die ("unable to open $filename ($!)"); |
2163 |
my $saved_sep = $/; |
2164 |
undef $/; |
2165 |
$retstr = <SLURPEE>; |
2166 |
$/ = $saved_sep; |
2167 |
close (SLURPEE); |
2168 |
return $retstr; |
2169 |
} |
2170 |
|
2171 |
sub debug () |
2172 |
{ |
2173 |
if ($Debug) { |
2174 |
my $msg = shift; |
2175 |
print STDERR $msg; |
2176 |
} |
2177 |
} |
2178 |
|
2179 |
sub version () |
2180 |
{ |
2181 |
print "cvs2cl.pl version ${VERSION}; distributed under the GNU GPL.\n"; |
2182 |
} |
2183 |
|
2184 |
sub usage () |
2185 |
{ |
2186 |
&version (); |
2187 |
print <<'END_OF_INFO'; |
2188 |
Generate GNU-style ChangeLogs in CVS working copies. |
2189 |
|
2190 |
Notes about the output format(s): |
2191 |
|
2192 |
The default output of cvs2cl.pl is designed to be compact, formally |
2193 |
unambiguous, but still easy for humans to read. It is largely |
2194 |
self-explanatory, I hope; the one abbreviation that might not be |
2195 |
obvious is "utags". That stands for "universal tags" -- a |
2196 |
universal tag is one held by all the files in a given change entry. |
2197 |
|
2198 |
If you need output that's easy for a program to parse, use the |
2199 |
--xml option. Note that with XML output, just about all available |
2200 |
information is included with each change entry, whether you asked |
2201 |
for it or not, on the theory that your parser can ignore anything |
2202 |
it's not looking for. |
2203 |
|
2204 |
Notes about the options and arguments (the actual options are listed |
2205 |
last in this usage message): |
2206 |
|
2207 |
* The -I and -F options may appear multiple times. |
2208 |
|
2209 |
* To follow trunk revisions, use "-F trunk" ("-F TRUNK" also works). |
2210 |
This is okay because no would ever, ever be crazy enough to name a |
2211 |
branch "trunk", right? Right. |
2212 |
|
2213 |
* For the -U option, the UFILE should be formatted like |
2214 |
CVSROOT/users. That is, each line of UFILE looks like this |
2215 |
jrandom:jrandom@red-bean.com |
2216 |
or maybe even like this |
2217 |
jrandom:'Jesse Q. Random <jrandom@red-bean.com>' |
2218 |
Don't forget to quote the portion after the colon if necessary. |
2219 |
|
2220 |
* Many people want to filter by date. To do so, invoke cvs2cl.pl |
2221 |
like this: |
2222 |
cvs2cl.pl -l "-d'DATESPEC'" |
2223 |
where DATESPEC is any date specification valid for "cvs log -d". |
2224 |
(Note that CVS 1.10.7 and below requires there be no space between |
2225 |
-d and its argument). |
2226 |
|
2227 |
Options/Arguments: |
2228 |
|
2229 |
-h, -help, --help, or -? Show this usage and exit |
2230 |
--version Show version and exit |
2231 |
-r, --revisions Show revision numbers in output |
2232 |
-b, --branches Show branch names in revisions when possible |
2233 |
-t, --tags Show tags (symbolic names) in output |
2234 |
-T, --tagdates Show tags in output on their first occurance |
2235 |
--show-dead Show dead files |
2236 |
--stdin Read from stdin, don't run cvs log |
2237 |
--stdout Output to stdout not to ChangeLog |
2238 |
-d, --distributed Put ChangeLogs in subdirs |
2239 |
-f FILE, --file FILE Write to FILE instead of "ChangeLog" |
2240 |
--fsf Use this if log data is in FSF ChangeLog style |
2241 |
--FSF Attempt strict FSF-standard compatible output |
2242 |
-W SECS, --window SECS Window of time within which log entries unify |
2243 |
-U UFILE, --usermap UFILE Expand usernames to email addresses from UFILE |
2244 |
--passwd PASSWORDFILE Use system passwd file for user name expansion. |
2245 |
If no mail domain is provided (via --domain), |
2246 |
it tries to read one from /etc/mailname else |
2247 |
output of |
2248 |
hostname -d / dnsdomainname / domainname. Dies |
2249 |
if none successful. Use a domain of '' to |
2250 |
prevent the addition of a mail domain. |
2251 |
--domain DOMAIN Domain to build email addresses from |
2252 |
--gecos Get user information from GECOS data |
2253 |
-R REGEXP, --regexp REGEXP Include only entries that match REGEXP |
2254 |
-I REGEXP, --ignore REGEXP Ignore files whose names match REGEXP |
2255 |
-C, --case-insensitive Any regexp matching is done case-insensitively |
2256 |
-F BRANCH, --follow BRANCH Show only revisions on or ancestral to BRANCH |
2257 |
--no-ancestors When using -F, only track changes since the |
2258 |
BRANCH started |
2259 |
--no-hide-branch-additions By default, entries generated by cvs for a file |
2260 |
added on a branch (a dead 1.1 entry) are not |
2261 |
shown. This flag reverses that action. |
2262 |
-S, --separate-header Blank line between each header and log message |
2263 |
--summary Add CVS change summary information |
2264 |
--no-wrap Don't auto-wrap log message (recommend -S also) |
2265 |
--gmt, --utc Show times in GMT/UTC instead of local time |
2266 |
--accum Add to an existing ChangeLog (incompat w/ --xml) |
2267 |
--update As --accum, but lists only files changed since |
2268 |
last run |
2269 |
-w, --day-of-week Show day of week |
2270 |
--no-times Don't show times in output |
2271 |
--chrono Output log in chronological order |
2272 |
(default is reverse chronological order) |
2273 |
--header FILE Get ChangeLog header from FILE ("-" means stdin) |
2274 |
--xml Output XML instead of ChangeLog format |
2275 |
--xml-encoding ENCODING Insert encoding clause in XML header |
2276 |
--hide-filenames Don't show filenames (ignored for XML output) |
2277 |
--no-common-dir Don't shorten directory names from filenames. |
2278 |
--rcs CVSROOT Handle filenames from raw RCS, for instance |
2279 |
those produced by "cvs rlog" output, stripping |
2280 |
the prefix CVSROOT. |
2281 |
-P, --prune Don't show empty log messages |
2282 |
--ignore-tag TAG Ignore individual changes that are associated |
2283 |
with a given tag. May be repeated, if so, |
2284 |
changes that are associated with any of the |
2285 |
given tags are ignored. |
2286 |
--show-tag TAG Log only individual changes that are associated |
2287 |
with a given tag. May be repeated, if so, |
2288 |
changes that are associated with any of the |
2289 |
given tags are logged. |
2290 |
--delta FROM_TAG:TO_TAG Attempt a delta between two tags (since FROM_TAG |
2291 |
up to & including TO_TAG). The algorithm is a |
2292 |
simple date-based one (this is a *hard* problem) |
2293 |
so results are imperfect |
2294 |
-g OPTS, --global-opts OPTS Invoke like this "cvs OPTS log ..." |
2295 |
-l OPTS, --log-opts OPTS Invoke like this "cvs ... log OPTS" |
2296 |
FILE1 [FILE2 ...] Show only log information for the named FILE(s) |
2297 |
|
2298 |
See http://www.red-bean.com/cvs2cl for maintenance and bug info. |
2299 |
END_OF_INFO |
2300 |
} |
2301 |
|
2302 |
__END__ |
2303 |
|
2304 |
=head1 NAME |
2305 |
|
2306 |
cvs2cl.pl - produces GNU-style ChangeLogs in CVS working copies, by |
2307 |
running "cvs log" and parsing the output. Shared log entries are |
2308 |
unified in an intuitive way. |
2309 |
|
2310 |
=head1 DESCRIPTION |
2311 |
|
2312 |
This script generates GNU-style ChangeLog files from CVS log |
2313 |
information. Basic usage: just run it inside a working copy and a |
2314 |
ChangeLog will appear. It requires repository access (i.e., 'cvs log' |
2315 |
must work). Run "cvs2cl.pl --help" to see more advanced options. |
2316 |
|
2317 |
See http://www.red-bean.com/cvs2cl for updates, and for instructions |
2318 |
on getting anonymous CVS access to this script. |
2319 |
|
2320 |
Maintainer: Karl Fogel <kfogel@red-bean.com> |
2321 |
Please report bugs to <bug-cvs2cl@red-bean.com>. |
2322 |
|
2323 |
=head1 README |
2324 |
|
2325 |
This script generates GNU-style ChangeLog files from CVS log |
2326 |
information. Basic usage: just run it inside a working copy and a |
2327 |
ChangeLog will appear. It requires repository access (i.e., 'cvs log' |
2328 |
must work). Run "cvs2cl.pl --help" to see more advanced options. |
2329 |
|
2330 |
See http://www.red-bean.com/cvs2cl for updates, and for instructions |
2331 |
on getting anonymous CVS access to this script. |
2332 |
|
2333 |
Maintainer: Karl Fogel <kfogel@red-bean.com> |
2334 |
Please report bugs to <bug-cvs2cl@red-bean.com>. |
2335 |
|
2336 |
=head1 PREREQUISITES |
2337 |
|
2338 |
This script requires C<Text::Wrap>, C<Time::Local>, and |
2339 |
C<File::Basename>. |
2340 |
It also seems to require C<Perl 5.004_04> or higher. |
2341 |
|
2342 |
=pod OSNAMES |
2343 |
|
2344 |
any |
2345 |
|
2346 |
=pod SCRIPT CATEGORIES |
2347 |
|
2348 |
Version_Control/CVS |
2349 |
|
2350 |
=cut |
2351 |
|
2352 |
-*- -*- -*- -*- -*- -*- -*- -*- -*- -*- -*- -*- -*- -*- -*- -*- -*- -*- |
2353 |
|
2354 |
Note about a bug-slash-opportunity: |
2355 |
----------------------------------- |
2356 |
|
2357 |
There's a bug in Text::Wrap, which affects cvs2cl. This script |
2358 |
reveals it: |
2359 |
|
2360 |
#!/usr/bin/perl -w |
2361 |
|
2362 |
use Text::Wrap; |
2363 |
|
2364 |
my $test_text = |
2365 |
"This script demonstrates a bug in Text::Wrap. The very long line |
2366 |
following this paragraph will be relocated relative to the surrounding |
2367 |
text: |
2368 |
|
2369 |
==================================================================== |
2370 |
|
2371 |
See? When the bug happens, we'll get the line of equal signs below |
2372 |
this paragraph, even though it should be above."; |
2373 |
|
2374 |
# Print out the test text with no wrapping: |
2375 |
print "$test_text"; |
2376 |
print "\n"; |
2377 |
print "\n"; |
2378 |
|
2379 |
# Now print it out wrapped, and see the bug: |
2380 |
print wrap ("\t", " ", "$test_text"); |
2381 |
print "\n"; |
2382 |
print "\n"; |
2383 |
|
2384 |
If the line of equal signs were one shorter, then the bug doesn't |
2385 |
happen. Interesting. |
2386 |
|
2387 |
Anyway, rather than fix this in Text::Wrap, we might as well write a |
2388 |
new wrap() which has the following much-needed features: |
2389 |
|
2390 |
* initial indentation, like current Text::Wrap() |
2391 |
* subsequent line indentation, like current Text::Wrap() |
2392 |
* user chooses among: force-break long words, leave them alone, or die()? |
2393 |
* preserve existing indentation: chopped chunks from an indented line |
2394 |
are indented by same (like this line, not counting the asterisk!) |
2395 |
* optional list of things to preserve on line starts, default ">" |
2396 |
|
2397 |
Note that the last two are essentially the same concept, so unify in |
2398 |
implementation and give a good interface to controlling them. |
2399 |
|
2400 |
And how about: |
2401 |
|
2402 |
Optionally, when encounter a line pre-indented by same as previous |
2403 |
line, then strip the newline and refill, but indent by the same. |
2404 |
Yeah... |
2405 |
|