HinzugefĆ¼gt:
[ipfire-2.x.git] / tools / cvs2cl.pl
CommitLineData
cd1a2927
MT
1#!/bin/sh\r
2exec perl -w -x $0 ${1+"$@"} # -*- mode: perl; perl-indent-level: 2; -*-\r
3#!perl -w\r
4\r
5\r
6##############################################################\r
7### ###\r
8### cvs2cl.pl: produce ChangeLog(s) from `cvs log` output. ###\r
9### ###\r
10##############################################################\r
11\r
12## $Revision: 1.1.2.1 $\r
13## $Date: 2004/08/12 23:40:08 $\r
14## $Author: gespinasse $\r
15##\r
16\r
17use strict;\r
18\r
19use File::Basename qw( fileparse );\r
20use Getopt::Long qw( GetOptions );\r
21use Text::Wrap qw( );\r
22use User::pwent qw( getpwnam );\r
23\r
24# The Plan:\r
25#\r
26# Read in the logs for multiple files, spit out a nice ChangeLog that\r
27# mirrors the information entered during `cvs commit'.\r
28#\r
29# The problem presents some challenges. In an ideal world, we could\r
30# detect files with the same author, log message, and checkin time --\r
31# each <filelist, author, time, logmessage> would be a changelog entry.\r
32# We'd sort them; and spit them out. Unfortunately, CVS is *not atomic*\r
33# so checkins can span a range of times. Also, the directory structure\r
34# could be hierarchical.\r
35#\r
36# Another question is whether we really want to have the ChangeLog\r
37# exactly reflect commits. An author could issue two related commits,\r
38# with different log entries, reflecting a single logical change to the\r
39# source. GNU style ChangeLogs group these under a single author/date.\r
40# We try to do the same.\r
41#\r
42# So, we parse the output of `cvs log', storing log messages in a\r
43# multilevel hash that stores the mapping:\r
44# directory => author => time => message => filelist\r
45# As we go, we notice "nearby" commit times and store them together\r
46# (i.e., under the same timestamp), so they appear in the same log\r
47# entry.\r
48#\r
49# When we've read all the logs, we twist this mapping into\r
50# a time => author => message => filelist mapping for each directory.\r
51#\r
52# If we're not using the `--distributed' flag, the directory is always\r
53# considered to be `./', even as descend into subdirectories.\r
54\r
55# Call Tree\r
56\r
57# name number of lines (10.xii.03)\r
58# parse_options 192\r
59# derive_changelog 13\r
60# +-maybe_grab_accumulation_date 38\r
61# +-read_changelog 277\r
62# +-maybe_read_user_map_file 94\r
63# +-run_ext 9\r
64# +-read_file_path 29\r
65# +-read_symbolic_name 43\r
66# +-read_revision 49\r
67# +-read_date_author_and_state 25\r
68# +-parse_date_author_and_state 20\r
69# +-read_branches 36\r
70# +-output_changelog 424\r
71# +-pretty_file_list 290\r
72# +-common_path_prefix 35\r
73# +-preprocess_msg_text 30\r
74# +-min 1\r
75# +-mywrap 16\r
76# +-last_line_len 5\r
77# +-wrap_log_entry 177\r
78#\r
79# Utilities\r
80#\r
81# xml_escape 6\r
82# slurp_file 11\r
83# debug 5\r
84# version 2\r
85# usage 142\r
86\r
87# -*- -*- -*- -*- -*- -*- -*- -*- -*- -*- -*- -*- -*- -*- -*- -*- -*- -*-\r
88#\r
89# Note about a bug-slash-opportunity:\r
90# -----------------------------------\r
91#\r
92# There's a bug in Text::Wrap, which affects cvs2cl. This script\r
93# reveals it:\r
94#\r
95# #!/usr/bin/perl -w\r
96#\r
97# use Text::Wrap;\r
98#\r
99# my $test_text =\r
100# "This script demonstrates a bug in Text::Wrap. The very long line\r
101# following this paragraph will be relocated relative to the surrounding\r
102# text:\r
103#\r
104# ====================================================================\r
105#\r
106# See? When the bug happens, we'll get the line of equal signs below\r
107# this paragraph, even though it should be above.";\r
108#\r
109#\r
110# # Print out the test text with no wrapping:\r
111# print "$test_text";\r
112# print "\n";\r
113# print "\n";\r
114#\r
115# # Now print it out wrapped, and see the bug:\r
116# print wrap ("\t", " ", "$test_text");\r
117# print "\n";\r
118# print "\n";\r
119#\r
120# If the line of equal signs were one shorter, then the bug doesn't\r
121# happen. Interesting.\r
122#\r
123# Anyway, rather than fix this in Text::Wrap, we might as well write a\r
124# new wrap() which has the following much-needed features:\r
125#\r
126# * initial indentation, like current Text::Wrap()\r
127# * subsequent line indentation, like current Text::Wrap()\r
128# * user chooses among: force-break long words, leave them alone, or die()?\r
129# * preserve existing indentation: chopped chunks from an indented line\r
130# are indented by same (like this line, not counting the asterisk!)\r
131# * optional list of things to preserve on line starts, default ">"\r
132#\r
133# Note that the last two are essentially the same concept, so unify in\r
134# implementation and give a good interface to controlling them.\r
135#\r
136# And how about:\r
137#\r
138# Optionally, when encounter a line pre-indented by same as previous\r
139# line, then strip the newline and refill, but indent by the same.\r
140# Yeah...\r
141\r
142# Globals --------------------------------------------------------------------\r
143\r
144# In case we have to print it out:\r
145my $VERSION = '$Revision: 1.1.2.1 $';\r
146$VERSION =~ s/\S+\s+(\S+)\s+\S+/$1/;\r
147\r
148## Vars set by options:\r
149\r
150# Print debugging messages?\r
151my $Debug = 0;\r
152\r
153# Just show version and exit?\r
154my $Print_Version = 0;\r
155\r
156# Just print usage message and exit?\r
157my $Print_Usage = 0;\r
158\r
159# What file should we generate (defaults to "ChangeLog")?\r
160my $Log_File_Name = "ChangeLog";\r
161\r
162# Grab most recent entry date from existing ChangeLog file, just add\r
163# to that ChangeLog.\r
164my $Cumulative = 0;\r
165\r
166# `cvs log -d`, this will repeat the last entry in the old log. This is OK,\r
167# as it guarantees at least one entry in the update changelog, which means\r
168# that there will always be a date to extract for the next update. The repeat\r
169# entry can be removed in postprocessing, if necessary.\r
170\r
171# MJP 2003-08-02\r
172# I don't think this actually does anything useful\r
173my $Update = 0;\r
174\r
175# Expand usernames to email addresses based on a map file?\r
176my $User_Map_File = '';\r
177my $User_Passwd_File;\r
178my $Mail_Domain;\r
179\r
180# Output log in chronological order? [default is reverse chronological order]\r
181my $Chronological_Order = 0;\r
182\r
183# Grab user details via gecos\r
184my $Gecos = 0;\r
185\r
186# User domain for gecos email addresses\r
187my $Domain;\r
188\r
189# Output to a file or to stdout?\r
190my $Output_To_Stdout = 0;\r
191\r
192# Eliminate empty log messages?\r
193my $Prune_Empty_Msgs = 0;\r
194\r
195# Tags of which not to output\r
196my %ignore_tags;\r
197\r
198# Show only revisions with Tags\r
199my %show_tags;\r
200\r
201# Don't call Text::Wrap on the body of the message\r
202my $No_Wrap = 0;\r
203\r
204# Indentation of log messages\r
205my $Indent = "\t";\r
206\r
207# Don't do any pretty print processing\r
208my $Summary = 0;\r
209\r
210# Separates header from log message. Code assumes it is either " " or\r
211# "\n\n", so if there's ever an option to set it to something else,\r
212# make sure to go through all conditionals that use this var.\r
213my $After_Header = " ";\r
214\r
215# XML Encoding\r
216my $XML_Encoding = '';\r
217\r
218# Format more for programs than for humans.\r
219my $XML_Output = 0;\r
220my $No_XML_Namespace = 0;\r
221my $No_XML_ISO_Date = 0;\r
222\r
223# Do some special tweaks for log data that was written in FSF\r
224# ChangeLog style.\r
225my $FSF_Style = 0;\r
226\r
227# Show times in UTC instead of local time\r
228my $UTC_Times = 0;\r
229\r
230# Show times in output?\r
231my $Show_Times = 1;\r
232\r
233# Show day of week in output?\r
234my $Show_Day_Of_Week = 0;\r
235\r
236# Show revision numbers in output?\r
237my $Show_Revisions = 0;\r
238\r
239# Show dead files in output?\r
240my $Show_Dead = 0;\r
241\r
242# Hide dead trunk files which were created as a result of additions on a\r
243# branch?\r
244my $Hide_Branch_Additions = 1;\r
245\r
246# Show tags (symbolic names) in output?\r
247my $Show_Tags = 0;\r
248\r
249# Show tags separately in output?\r
250my $Show_Tag_Dates = 0;\r
251\r
252# Show branches by symbolic name in output?\r
253my $Show_Branches = 0;\r
254\r
255# Show only revisions on these branches or their ancestors.\r
256my @Follow_Branches;\r
257# Show only revisions on these branches or their ancestors; ignore descendent\r
258# branches.\r
259my @Follow_Only;\r
260\r
261# Don't bother with files matching this regexp.\r
262my @Ignore_Files;\r
263\r
264# How exactly we match entries. We definitely want "o",\r
265# and user might add "i" by using --case-insensitive option.\r
266my $Case_Insensitive = 0;\r
267\r
268# Maybe only show log messages matching a certain regular expression.\r
269my $Regexp_Gate = '';\r
270\r
271# Pass this global option string along to cvs, to the left of `log':\r
272my $Global_Opts = '';\r
273\r
274# Pass this option string along to the cvs log subcommand:\r
275my $Command_Opts = '';\r
276\r
277# Read log output from stdin instead of invoking cvs log?\r
278my $Input_From_Stdin = 0;\r
279\r
280# Don't show filenames in output.\r
281my $Hide_Filenames = 0;\r
282\r
283# Don't shorten directory names from filenames.\r
284my $Common_Dir = 1;\r
285\r
286# Max checkin duration. CVS checkin is not atomic, so we may have checkin\r
287# times that span a range of time. We assume that checkins will last no\r
288# longer than $Max_Checkin_Duration seconds, and that similarly, no\r
289# checkins will happen from the same users with the same message less\r
290# than $Max_Checkin_Duration seconds apart.\r
291my $Max_Checkin_Duration = 180;\r
292\r
293# What to put at the front of [each] ChangeLog.\r
294my $ChangeLog_Header = '';\r
295\r
296# Whether to enable 'delta' mode, and for what start/end tags.\r
297my $Delta_Mode = 0;\r
298my $Delta_From = '';\r
299my $Delta_To = '';\r
300\r
301my $TestCode;\r
302\r
303# Whether to parse filenames from the RCS filename, and if so what\r
304# prefix to strip.\r
305my $RCS_Root;\r
306\r
307# Whether to output information on the # of lines added and removed\r
308# by each file modification.\r
309my $Show_Lines_Modified = 0;\r
310\r
311## end vars set by options.\r
312\r
313# latest observed times for the start/end tags in delta mode\r
314my $Delta_StartTime = 0;\r
315my $Delta_EndTime = 0;\r
316\r
317my $No_Ancestors = 0;\r
318\r
319my $No_Extra_Indent = 0;\r
320\r
321my $GroupWithinDate = 0;\r
322\r
323# ----------------------------------------------------------------------------\r
324\r
325package CVS::Utils::ChangeLog::EntrySet;\r
326\r
327sub new {\r
328 my $class = shift;\r
329 my %self;\r
330 bless \%self, $class;\r
331}\r
332\r
333# -------------------------------------\r
334\r
335sub output_changelog {\r
336 my $output_type = $XML_Output ? 'XML' : 'Text';\r
337 my $output_class = "CVS::Utils::ChangeLog::EntrySet::Output::${output_type}";\r
338 my $output = $output_class->new(follow_branches => \@Follow_Branches,\r
339 follow_only => \@Follow_Only,\r
340 ignore_tags => \%ignore_tags,\r
341 show_tags => \%show_tags,\r
342 );\r
343 $output->output_changelog(@_);\r
344}\r
345\r
346# -------------------------------------\r
347\r
348sub add_fileentry {\r
349 my ($self, $file_full_path, $time, $revision, $state, $lines,\r
350 $branch_names, $branch_roots, $branch_numbers,\r
351 $symbolic_names, $author, $msg_txt) = @_;\r
352\r
353 my $qunk =\r
354 CVS::Utils::ChangeLog::FileEntry->new($file_full_path, $time, $revision,\r
355 $state, $lines,\r
356 $branch_names, $branch_roots,\r
357 $branch_numbers,\r
358 $symbolic_names);\r
359\r
360 # We might be including revision numbers and/or tags and/or\r
361 # branch names in the output. Most of the code from here to\r
362 # loop-end deals with organizing these in qunk.\r
363\r
364 unless ( $Hide_Branch_Additions\r
365 and\r
366 $msg_txt =~ /file .+ was initially added on branch \S+./ ) {\r
367 # Add this file to the list\r
368 # (We use many spoonfuls of autovivication magic. Hashes and arrays\r
369 # will spring into existence if they aren't there already.)\r
370\r
371 &main::debug ("(pushing log msg for ". $qunk->dir_key . $qunk->filename . ")\n");\r
372\r
373 # Store with the files in this commit. Later we'll loop through\r
374 # again, making sure that revisions with the same log message\r
375 # and nearby commit times are grouped together as one commit.\r
376 $self->{$qunk->dir_key}{$author}{$time}{$msg_txt} =\r
377 CVS::Utils::ChangeLog::Message->new($msg_txt)\r
378 unless exists $self->{$qunk->dir_key}{$author}{$time}{$msg_txt};\r
379 $self->{$qunk->dir_key}{$author}{$time}{$msg_txt}->add_fileentry($qunk);\r
380 }\r
381\r
382}\r
383\r
384# ----------------------------------------------------------------------------\r
385\r
386package CVS::Utils::ChangeLog::EntrySet::Output::Text;\r
387\r
388use base qw( CVS::Utils::ChangeLog::EntrySet::Output );\r
389\r
390use File::Basename qw( fileparse );\r
391\r
392sub new {\r
393 my $class = shift;\r
394 my $self = $class->SUPER::new(@_);\r
395}\r
396\r
397# -------------------------------------\r
398\r
399sub wday {\r
400 my $self = shift; my $class = ref $self;\r
401 my ($wday) = @_;\r
402\r
403 return $Show_Day_Of_Week ? ' ' . $class->weekday_en($wday) : '';\r
404}\r
405\r
406# -------------------------------------\r
407\r
408sub header_line {\r
409 my $self = shift;\r
410 my ($time, $author, $lastdate) = @_;\r
411\r
412 my $header_line = '';\r
413\r
414 my (undef,$min,$hour,$mday,$mon,$year,$wday)\r
415 = $UTC_Times ? gmtime($time) : localtime($time);\r
416\r
417 my $date = $self->fdatetime($time);\r
418\r
419 if ($Show_Times) {\r
420 $header_line =\r
421 sprintf "%s %s\n\n", $date, $author;\r
422 } else {\r
423 if ( ! defined $lastdate or $date ne $lastdate or ! $GroupWithinDate ) {\r
424 if ( $GroupWithinDate ) {\r
425 $header_line = "$date\n\n";\r
426 } else {\r
427 $header_line = "$date $author\n\n";\r
428 }\r
429 } else {\r
430 $header_line = '';\r
431 }\r
432 }\r
433}\r
434\r
435# -------------------------------------\r
436\r
437sub preprocess_msg_text {\r
438 my $self = shift;\r
439 my ($text) = @_;\r
440\r
441 $text = $self->SUPER::preprocess_msg_text($text);\r
442\r
443 unless ( $No_Wrap ) {\r
444 # Strip off lone newlines, but only for lines that don't begin with\r
445 # whitespace or a mail-quoting character, since we want to preserve\r
446 # that kind of formatting. Also don't strip newlines that follow a\r
447 # period; we handle those specially next. And don't strip\r
448 # newlines that precede an open paren.\r
449 1 while $text =~ s/(^|\n)([^>\s].*[^.\n])\n([^>\n])/$1$2 $3/g;\r
450\r
451 # If a newline follows a period, make sure that when we bring up the\r
452 # bottom sentence, it begins with two spaces.\r
453 1 while $text =~ s/(^|\n)([^>\s].*)\n([^>\n])/$1$2 $3/g;\r
454 }\r
455\r
456 return $text;\r
457}\r
458\r
459# -------------------------------------\r
460\r
461# Here we take a bunch of qunks and convert them into printed\r
462# summary that will include all the information the user asked for.\r
463sub pretty_file_list {\r
464 my $self = shift;\r
465\r
466 return ''\r
467 if $Hide_Filenames;\r
468\r
469 my $qunksref = shift;\r
470\r
471 my @filenames;\r
472 my $beauty = ''; # The accumulating header string for this entry.\r
473 my %non_unanimous_tags; # Tags found in a proper subset of qunks\r
474 my %unanimous_tags; # Tags found in all qunks\r
475 my %all_branches; # Branches found in any qunk\r
476 my $fbegun = 0; # Did we begin printing filenames yet?\r
477\r
478 my ($common_dir, $qunkrefs) =\r
479 $self->_pretty_file_list(\(%unanimous_tags, %non_unanimous_tags, %all_branches), $qunksref);\r
480\r
481 my @qunkrefs = @$qunkrefs;\r
482\r
483 # Not XML output, so complexly compactify for chordate consumption. At this\r
484 # point we have enough global information about all the qunks to organize\r
485 # them non-redundantly for output.\r
486\r
487 if ($common_dir) {\r
488 # Note that $common_dir still has its trailing slash\r
489 $beauty .= "$common_dir: ";\r
490 }\r
491\r
492 if ($Show_Branches)\r
493 {\r
494 # For trailing revision numbers.\r
495 my @brevisions;\r
496\r
497 foreach my $branch (keys (%all_branches))\r
498 {\r
499 foreach my $qunkref (@qunkrefs)\r
500 {\r
501 if ((defined ($qunkref->branch))\r
502 and ($qunkref->branch eq $branch))\r
503 {\r
504 if ($fbegun) {\r
505 # kff todo: comma-delimited in XML too? Sure.\r
506 $beauty .= ", ";\r
507 }\r
508 else {\r
509 $fbegun = 1;\r
510 }\r
511 my $fname = substr ($qunkref->filename, length ($common_dir));\r
512 $beauty .= $fname;\r
513 $qunkref->{'printed'} = 1; # Just setting a mark bit, basically\r
514\r
515 if ( $Show_Tags and defined $qunkref->tags ) {\r
516 my @tags = grep ($non_unanimous_tags{$_}, @{$qunkref->tags});\r
517\r
518 if (@tags) {\r
519 $beauty .= " (tags: ";\r
520 $beauty .= join (', ', @tags);\r
521 $beauty .= ")";\r
522 }\r
523 }\r
524\r
525 if ($Show_Revisions) {\r
526 # Collect the revision numbers' last components, but don't\r
527 # print them -- they'll get printed with the branch name\r
528 # later.\r
529 $qunkref->revision =~ /.+\.([\d]+)$/;\r
530 push (@brevisions, $1);\r
531\r
532 # todo: we're still collecting branch roots, but we're not\r
533 # showing them anywhere. If we do show them, it would be\r
534 # nifty to just call them revision "0" on a the branch.\r
535 # Yeah, that's the ticket.\r
536 }\r
537 }\r
538 }\r
539 $beauty .= " ($branch";\r
540 if (@brevisions) {\r
541 if ((scalar (@brevisions)) > 1) {\r
542 $beauty .= ".[";\r
543 $beauty .= (join (',', @brevisions));\r
544 $beauty .= "]";\r
545 }\r
546 else {\r
547 # Square brackets are spurious here, since there's no range to\r
548 # encapsulate\r
549 $beauty .= ".$brevisions[0]";\r
550 }\r
551 }\r
552 $beauty .= ")";\r
553 }\r
554 }\r
555\r
556 # Okay; any qunks that were done according to branch are taken care\r
557 # of, and marked as printed. Now print everyone else.\r
558\r
559 my %fileinfo_printed;\r
560 foreach my $qunkref (@qunkrefs)\r
561 {\r
562 next if (defined ($qunkref->{'printed'})); # skip if already printed\r
563\r
564 my $b = substr ($qunkref->filename, length ($common_dir));\r
565 # todo: Shlomo's change was this:\r
566 # $beauty .= substr ($qunkref->filename,\r
567 # (($common_dir eq "./") ? '' : length ($common_dir)));\r
568 $qunkref->{'printed'} = 1; # Set a mark bit.\r
569\r
570 if ($Show_Revisions || $Show_Tags || $Show_Dead)\r
571 {\r
572 my $started_addendum = 0;\r
573\r
574 if ($Show_Revisions) {\r
575 $started_addendum = 1;\r
576 $b .= " (";\r
577 $b .= $qunkref->revision;\r
578 }\r
579 if ($Show_Dead && $qunkref->state =~ /dead/)\r
580 {\r
581 # Deliberately not using $started_addendum. Keeping it simple.\r
582 $b .= "[DEAD]";\r
583 }\r
584 if ($Show_Tags && (defined $qunkref->tags)) {\r
585 my @tags = grep ($non_unanimous_tags{$_}, @{$qunkref->tags});\r
586 if ((scalar (@tags)) > 0) {\r
587 if ($started_addendum) {\r
588 $b .= ", ";\r
589 }\r
590 else {\r
591 $b .= " (tags: ";\r
592 }\r
593 $b .= join (', ', @tags);\r
594 $started_addendum = 1;\r
595 }\r
596 }\r
597 if ($started_addendum) {\r
598 $b .= ")";\r
599 }\r
600 }\r
601\r
602 unless ( exists $fileinfo_printed{$b} ) {\r
603 if ($fbegun) {\r
604 $beauty .= ", ";\r
605 } else {\r
606 $fbegun = 1;\r
607 }\r
608 $beauty .= $b, $fileinfo_printed{$b} = 1;\r
609 }\r
610 }\r
611\r
612 # Unanimous tags always come last.\r
613 if ($Show_Tags && %unanimous_tags)\r
614 {\r
615 $beauty .= " (utags: ";\r
616 $beauty .= join (', ', sort keys (%unanimous_tags));\r
617 $beauty .= ")";\r
618 }\r
619\r
620 # todo: still have to take care of branch_roots?\r
621\r
622 $beauty = "$beauty:";\r
623\r
624 return $beauty;\r
625}\r
626\r
627# -------------------------------------\r
628\r
629sub output_tagdate {\r
630 my $self = shift;\r
631 my ($fh, $time, $tag) = @_;\r
632\r
633 my $fdatetime = $self->fdatetime($time);\r
634 print $fh "$fdatetime tag $tag\n\n";\r
635 return;\r
636}\r
637\r
638# -------------------------------------\r
639\r
640sub format_body {\r
641 my $self = shift;\r
642 my ($msg, $files, $qunklist) = @_;\r
643\r
644 my $body;\r
645\r
646 if ( $No_Wrap and ! $Summary ) {\r
647 $msg = $self->preprocess_msg_text($msg);\r
648 $files = $self->mywrap("\t", "\t ", "* $files");\r
649 $msg =~ s/\n(.+)/\n$Indent$1/g;\r
650 unless ($After_Header eq " ") {\r
651 $msg =~ s/^(.+)/$Indent$1/g;\r
652 }\r
653 if ( $Hide_Filenames ) {\r
654 $body = $After_Header . $msg;\r
655 } else {\r
656 $body = $files . $After_Header . $msg;\r
657 }\r
658 } elsif ( $Summary ) {\r
659 my ($filelist, $qunk);\r
660 my (@DeletedQunks, @AddedQunks, @ChangedQunks);\r
661\r
662 $msg = $self->preprocess_msg_text($msg);\r
663 #\r
664 # Sort the files (qunks) according to the operation that was\r
665 # performed. Files which were added have no line change\r
666 # indicator, whereas deleted files have state dead.\r
667 #\r
668 foreach $qunk ( @$qunklist ) {\r
669 if ( "dead" eq $qunk->state) {\r
670 push @DeletedQunks, $qunk;\r
671 } elsif ( ! defined $qunk->lines ) {\r
672 push @AddedQunks, $qunk;\r
673 } else {\r
674 push @ChangedQunks, $qunk;\r
675 }\r
676 }\r
677 #\r
678 # The qunks list was originally in tree search order. Let's\r
679 # get that back. The lists, if they exist, will be reversed upon\r
680 # processing.\r
681 #\r
682\r
683 #\r
684 # Now write the three sections onto $filelist\r
685 #\r
686 if ( @DeletedQunks ) {\r
687 $filelist .= "\tDeleted:\n";\r
688 foreach $qunk ( @DeletedQunks ) {\r
689 $filelist .= "\t\t" . $qunk->filename;\r
690 $filelist .= " (" . $qunk->revision . ")";\r
691 $filelist .= "\n";\r
692 }\r
693 undef @DeletedQunks;\r
694 }\r
695\r
696 if ( @AddedQunks ) {\r
697 $filelist .= "\tAdded:\n";\r
698 foreach $qunk (@AddedQunks) {\r
699 $filelist .= "\t\t" . $qunk->filename;\r
700 $filelist .= " (" . $qunk->revision . ")";\r
701 $filelist .= "\n";\r
702 }\r
703 undef @AddedQunks ;\r
704 }\r
705\r
706 if ( @ChangedQunks ) {\r
707 $filelist .= "\tChanged:\n";\r
708 foreach $qunk (@ChangedQunks) {\r
709 $filelist .= "\t\t" . $qunk->filename;\r
710 $filelist .= " (" . $qunk->revision . ")";\r
711 $filelist .= ", \"" . $qunk->state . "\"";\r
712 $filelist .= ", lines: " . $qunk->lines;\r
713 $filelist .= "\n";\r
714 }\r
715 undef @ChangedQunks;\r
716 }\r
717\r
718 chomp $filelist;\r
719\r
720 if ( $Hide_Filenames ) {\r
721 $filelist = '';\r
722 }\r
723\r
724 $msg =~ s/\n(.*)/\n$Indent$1/g;\r
725 unless ( $After_Header eq " " or $FSF_Style ) {\r
726 $msg =~ s/^(.*)/$Indent$1/g;\r
727 }\r
728\r
729 unless ( $No_Wrap ) {\r
730 if ( $FSF_Style ) {\r
731 $msg = $self->wrap_log_entry($msg, '', 69, 69);\r
732 chomp($msg);\r
733 chomp($msg);\r
734 } else {\r
735 $msg = $self->mywrap('', $Indent, "$msg");\r
736 $msg =~ s/[ \t]+\n/\n/g;\r
737 }\r
738 }\r
739\r
740 $body = $filelist . $After_Header . $msg;\r
741 } else { # do wrapping, either FSF-style or regular\r
742 my $latter_wrap = $No_Extra_Indent ? $Indent : "$Indent ";\r
743\r
744 if ( $FSF_Style ) {\r
745 $files = $self->mywrap($Indent, $latter_wrap, "* $files");\r
746\r
747 my $files_last_line_len = 0;\r
748 if ( $After_Header eq " " ) {\r
749 $files_last_line_len = $self->last_line_len($files);\r
750 $files_last_line_len += 1; # for $After_Header\r
751 }\r
752\r
753 $msg = $self->wrap_log_entry($msg, $latter_wrap, 69-$files_last_line_len, 69);\r
754 $body = $files . $After_Header . $msg;\r
755 } else { # not FSF-style\r
756 $msg = $self->preprocess_msg_text($msg);\r
757 $body = $files . $After_Header . $msg;\r
758 $body = $self->mywrap($Indent, $latter_wrap, "* $body");\r
759 $body =~ s/[ \t]+\n/\n/g;\r
760 }\r
761 }\r
762\r
763 return $body;\r
764}\r
765\r
766# ----------------------------------------------------------------------------\r
767\r
768package CVS::Utils::ChangeLog::EntrySet::Output::XML;\r
769\r
770use base qw( CVS::Utils::ChangeLog::EntrySet::Output );\r
771\r
772use File::Basename qw( fileparse );\r
773\r
774sub new {\r
775 my $class = shift;\r
776 my $self = $class->SUPER::new(@_);\r
777}\r
778\r
779# -------------------------------------\r
780\r
781sub header_line {\r
782 my $self = shift;\r
783 my ($time, $author, $lastdate) = @_;\r
784\r
785 my $header_line = '';\r
786\r
787 my $isoDate;\r
788\r
789 my ($y, $m, $d, $H, $M, $S) = (gmtime($time))[5,4,3,2,1,0];\r
790\r
791 # Ideally, this would honor $UTC_Times and use +HH:MM syntax\r
792 $isoDate = sprintf("%04d-%02d-%02dT%02d:%02d:%02dZ",\r
793 $y + 1900, $m + 1, $d, $H, $M, $S);\r
794\r
795 my (undef,$min,$hour,$mday,$mon,$year,$wday)\r
796 = $UTC_Times ? gmtime($time) : localtime($time);\r
797\r
798 my $date = $self->fdatetime($time);\r
799 $wday = $self->wday($wday);\r
800\r
801 $header_line =\r
802 sprintf ("<date>%4u-%02u-%02u</date>\n${wday}<time>%02u:%02u</time>\n",\r
803 $year+1900, $mon+1, $mday, $hour, $min);\r
804 $header_line .= "<isoDate>$isoDate</isoDate>\n"\r
805 unless $No_XML_ISO_Date;\r
806 $header_line .= sprintf("<author>%s</author>\n" , $author);\r
807}\r
808\r
809# -------------------------------------\r
810\r
811sub wday {\r
812 my $self = shift; my $class = ref $self;\r
813 my ($wday) = @_;\r
814\r
815 return '<weekday>' . $class->weekday_en($wday) . "</weekday>\n";\r
816}\r
817\r
818# -------------------------------------\r
819\r
820sub escape {\r
821 my $self = shift;\r
822\r
823 my $txt = shift;\r
824 $txt =~ s/&/&amp;/g;\r
825 $txt =~ s/</&lt;/g;\r
826 $txt =~ s/>/&gt;/g;\r
827 return $txt;\r
828}\r
829\r
830# -------------------------------------\r
831\r
832sub output_header {\r
833 my $self = shift;\r
834 my ($fh) = @_;\r
835\r
836 my $encoding =\r
837 length $XML_Encoding ? qq'encoding="$XML_Encoding"' : '';\r
838 my $version = 'version="1.0"';\r
839 my $declaration =\r
840 sprintf '<?xml %s?>', join ' ', grep length, $version, $encoding;\r
841 my $root =\r
842 $No_XML_Namespace ?\r
843 '<changelog>' :\r
844 '<changelog xmlns="http://www.red-bean.com/xmlns/cvs2cl/">';\r
845 print $fh "$declaration\n\n$root\n\n";\r
846}\r
847\r
848# -------------------------------------\r
849\r
850sub output_footer {\r
851 my $self = shift;\r
852 my ($fh) = @_;\r
853\r
854 print $fh "</changelog>\n";\r
855}\r
856\r
857# -------------------------------------\r
858\r
859sub preprocess_msg_text {\r
860 my $self = shift;\r
861 my ($text) = @_;\r
862\r
863 $text = $self->SUPER::preprocess_msg_text($text);\r
864\r
865 $text = $self->escape($text);\r
866 chomp $text;\r
867 $text = "<msg>${text}</msg>\n";\r
868\r
869 return $text;\r
870}\r
871\r
872# -------------------------------------\r
873\r
874# Here we take a bunch of qunks and convert them into a printed\r
875# summary that will include all the information the user asked for.\r
876sub pretty_file_list {\r
877 my $self = shift;\r
878 my ($qunksref) = @_;\r
879\r
880 my $beauty = ''; # The accumulating header string for this entry.\r
881 my %non_unanimous_tags; # Tags found in a proper subset of qunks\r
882 my %unanimous_tags; # Tags found in all qunks\r
883 my %all_branches; # Branches found in any qunk\r
884 my $fbegun = 0; # Did we begin printing filenames yet?\r
885\r
886 my ($common_dir, $qunkrefs) =\r
887 $self->_pretty_file_list(\(%unanimous_tags, %non_unanimous_tags, %all_branches),\r
888 $qunksref);\r
889\r
890 my @qunkrefs = @$qunkrefs;\r
891\r
892 # If outputting XML, then our task is pretty simple, because we\r
893 # don't have to detect common dir, common tags, branch prefixing,\r
894 # etc. We just output exactly what we have, and don't worry about\r
895 # redundancy or readability.\r
896\r
897 foreach my $qunkref (@qunkrefs)\r
898 {\r
899 my $filename = $qunkref->filename;\r
900 my $state = $qunkref->state;\r
901 my $revision = $qunkref->revision;\r
902 my $tags = $qunkref->tags;\r
903 my $branch = $qunkref->branch;\r
904 my $branchroots = $qunkref->roots;\r
905 my $lines = $qunkref->lines;\r
906\r
907 $filename = $self->escape($filename); # probably paranoia\r
908 $revision = $self->escape($revision); # definitely paranoia\r
909\r
910 $beauty .= "<file>\n";\r
911 $beauty .= "<name>${filename}</name>\n";\r
912 $beauty .= "<cvsstate>${state}</cvsstate>\n";\r
913 $beauty .= "<revision>${revision}</revision>\n";\r
914\r
915 if ($Show_Lines_Modified\r
916 && $lines && $lines =~ m/\+(\d+)\s+-(\d+)/) {\r
917 $beauty .= "<linesadded>$1</linesadded>\n";\r
918 $beauty .= "<linesremoved>$2</linesremoved>\n";\r
919 }\r
920\r
921 if ($branch) {\r
922 $branch = $self->escape($branch); # more paranoia\r
923 $beauty .= "<branch>${branch}</branch>\n";\r
924 }\r
925 foreach my $tag (@$tags) {\r
926 $tag = $self->escape($tag); # by now you're used to the paranoia\r
927 $beauty .= "<tag>${tag}</tag>\n";\r
928 }\r
929 foreach my $root (@$branchroots) {\r
930 $root = $self->escape($root); # which is good, because it will continue\r
931 $beauty .= "<branchroot>${root}</branchroot>\n";\r
932 }\r
933 $beauty .= "</file>\n";\r
934 }\r
935\r
936 # Theoretically, we could go home now. But as long as we're here,\r
937 # let's print out the common_dir and utags, as a convenience to\r
938 # the receiver (after all, earlier code calculated that stuff\r
939 # anyway, so we might as well take advantage of it).\r
940\r
941 if ((scalar (keys (%unanimous_tags))) > 1) {\r
942 foreach my $utag ((keys (%unanimous_tags))) {\r
943 $utag = $self->escape($utag); # the usual paranoia\r
944 $beauty .= "<utag>${utag}</utag>\n";\r
945 }\r
946 }\r
947 if ($common_dir) {\r
948 $common_dir = $self->escape($common_dir);\r
949 $beauty .= "<commondir>${common_dir}</commondir>\n";\r
950 }\r
951\r
952 # That's enough for XML, time to go home:\r
953 return $beauty;\r
954}\r
955\r
956# -------------------------------------\r
957\r
958sub output_tagdate {\r
959 # NOT YET DONE\r
960}\r
961\r
962# -------------------------------------\r
963\r
964sub output_entry {\r
965 my $self = shift;\r
966 my ($fh, $entry) = @_;\r
967 print $fh "<entry>\n$entry</entry>\n\n";\r
968}\r
969\r
970# -------------------------------------\r
971\r
972sub format_body {\r
973 my $self = shift;\r
974 my ($msg, $files, $qunklist) = @_;\r
975\r
976 $msg = $self->preprocess_msg_text($msg);\r
977 return $files . $msg;\r
978}\r
979\r
980# ----------------------------------------------------------------------------\r
981\r
982package CVS::Utils::ChangeLog::EntrySet::Output;\r
983\r
984use Carp qw( croak );\r
985use File::Basename qw( fileparse );\r
986\r
987# Class Utility Functions -------------\r
988\r
989{ # form closure\r
990\r
991my @weekdays = (qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday));\r
992sub weekday_en {\r
993 my $class = shift;\r
994 return $weekdays[$_[0]];\r
995}\r
996\r
997}\r
998\r
999# -------------------------------------\r
1000\r
1001sub new {\r
1002 my ($proto, %args) = @_;\r
1003 my $class = ref $proto || $proto;\r
1004\r
1005 my $follow_branches = delete $args{follow_branches};\r
1006 my $follow_only = delete $args{follow_only};\r
1007 my $ignore_tags = delete $args{ignore_tags};\r
1008 my $show_tags = delete $args{show_tags};\r
1009 die "Unrecognized arg to EntrySet::Output::new: '$_'\n"\r
1010 for keys %args;\r
1011\r
1012 bless +{follow_branches => $follow_branches,\r
1013 follow_only => $follow_only,\r
1014 show_tags => $show_tags,\r
1015 ignore_tags => $ignore_tags,\r
1016 }, $class;\r
1017}\r
1018\r
1019# Abstract Subrs ----------------------\r
1020\r
1021sub wday { croak "Whoops. Abtract method call (wday).\n" }\r
1022sub pretty_file_list { croak "Whoops. Abtract method call (pretty_file_list).\n" }\r
1023sub output_tagdate { croak "Whoops. Abtract method call (output_tagdate).\n" }\r
1024sub header_line { croak "Whoops. Abtract method call (header_line).\n" }\r
1025\r
1026# Instance Subrs ----------------------\r
1027\r
1028sub output_header { }\r
1029\r
1030# -------------------------------------\r
1031\r
1032sub output_entry {\r
1033 my $self = shift;\r
1034 my ($fh, $entry) = @_;\r
1035 print $fh "$entry\n";\r
1036}\r
1037\r
1038# -------------------------------------\r
1039\r
1040sub output_footer { }\r
1041\r
1042# -------------------------------------\r
1043\r
1044sub escape { return $_[1] }\r
1045\r
1046# -------------------------------------\r
1047\r
1048sub _revision_is_wanted {\r
1049 my ($self, $qunk) = @_;\r
1050\r
1051 my ($revision, $branch_numbers) = @{$qunk}{qw( revision branch_numbers )};\r
1052 my $follow_branches = $self->{follow_branches};\r
1053 my $follow_only = $self->{follow_only};\r
1054\r
1055#print STDERR "IG: ", join(',', keys %{$self->{ignore_tags}}), "\n";\r
1056#print STDERR "IX: ", join(',', @{$qunk->{tags}}), "\n" if defined $qunk->{tags};\r
1057#print STDERR "IQ: ", join(',', keys %{$qunk->{branch_numbers}}), "\n" if defined $qunk->{branch_numbers};\r
1058#use Data::Dumper; print STDERR Dumper $qunk;\r
1059\r
1060 for my $ignore_tag (keys %{$self->{ignore_tags}}) {\r
1061 return\r
1062 if defined $qunk->{tags} and grep $_ eq $ignore_tag, @{$qunk->{tags}};\r
1063 }\r
1064\r
1065 if ( keys %{$self->{show_tags}} ) {\r
1066 for my $show_tag (keys %{$self->{show_tags}}) {\r
1067 return\r
1068 if ! defined $qunk->{tags} or ! grep $_ eq $show_tag, @{$qunk->{tags}};\r
1069 }\r
1070 }\r
1071\r
1072 return 1\r
1073 unless @$follow_branches + @$follow_only; # no follow is follow all\r
1074\r
1075 for my $x (map([$_, 1], @$follow_branches),\r
1076 map([$_, 0], @$follow_only )) {\r
1077 my ($branch, $followsub) = @$x;\r
1078\r
1079 # Special case for following trunk revisions\r
1080 return 1\r
1081 if $branch =~ /^trunk$/i and $revision =~ /^[0-9]+\.[0-9]+$/;\r
1082\r
1083 if ( my $branch_number = $branch_numbers->{$branch} ) {\r
1084 # Are we on one of the follow branches or an ancestor of same?\r
1085\r
1086 # If this revision is a prefix of the branch number, or possibly is less\r
1087 # in the minormost number, OR if this branch number is a prefix of the\r
1088 # revision, then yes. Otherwise, no.\r
1089\r
1090 # So below, we determine if any of those conditions are met.\r
1091\r
1092 # Trivial case: is this revision on the branch? (Compare this way to\r
1093 # avoid regexps that screw up Emacs indentation, argh.)\r
1094 if ( substr($revision, 0, (length($branch_number) + 1))\r
1095 eq\r
1096 ($branch_number . ".") ) {\r
1097 if ( $followsub ) {\r
1098 return 1;\r
1099 } elsif (length($revision) == length($branch_number)+2 ) {\r
1100 return 1;\r
1101 }\r
1102 } elsif ( length($branch_number) > length($revision)\r
1103 and\r
1104 $No_Ancestors ) {\r
1105 # Non-trivial case: check if rev is ancestral to branch\r
1106\r
1107 # r_left still has the trailing "."\r
1108 my ($r_left, $r_end) = ($revision =~ /^((?:\d+\.)+)(\d+)$/);\r
1109\r
1110 # b_left still has trailing "."\r
1111 # b_mid has no trailing "."\r
1112 my ($b_left, $b_mid) = ($branch_number =~ /^((?:\d+\.)+)(\d+)\.\d+$/);\r
1113 return 1\r
1114 if $r_left eq $b_left and $r_end <= $b_mid;\r
1115 }\r
1116 }\r
1117 }\r
1118\r
1119 return;\r
1120}\r
1121\r
1122# -------------------------------------\r
1123\r
1124sub output_changelog {\r
1125my $self = shift; my $class = ref $self;\r
1126 my ($grand_poobah) = @_;\r
1127 ### Process each ChangeLog\r
1128\r
1129 while (my ($dir,$authorhash) = each %$grand_poobah)\r
1130 {\r
1131 &main::debug ("DOING DIR: $dir\n");\r
1132\r
1133 # Here we twist our hash around, from being\r
1134 # author => time => message => filelist\r
1135 # in %$authorhash to\r
1136 # time => author => message => filelist\r
1137 # in %changelog.\r
1138 #\r
1139 # This is also where we merge entries. The algorithm proceeds\r
1140 # through the timeline of the changelog with a sliding window of\r
1141 # $Max_Checkin_Duration seconds; within that window, entries that\r
1142 # have the same log message are merged.\r
1143 #\r
1144 # (To save space, we zap %$authorhash after we've copied\r
1145 # everything out of it.)\r
1146\r
1147 my %changelog;\r
1148 while (my ($author,$timehash) = each %$authorhash)\r
1149 {\r
1150 my %stamptime;\r
1151 foreach my $time (sort {$a <=> $b} (keys %$timehash))\r
1152 {\r
1153 my $msghash = $timehash->{$time};\r
1154 while (my ($msg,$qunklist) = each %$msghash)\r
1155 {\r
1156 my $stamptime = $stamptime{$msg};\r
1157 if ((defined $stamptime)\r
1158 and (($time - $stamptime) < $Max_Checkin_Duration)\r
1159 and (defined $changelog{$stamptime}{$author}{$msg}))\r
1160 {\r
1161 push(@{$changelog{$stamptime}{$author}{$msg}}, $qunklist->files);\r
1162 }\r
1163 else {\r
1164 $changelog{$time}{$author}{$msg} = $qunklist->files;\r
1165 $stamptime{$msg} = $time;\r
1166 }\r
1167 }\r
1168 }\r
1169 }\r
1170 undef (%$authorhash);\r
1171\r
1172 ### Now we can write out the ChangeLog!\r
1173\r
1174 my ($logfile_here, $logfile_bak, $tmpfile);\r
1175 my $lastdate;\r
1176\r
1177 if (! $Output_To_Stdout) {\r
1178 $logfile_here = $dir . $Log_File_Name;\r
1179 $logfile_here =~ s/^\.\/\//\//; # fix any leading ".//" problem\r
1180 $tmpfile = "${logfile_here}.cvs2cl$$.tmp";\r
1181 $logfile_bak = "${logfile_here}.bak";\r
1182\r
1183 open (LOG_OUT, ">$tmpfile") or die "Unable to open \"$tmpfile\"";\r
1184 }\r
1185 else {\r
1186 open (LOG_OUT, ">-") or die "Unable to open stdout for writing";\r
1187 }\r
1188\r
1189 print LOG_OUT $ChangeLog_Header;\r
1190\r
1191 my %tag_date_printed;\r
1192\r
1193 $self->output_header(\*LOG_OUT);\r
1194\r
1195 my @key_list = ();\r
1196 if($Chronological_Order) {\r
1197 @key_list = sort {$a <=> $b} (keys %changelog);\r
1198 } else {\r
1199 @key_list = sort {$b <=> $a} (keys %changelog);\r
1200 }\r
1201 foreach my $time (@key_list)\r
1202 {\r
1203 next if ($Delta_Mode &&\r
1204 (($time <= $Delta_StartTime) ||\r
1205 ($time > $Delta_EndTime && $Delta_EndTime)));\r
1206\r
1207 # Set up the date/author line.\r
1208 # kff todo: do some more XML munging here, on the header\r
1209 # part of the entry:\r
1210 my (undef,$min,$hour,$mday,$mon,$year,$wday)\r
1211 = $UTC_Times ? gmtime($time) : localtime($time);\r
1212\r
1213 $wday = $self->wday($wday);\r
1214 # XML output includes everything else, we might as well make\r
1215 # it always include Day Of Week too, for consistency.\r
1216 my $authorhash = $changelog{$time};\r
1217 if ($Show_Tag_Dates) {\r
1218 my %tags;\r
1219 while (my ($author,$mesghash) = each %$authorhash) {\r
1220 while (my ($msg,$qunk) = each %$mesghash) {\r
1221 foreach my $qunkref2 (@$qunk) {\r
1222 if (defined ($qunkref2->tags)) {\r
1223 foreach my $tag (@{$qunkref2->tags}) {\r
1224 $tags{$tag} = 1;\r
1225 }\r
1226 }\r
1227 }\r
1228 }\r
1229 }\r
1230 # Sort here for determinism to ease testing\r
1231 foreach my $tag (sort keys %tags) {\r
1232 if ( ! defined $tag_date_printed{$tag} ) {\r
1233 $tag_date_printed{$tag} = $time;\r
1234 $self->output_tagdate(\*LOG_OUT, $time, $tag);\r
1235 }\r
1236 }\r
1237 }\r
1238 while (my ($author,$mesghash) = each %$authorhash)\r
1239 {\r
1240 # If XML, escape in outer loop to avoid compound quoting:\r
1241 $author = $self->escape($author);\r
1242\r
1243 FOOBIE:\r
1244 # We sort here to enable predictable ordering for the testing porpoises\r
1245 for my $msg (sort keys %$mesghash)\r
1246 {\r
1247 my $qunklist = $mesghash->{$msg};\r
1248\r
1249 my @qunklist =\r
1250 grep $self->_revision_is_wanted($_), @$qunklist;\r
1251\r
1252 next FOOBIE unless @qunklist;\r
1253\r
1254 my $files = $self->pretty_file_list(\@qunklist);\r
1255 my $header_line; # date and author\r
1256 my $wholething; # $header_line + $body\r
1257\r
1258 my $date = $self->fdatetime($time);\r
1259 $header_line = $self->header_line($time, $author, $lastdate);\r
1260 $lastdate = $date;\r
1261\r
1262 $Text::Wrap::huge = 'overflow'\r
1263 if $Text::Wrap::VERSION >= 2001.0130;\r
1264 # Reshape the body according to user preferences.\r
1265 my $body = $self->format_body($msg, $files, \@qunklist);\r
1266\r
1267 $body =~ s/[ \t]+\n/\n/g;\r
1268 $wholething = $header_line . $body;\r
1269\r
1270 # One last check: make sure it passes the regexp test, if the\r
1271 # user asked for that. We have to do it here, so that the\r
1272 # test can match against information in the header as well\r
1273 # as in the text of the log message.\r
1274\r
1275 # How annoying to duplicate so much code just because I\r
1276 # can't figure out a way to evaluate scalars on the trailing\r
1277 # operator portion of a regular expression. Grrr.\r
1278 if ($Case_Insensitive) {\r
1279 unless ( $Regexp_Gate and ( $wholething !~ /$Regexp_Gate/oi ) ) {\r
1280 $self->output_entry(\*LOG_OUT, $wholething);\r
1281 }\r
1282 }\r
1283 else {\r
1284 unless ( $Regexp_Gate and ( $wholething !~ /$Regexp_Gate/o ) ) {\r
1285 $self->output_entry(\*LOG_OUT, $wholething);\r
1286 }\r
1287 }\r
1288 }\r
1289 }\r
1290 }\r
1291\r
1292 $self->output_footer(\*LOG_OUT);\r
1293\r
1294 close (LOG_OUT);\r
1295\r
1296 if ( ! $Output_To_Stdout ) {\r
1297 # If accumulating, append old data to new before renaming. But\r
1298 # don't append the most recent entry, since it's already in the\r
1299 # new log due to CVS's idiosyncratic interpretation of "log -d".\r
1300 if ($Cumulative && -f $logfile_here) {\r
1301 open NEW_LOG, ">>$tmpfile"\r
1302 or die "trouble appending to $tmpfile ($!)";\r
1303\r
1304 open OLD_LOG, "<$logfile_here"\r
1305 or die "trouble reading from $logfile_here ($!)";\r
1306\r
1307 my $started_first_entry = 0;\r
1308 my $passed_first_entry = 0;\r
1309 while (<OLD_LOG>) {\r
1310 if ( ! $passed_first_entry ) {\r
1311 if ( ( ! $started_first_entry )\r
1312 and /^(\d\d\d\d-\d\d-\d\d\s+\d\d:\d\d)/ ) {\r
1313 $started_first_entry = 1;\r
1314 } elsif ( /^(\d\d\d\d-\d\d-\d\d\s+\d\d:\d\d)/ ) {\r
1315 $passed_first_entry = 1;\r
1316 print NEW_LOG $_;\r
1317 }\r
1318 } else {\r
1319 print NEW_LOG $_;\r
1320 }\r
1321 }\r
1322\r
1323 close NEW_LOG;\r
1324 close OLD_LOG;\r
1325 }\r
1326\r
1327 if ( -f $logfile_here ) {\r
1328 rename $logfile_here, $logfile_bak;\r
1329 }\r
1330 rename $tmpfile, $logfile_here;\r
1331 }\r
1332 }\r
1333}\r
1334\r
1335# -------------------------------------\r
1336\r
1337# Don't call this wrap, because with 5.5.3, that clashes with the\r
1338# (unconditional :-( ) export of wrap() from Text::Wrap\r
1339sub mywrap {\r
1340 my $self = shift;\r
1341 my ($indent1, $indent2, @text) = @_;\r
1342 # If incoming text looks preformatted, don't get clever\r
1343 my $text = Text::Wrap::wrap($indent1, $indent2, @text);\r
1344 if ( grep /^\s+/m, @text ) {\r
1345 return $text;\r
1346 }\r
1347 my @lines = split /\n/, $text;\r
1348 $indent2 =~ s!^((?: {8})+)!"\t" x (length($1)/8)!e;\r
1349 $lines[0] =~ s/^$indent1\s+/$indent1/;\r
1350 s/^$indent2\s+/$indent2/\r
1351 for @lines[1..$#lines];\r
1352 my $newtext = join "\n", @lines;\r
1353 $newtext .= "\n"\r
1354 if substr($text, -1) eq "\n";\r
1355 return $newtext;\r
1356}\r
1357\r
1358# -------------------------------------\r
1359\r
1360sub preprocess_msg_text {\r
1361 my $self = shift;\r
1362 my ($text) = @_;\r
1363\r
1364 # Strip out carriage returns (as they probably result from DOSsy editors).\r
1365 $text =~ s/\r\n/\n/g;\r
1366 # If it *looks* like two newlines, make it *be* two newlines:\r
1367 $text =~ s/\n\s*\n/\n\n/g;\r
1368\r
1369 return $text;\r
1370}\r
1371\r
1372# -------------------------------------\r
1373\r
1374sub last_line_len {\r
1375 my $self = shift;\r
1376\r
1377 my $files_list = shift;\r
1378 my @lines = split (/\n/, $files_list);\r
1379 my $last_line = pop (@lines);\r
1380 return length ($last_line);\r
1381}\r
1382\r
1383# -------------------------------------\r
1384\r
1385# A custom wrap function, sensitive to some common constructs used in\r
1386# log entries.\r
1387sub wrap_log_entry {\r
1388 my $self = shift;\r
1389\r
1390 my $text = shift; # The text to wrap.\r
1391 my $left_pad_str = shift; # String to pad with on the left.\r
1392\r
1393 # These do NOT take left_pad_str into account:\r
1394 my $length_remaining = shift; # Amount left on current line.\r
1395 my $max_line_length = shift; # Amount left for a blank line.\r
1396\r
1397 my $wrapped_text = ''; # The accumulating wrapped entry.\r
1398 my $user_indent = ''; # Inherited user_indent from prev line.\r
1399\r
1400 my $first_time = 1; # First iteration of the loop?\r
1401 my $suppress_line_start_match = 0; # Set to disable line start checks.\r
1402\r
1403 my @lines = split (/\n/, $text);\r
1404 while (@lines) # Don't use `foreach' here, it won't work.\r
1405 {\r
1406 my $this_line = shift (@lines);\r
1407 chomp $this_line;\r
1408\r
1409 if ($this_line =~ /^(\s+)/) {\r
1410 $user_indent = $1;\r
1411 }\r
1412 else {\r
1413 $user_indent = '';\r
1414 }\r
1415\r
1416 # If it matches any of the line-start regexps, print a newline now...\r
1417 if ($suppress_line_start_match)\r
1418 {\r
1419 $suppress_line_start_match = 0;\r
1420 }\r
1421 elsif (($this_line =~ /^(\s*)\*\s+[a-zA-Z0-9]/)\r
1422 || ($this_line =~ /^(\s*)\* [a-zA-Z0-9_\.\/\+-]+/)\r
1423 || ($this_line =~ /^(\s*)\([a-zA-Z0-9_\.\/\+-]+(\)|,\s*)/)\r
1424 || ($this_line =~ /^(\s+)(\S+)/)\r
1425 || ($this_line =~ /^(\s*)- +/)\r
1426 || ($this_line =~ /^()\s*$/)\r
1427 || ($this_line =~ /^(\s*)\*\) +/)\r
1428 || ($this_line =~ /^(\s*)[a-zA-Z0-9](\)|\.|\:) +/))\r
1429 {\r
1430 # Make a line break immediately, unless header separator is set\r
1431 # and this line is the first line in the entry, in which case\r
1432 # we're getting the blank line for free already and shouldn't\r
1433 # add an extra one.\r
1434 unless (($After_Header ne " ") and ($first_time))\r
1435 {\r
1436 if ($this_line =~ /^()\s*$/) {\r
1437 $suppress_line_start_match = 1;\r
1438 $wrapped_text .= "\n${left_pad_str}";\r
1439 }\r
1440\r
1441 $wrapped_text .= "\n${left_pad_str}";\r
1442 }\r
1443\r
1444 $length_remaining = $max_line_length - (length ($user_indent));\r
1445 }\r
1446\r
1447 # Now that any user_indent has been preserved, strip off leading\r
1448 # whitespace, so up-folding has no ugly side-effects.\r
1449 $this_line =~ s/^\s*//;\r
1450\r
1451 # Accumulate the line, and adjust parameters for next line.\r
1452 my $this_len = length ($this_line);\r
1453 if ($this_len == 0)\r
1454 {\r
1455 # Blank lines should cancel any user_indent level.\r
1456 $user_indent = '';\r
1457 $length_remaining = $max_line_length;\r
1458 }\r
1459 elsif ($this_len >= $length_remaining) # Line too long, try breaking it.\r
1460 {\r
1461 # Walk backwards from the end. At first acceptable spot, break\r
1462 # a new line.\r
1463 my $idx = $length_remaining - 1;\r
1464 if ($idx < 0) { $idx = 0 };\r
1465 while ($idx > 0)\r
1466 {\r
1467 if (substr ($this_line, $idx, 1) =~ /\s/)\r
1468 {\r
1469 my $line_now = substr ($this_line, 0, $idx);\r
1470 my $next_line = substr ($this_line, $idx);\r
1471 $this_line = $line_now;\r
1472\r
1473 # Clean whitespace off the end.\r
1474 chomp $this_line;\r
1475\r
1476 # The current line is ready to be printed.\r
1477 $this_line .= "\n${left_pad_str}";\r
1478\r
1479 # Make sure the next line is allowed full room.\r
1480 $length_remaining = $max_line_length - (length ($user_indent));\r
1481\r
1482 # Strip next_line, but then preserve any user_indent.\r
1483 $next_line =~ s/^\s*//;\r
1484\r
1485 # Sneak a peek at the user_indent of the upcoming line, so\r
1486 # $next_line (which will now precede it) can inherit that\r
1487 # indent level. Otherwise, use whatever user_indent level\r
1488 # we currently have, which might be none.\r
1489 my $next_next_line = shift (@lines);\r
1490 if ((defined ($next_next_line)) && ($next_next_line =~ /^(\s+)/)) {\r
1491 $next_line = $1 . $next_line if (defined ($1));\r
1492 # $length_remaining = $max_line_length - (length ($1));\r
1493 $next_next_line =~ s/^\s*//;\r
1494 }\r
1495 else {\r
1496 $next_line = $user_indent . $next_line;\r
1497 }\r
1498 if (defined ($next_next_line)) {\r
1499 unshift (@lines, $next_next_line);\r
1500 }\r
1501 unshift (@lines, $next_line);\r
1502\r
1503 # Our new next line might, coincidentally, begin with one of\r
1504 # the line-start regexps, so we temporarily turn off\r
1505 # sensitivity to that until we're past the line.\r
1506 $suppress_line_start_match = 1;\r
1507\r
1508 last;\r
1509 }\r
1510 else\r
1511 {\r
1512 $idx--;\r
1513 }\r
1514 }\r
1515\r
1516 if ($idx == 0)\r
1517 {\r
1518 # We bottomed out because the line is longer than the\r
1519 # available space. But that could be because the space is\r
1520 # small, or because the line is longer than even the maximum\r
1521 # possible space. Handle both cases below.\r
1522\r
1523 if ($length_remaining == ($max_line_length - (length ($user_indent))))\r
1524 {\r
1525 # The line is simply too long -- there is no hope of ever\r
1526 # breaking it nicely, so just insert it verbatim, with\r
1527 # appropriate padding.\r
1528 $this_line = "\n${left_pad_str}${this_line}";\r
1529 }\r
1530 else\r
1531 {\r
1532 # Can't break it here, but may be able to on the next round...\r
1533 unshift (@lines, $this_line);\r
1534 $length_remaining = $max_line_length - (length ($user_indent));\r
1535 $this_line = "\n${left_pad_str}";\r
1536 }\r
1537 }\r
1538 }\r
1539 else # $this_len < $length_remaining, so tack on what we can.\r
1540 {\r
1541 # Leave a note for the next iteration.\r
1542 $length_remaining = $length_remaining - $this_len;\r
1543\r
1544 if ($this_line =~ /\.$/)\r
1545 {\r
1546 $this_line .= " ";\r
1547 $length_remaining -= 2;\r
1548 }\r
1549 else # not a sentence end\r
1550 {\r
1551 $this_line .= " ";\r
1552 $length_remaining -= 1;\r
1553 }\r
1554 }\r
1555\r
1556 # Unconditionally indicate that loop has run at least once.\r
1557 $first_time = 0;\r
1558\r
1559 $wrapped_text .= "${user_indent}${this_line}";\r
1560 }\r
1561\r
1562 # One last bit of padding.\r
1563 $wrapped_text .= "\n";\r
1564\r
1565 return $wrapped_text;\r
1566}\r
1567\r
1568# -------------------------------------\r
1569\r
1570sub _pretty_file_list {\r
1571 my $self = shift;\r
1572\r
1573 my ($unanimous_tags, $non_unanimous_tags, $all_branches, $qunksref) = @_;\r
1574\r
1575 my @qunkrefs =\r
1576 grep +( ( ! $_->tags_exists\r
1577 or\r
1578 ! grep exists $ignore_tags{$_}, @{$_->tags})\r
1579 and\r
1580 ( ! keys %show_tags\r
1581 or\r
1582 ( $_->tags_exists\r
1583 and\r
1584 grep exists $show_tags{$_}, @{$_->tags} )\r
1585 )\r
1586 ),\r
1587 @$qunksref;\r
1588\r
1589 my $common_dir; # Dir prefix common to all files ('' if none)\r
1590\r
1591 # First, loop over the qunks gathering all the tag/branch names.\r
1592 # We'll put them all in non_unanimous_tags, and take out the\r
1593 # unanimous ones later.\r
1594 QUNKREF:\r
1595 foreach my $qunkref (@qunkrefs)\r
1596 {\r
1597 # Keep track of whether all the files in this commit were in the\r
1598 # same directory, and memorize it if so. We can make the output a\r
1599 # little more compact by mentioning the directory only once.\r
1600 if ($Common_Dir && (scalar (@qunkrefs)) > 1)\r
1601 {\r
1602 if (! (defined ($common_dir)))\r
1603 {\r
1604 my ($base, $dir);\r
1605 ($base, $dir, undef) = fileparse ($qunkref->filename);\r
1606\r
1607 if ((! (defined ($dir))) # this first case is sheer paranoia\r
1608 or ($dir eq '')\r
1609 or ($dir eq "./")\r
1610 or ($dir eq ".\\"))\r
1611 {\r
1612 $common_dir = '';\r
1613 }\r
1614 else\r
1615 {\r
1616 $common_dir = $dir;\r
1617 }\r
1618 }\r
1619 elsif ($common_dir ne '')\r
1620 {\r
1621 # Already have a common dir prefix, so how much of it can we preserve?\r
1622 $common_dir = &main::common_path_prefix ($qunkref->filename, $common_dir);\r
1623 }\r
1624 }\r
1625 else # only one file in this entry anyway, so common dir not an issue\r
1626 {\r
1627 $common_dir = '';\r
1628 }\r
1629\r
1630 if (defined ($qunkref->branch)) {\r
1631 $all_branches->{$qunkref->branch} = 1;\r
1632 }\r
1633 if (defined ($qunkref->tags)) {\r
1634 foreach my $tag (@{$qunkref->tags}) {\r
1635 $non_unanimous_tags->{$tag} = 1;\r
1636 }\r
1637 }\r
1638 }\r
1639\r
1640 # Any tag held by all qunks will be printed specially... but only if\r
1641 # there are multiple qunks in the first place!\r
1642 if ((scalar (@qunkrefs)) > 1) {\r
1643 foreach my $tag (keys (%$non_unanimous_tags)) {\r
1644 my $everyone_has_this_tag = 1;\r
1645 foreach my $qunkref (@qunkrefs) {\r
1646 if ((! (defined ($qunkref->tags)))\r
1647 or (! (grep ($_ eq $tag, @{$qunkref->tags})))) {\r
1648 $everyone_has_this_tag = 0;\r
1649 }\r
1650 }\r
1651 if ($everyone_has_this_tag) {\r
1652 $unanimous_tags->{$tag} = 1;\r
1653 delete $non_unanimous_tags->{$tag};\r
1654 }\r
1655 }\r
1656 }\r
1657\r
1658 return $common_dir, \@qunkrefs;\r
1659}\r
1660\r
1661# -------------------------------------\r
1662\r
1663sub fdatetime {\r
1664 my $self = shift;\r
1665\r
1666 my ($year, $mday, $mon, $wday, $hour, $min);\r
1667\r
1668 if ( @_ > 1 ) {\r
1669 ($year, $mday, $mon, $wday, $hour, $min) = @_;\r
1670 } else {\r
1671 my ($time) = @_;\r
1672 (undef, $min, $hour, $mday, $mon, $year, $wday) =\r
1673 $UTC_Times ? gmtime($time) : localtime($time);\r
1674\r
1675 $year += 1900;\r
1676 $mon += 1;\r
1677 $wday = $self->wday($wday);\r
1678 }\r
1679\r
1680 my $fdate = $self->fdate($year, $mon, $mday, $wday);\r
1681\r
1682 if ($Show_Times) {\r
1683 my $ftime = $self->ftime($hour, $min);\r
1684 return "$fdate $ftime";\r
1685 } else {\r
1686 return $fdate;\r
1687 }\r
1688}\r
1689\r
1690# -------------------------------------\r
1691\r
1692sub fdate {\r
1693 my $self = shift;\r
1694\r
1695 my ($year, $mday, $mon, $wday);\r
1696\r
1697 if ( @_ > 1 ) {\r
1698 ($year, $mon, $mday, $wday) = @_;\r
1699 } else {\r
1700 my ($time) = @_;\r
1701 (undef, undef, undef, $mday, $mon, $year, $wday) =\r
1702 $UTC_Times ? gmtime($time) : localtime($time);\r
1703\r
1704 $year += 1900;\r
1705 $mon += 1;\r
1706 $wday = $self->wday($wday);\r
1707 }\r
1708\r
1709 return sprintf '%4u-%02u-%02u%s', $year, $mon, $mday, $wday;\r
1710}\r
1711\r
1712# -------------------------------------\r
1713\r
1714sub ftime {\r
1715 my $self = shift;\r
1716\r
1717 my ($hour, $min);\r
1718\r
1719 if ( @_ > 1 ) {\r
1720 ($hour, $min) = @_;\r
1721 } else {\r
1722 my ($time) = @_;\r
1723 (undef, $min, $hour) = $UTC_Times ? gmtime($time) : localtime($time);\r
1724 }\r
1725\r
1726 return sprintf '%02u:%02u', $hour, $min;\r
1727}\r
1728\r
1729# ----------------------------------------------------------------------------\r
1730\r
1731package CVS::Utils::ChangeLog::Message;\r
1732\r
1733sub new {\r
1734 my $class = shift;\r
1735 my ($msg) = @_;\r
1736\r
1737 my %self = (msg => $msg, files => []);\r
1738\r
1739 bless \%self, $class;\r
1740}\r
1741\r
1742sub add_fileentry {\r
1743 my $self = shift;\r
1744 my ($fileentry) = @_;\r
1745\r
1746 die "Not a fileentry: $fileentry"\r
1747 unless $fileentry->isa('CVS::Utils::ChangeLog::FileEntry');\r
1748\r
1749 push @{$self->{files}}, $fileentry;\r
1750}\r
1751\r
1752sub files { wantarray ? @{$_[0]->{files}} : $_[0]->{files} }\r
1753\r
1754# ----------------------------------------------------------------------------\r
1755\r
1756package CVS::Utils::ChangeLog::FileEntry;\r
1757\r
1758use File::Basename qw( fileparse );\r
1759\r
1760# Each revision of a file has a little data structure (a `qunk')\r
1761# associated with it. That data structure holds not only the\r
1762# file's name, but any additional information about the file\r
1763# that might be needed in the output, such as the revision\r
1764# number, tags, branches, etc. The reason to have these things\r
1765# arranged in a data structure, instead of just appending them\r
1766# textually to the file's name, is that we may want to do a\r
1767# little rearranging later as we write the output. For example,\r
1768# all the files on a given tag/branch will go together, followed\r
1769# by the tag in parentheses (so trunk or otherwise non-tagged\r
1770# files would go at the end of the file list for a given log\r
1771# message). This rearrangement is a lot easier to do if we\r
1772# don't have to reparse the text.\r
1773#\r
1774# A qunk looks like this:\r
1775#\r
1776# {\r
1777# filename => "hello.c",\r
1778# revision => "1.4.3.2",\r
1779# time => a timegm() return value (moment of commit)\r
1780# tags => [ "tag1", "tag2", ... ],\r
1781# branch => "branchname" # There should be only one, right?\r
1782# roots => [ "branchtag1", "branchtag2", ... ]\r
1783# lines => "+x -y" # or undefined; x and y are integers\r
1784# }\r
1785\r
1786# Single top-level ChangeLog, or one per subdirectory?\r
1787my $distributed;\r
1788sub distributed { $#_ ? ($distributed = $_[1]) : $distributed; }\r
1789\r
1790sub new {\r
1791 my $class = shift;\r
1792 my ($path, $time, $revision, $state, $lines,\r
1793 $branch_names, $branch_roots, $branch_numbers, $symbolic_names) = @_;\r
1794\r
1795 my %self = (time => $time,\r
1796 revision => $revision,\r
1797 state => $state,\r
1798 lines => $lines,\r
1799 branch_numbers => $branch_numbers,\r
1800 );\r
1801\r
1802 if ( $distributed ) {\r
1803 @self{qw(filename dir_key)} = fileparse($path);\r
1804 } else {\r
1805 @self{qw(filename dir_key)} = ($path, './');\r
1806 }\r
1807\r
1808 { # Scope for $branch_prefix\r
1809 (my ($branch_prefix) = ($revision =~ /((?:\d+\.)+)\d+/));\r
1810 $branch_prefix =~ s/\.$//;\r
1811 if ( $branch_names->{$branch_prefix} ) {\r
1812 my $branch_name = $branch_names->{$branch_prefix};\r
1813 $self{branch} = $branch_name;\r
1814 $self{branches} = [$branch_name];\r
1815 }\r
1816 while ( $branch_prefix =~ s/^(\d+(?:\.\d+\.\d+)+)\.\d+\.\d+$/$1/ ) {\r
1817 push @{$self{branches}}, $branch_names->{$branch_prefix}\r
1818 if exists $branch_names->{$branch_prefix};\r
1819 }\r
1820 }\r
1821\r
1822 # If there's anything in the @branch_roots array, then this\r
1823 # revision is the root of at least one branch. We'll display\r
1824 # them as branch names instead of revision numbers, the\r
1825 # substitution for which is done directly in the array:\r
1826 $self{'roots'} = [ map { $branch_names->{$_} } @$branch_roots ]\r
1827 if @$branch_roots;\r
1828\r
1829 if ( exists $symbolic_names->{$revision} ) {\r
1830 $self{tags} = delete $symbolic_names->{$revision};\r
1831 &main::delta_check($time, $self{tags});\r
1832 }\r
1833\r
1834 bless \%self, $class;\r
1835}\r
1836\r
1837sub filename { $_[0]->{filename} }\r
1838sub dir_key { $_[0]->{dir_key} }\r
1839sub revision { $_[0]->{revision} }\r
1840sub branch { $_[0]->{branch} }\r
1841sub state { $_[0]->{state} }\r
1842sub lines { $_[0]->{lines} }\r
1843sub roots { $_[0]->{roots} }\r
1844sub branch_numbers { $_[0]->{branch_numbers} }\r
1845\r
1846sub tags { $_[0]->{tags} }\r
1847sub tags_exists {\r
1848 exists $_[0]->{tags};\r
1849}\r
1850\r
1851# This may someday be used in a more sophisticated calculation of what other\r
1852# files are involved in this commit. For now, we don't use it much except for\r
1853# delta mode, because the common-commit-detection algorithm is hypothesized to\r
1854# be "good enough" as it stands.\r
1855sub time { $_[0]->{time} }\r
1856\r
1857# ----------------------------------------------------------------------------\r
1858\r
1859package CVS::Utils::ChangeLog::EntrySetBuilder;\r
1860\r
1861use File::Basename qw( fileparse );\r
1862use Time::Local qw( timegm );\r
1863\r
1864use constant MAILNAME => "/etc/mailname";\r
1865\r
1866# In 'cvs log' output, one long unbroken line of equal signs separates files:\r
1867use constant FILE_SEPARATOR => '=' x 77;# . "\n";\r
1868# In 'cvs log' output, a shorter line of dashes separates log messages within\r
1869# a file:\r
1870use constant REV_SEPARATOR => '-' x 28;# . "\n";\r
1871\r
1872use constant EMPTY_LOG_MESSAGE => '*** empty log message ***';\r
1873\r
1874# -------------------------------------\r
1875\r
1876sub new {\r
1877 my ($proto) = @_;\r
1878 my $class = ref $proto || $proto;\r
1879\r
1880 my $poobah = CVS::Utils::ChangeLog::EntrySet->new;\r
1881 my $self = bless +{ grand_poobah => $poobah }, $class;\r
1882\r
1883 $self->clear_file;\r
1884 $self->maybe_read_user_map_file;\r
1885 return $self;\r
1886}\r
1887\r
1888# -------------------------------------\r
1889\r
1890sub clear_msg {\r
1891 my ($self) = @_;\r
1892\r
1893 # Make way for the next message\r
1894 undef $self->{rev_msg};\r
1895 undef $self->{rev_time};\r
1896 undef $self->{rev_revision};\r
1897 undef $self->{rev_author};\r
1898 undef $self->{rev_state};\r
1899 undef $self->{lines};\r
1900 $self->{rev_branch_roots} = []; # For showing which files are branch\r
1901 # ancestors.\r
1902 $self->{collecting_symbolic_names} = 0;\r
1903}\r
1904\r
1905# -------------------------------------\r
1906\r
1907sub clear_file {\r
1908 my ($self) = @_;\r
1909 $self->clear_msg;\r
1910\r
1911 undef $self->{filename};\r
1912 $self->{branch_names} = +{}; # We'll grab branch names while we're\r
1913 # at it.\r
1914 $self->{branch_numbers} = +{}; # Save some revisions for\r
1915 # @Follow_Branches\r
1916 $self->{symbolic_names} = +{}; # Where tag names get stored.\r
1917}\r
1918\r
1919# -------------------------------------\r
1920\r
1921sub grand_poobah { $_[0]->{grand_poobah} }\r
1922\r
1923# -------------------------------------\r
1924\r
1925sub read_changelog {\r
1926 my ($self, $command) = @_;\r
1927\r
1928# my $grand_poobah = CVS::Utils::ChangeLog::EntrySet->new;\r
1929\r
1930 if (! $Input_From_Stdin) {\r
1931 my $Log_Source_Command = join(' ', @$command);\r
1932 &main::debug ("(run \"${Log_Source_Command}\")\n");\r
1933 open (LOG_SOURCE, "$Log_Source_Command |")\r
1934 or die "unable to run \"${Log_Source_Command}\"";\r
1935 }\r
1936 else {\r
1937 open (LOG_SOURCE, "-") or die "unable to open stdin for reading";\r
1938 }\r
1939\r
1940 binmode LOG_SOURCE;\r
1941\r
1942 XX_Log_Source:\r
1943 while (<LOG_SOURCE>) {\r
1944 chomp;\r
1945 s!\r$!!;\r
1946\r
1947 # If on a new file and don't see filename, skip until we find it, and\r
1948 # when we find it, grab it.\r
1949 if ( ! defined $self->{filename} ) {\r
1950 $self->read_file_path($_);\r
1951 } elsif ( /^symbolic names:$/ ) {\r
1952 $self->{collecting_symbolic_names} = 1;\r
1953 } elsif ( $self->{collecting_symbolic_names} ) {\r
1954 $self->read_symbolic_name($_);\r
1955 } elsif ( $_ eq FILE_SEPARATOR and ! defined $self->{rev_revision} ) {\r
1956 $self->clear_file;\r
1957 } elsif ( ! defined $self->{rev_revision} ) {\r
1958 # If have file name, but not revision, and see revision, then grab\r
1959 # it. (We collect unconditionally, even though we may or may not\r
1960 # ever use it.)\r
1961 $self->read_revision($_);\r
1962 } elsif ( ! defined $self->{rev_time} ) { # and /^date: /) {\r
1963 $self->read_date_author_and_state($_);\r
1964 } elsif ( /^branches:\s+(.*);$/ ) {\r
1965 $self->read_branches($1);\r
1966 } elsif ( ! ( $_ eq FILE_SEPARATOR or $_ eq REV_SEPARATOR ) ) {\r
1967 # If have file name, time, and author, then we're just grabbing\r
1968 # log message texts:\r
1969 $self->{rev_msg} .= $_ . "\n"; # Normally, just accumulate the message...\r
1970 } else {\r
1971 if ( ! $self->{rev_msg}\r
1972 or $self->{rev_msg} =~ /^\s*(\.\s*)?$/\r
1973 or index($self->{rev_msg}, EMPTY_LOG_MESSAGE) > -1 ) {\r
1974 # ... until a msg separator is encountered:\r
1975 # Ensure the message contains something:\r
1976 $self->clear_msg\r
1977 if $Prune_Empty_Msgs;\r
1978 $self->{rev_msg} = "[no log message]\n";\r
1979 }\r
1980\r
1981 $self->add_file_entry;\r
1982\r
1983 if ( $_ eq FILE_SEPARATOR ) {\r
1984 $self->clear_file;\r
1985 } else {\r
1986 $self->clear_msg;\r
1987 }\r
1988 }\r
1989 }\r
1990\r
1991 close LOG_SOURCE\r
1992 or die sprintf("Problem reading log input (exit/signal/core: %d/%d/%d)\n",\r
1993 $? >> 8, $? & 127, $? & 128);\r
1994 return;\r
1995}\r
1996\r
1997# -------------------------------------\r
1998\r
1999sub add_file_entry {\r
2000 $_[0]->grand_poobah->add_fileentry(@{$_[0]}{qw(filename rev_time rev_revision\r
2001 rev_state lines branch_names\r
2002 rev_branch_roots\r
2003 branch_numbers\r
2004 symbolic_names\r
2005 rev_author rev_msg)});\r
2006}\r
2007\r
2008# -------------------------------------\r
2009\r
2010sub maybe_read_user_map_file {\r
2011 my ($self) = @_;\r
2012\r
2013 my %expansions;\r
2014 my $User_Map_Input;\r
2015\r
2016 if ($User_Map_File)\r
2017 {\r
2018 if ( $User_Map_File =~ m{^([-\w\@+=.,\/]+):([-\w\@+=.,\/:]+)} and\r
2019 !-f $User_Map_File )\r
2020 {\r
2021 my $rsh = (exists $ENV{'CVS_RSH'} ? $ENV{'CVS_RSH'} : 'ssh');\r
2022 $User_Map_Input = "$rsh $1 'cat $2' |";\r
2023 &main::debug ("(run \"${User_Map_Input}\")\n");\r
2024 }\r
2025 else\r
2026 {\r
2027 $User_Map_Input = "<$User_Map_File";\r
2028 }\r
2029\r
2030 open (MAPFILE, $User_Map_Input)\r
2031 or die ("Unable to open $User_Map_File ($!)");\r
2032\r
2033 while (<MAPFILE>)\r
2034 {\r
2035 next if /^\s*#/; # Skip comment lines.\r
2036 next if not /:/; # Skip lines without colons.\r
2037\r
2038 # It is now safe to split on ':'.\r
2039 my ($username, $expansion) = split ':';\r
2040 chomp $expansion;\r
2041 $expansion =~ s/^'(.*)'$/$1/;\r
2042 $expansion =~ s/^"(.*)"$/$1/;\r
2043\r
2044 # If it looks like the expansion has a real name already, then\r
2045 # we toss the username we got from CVS log. Otherwise, keep\r
2046 # it to use in combination with the email address.\r
2047\r
2048 if ($expansion =~ /^\s*<{0,1}\S+@.*/) {\r
2049 # Also, add angle brackets if none present\r
2050 if (! ($expansion =~ /<\S+@\S+>/)) {\r
2051 $expansions{$username} = "$username <$expansion>";\r
2052 }\r
2053 else {\r
2054 $expansions{$username} = "$username $expansion";\r
2055 }\r
2056 }\r
2057 else {\r
2058 $expansions{$username} = $expansion;\r
2059 }\r
2060 } # fi ($User_Map_File)\r
2061\r
2062 close (MAPFILE);\r
2063 }\r
2064\r
2065 if (defined $User_Passwd_File)\r
2066 {\r
2067 if ( ! defined $Domain ) {\r
2068 if ( -e MAILNAME ) {\r
2069 chomp($Domain = slurp_file(MAILNAME));\r
2070 } else {\r
2071 MAILDOMAIN_CMD:\r
2072 for ([qw(hostname -d)], 'dnsdomainname', 'domainname') {\r
2073 my ($text, $exit, $sig, $core) = run_ext($_);\r
2074 if ( $exit == 0 && $sig == 0 && $core == 0 ) {\r
2075 chomp $text;\r
2076 if ( length $text ) {\r
2077 $Domain = $text;\r
2078 last MAILDOMAIN_CMD;\r
2079 }\r
2080 }\r
2081 }\r
2082 }\r
2083 }\r
2084\r
2085 die "No mail domain found\n"\r
2086 unless defined $Domain;\r
2087\r
2088 open (MAPFILE, "<$User_Passwd_File")\r
2089 or die ("Unable to open $User_Passwd_File ($!)");\r
2090 while (<MAPFILE>)\r
2091 {\r
2092 # all lines are valid\r
2093 my ($username, $pw, $uid, $gid, $gecos, $homedir, $shell) = split ':';\r
2094 my $expansion = '';\r
2095 ($expansion) = split (',', $gecos)\r
2096 if defined $gecos && length $gecos;\r
2097\r
2098 my $mailname = $Domain eq '' ? $username : "$username\@$Domain";\r
2099 $expansions{$username} = "$expansion <$mailname>";\r
2100 }\r
2101 close (MAPFILE);\r
2102 }\r
2103\r
2104 $self->{usermap} = \%expansions;\r
2105}\r
2106\r
2107# -------------------------------------\r
2108\r
2109sub read_file_path {\r
2110 my ($self, $line) = @_;\r
2111\r
2112 my $path;\r
2113\r
2114 if ( $line =~ /^Working file: (.*)/ ) {\r
2115 $path = $1;\r
2116 } elsif ( defined $RCS_Root\r
2117 and\r
2118 $line =~ m|^RCS file: $RCS_Root[/\\](.*),v$| ) {\r
2119 $path = $1;\r
2120 $path =~ s!Attic/!!;\r
2121 } else {\r
2122 return;\r
2123 }\r
2124\r
2125 if ( @Ignore_Files ) {\r
2126 my $base;\r
2127 ($base, undef, undef) = fileparse($path);\r
2128\r
2129 my $xpath = $Case_Insensitive ? lc($path) : $path;\r
2130 if ( grep index($path, $_) > -1, @Ignore_Files ) {\r
2131 return;\r
2132 }\r
2133 }\r
2134\r
2135 $self->{filename} = $path;\r
2136 return;\r
2137}\r
2138\r
2139# -------------------------------------\r
2140\r
2141sub read_symbolic_name {\r
2142 my ($self, $line) = @_;\r
2143\r
2144 # All tag names are listed with whitespace in front in cvs log\r
2145 # output; so if see non-whitespace, then we're done collecting.\r
2146 if ( /^\S/ ) {\r
2147 $self->{collecting_symbolic_names} = 0;\r
2148 return;\r
2149 } else {\r
2150 # we're looking at a tag name, so parse & store it\r
2151\r
2152 # According to the Cederqvist manual, in node "Tags", tag names must start\r
2153 # with an uppercase or lowercase letter and can contain uppercase and\r
2154 # lowercase letters, digits, `-', and `_'. However, it's not our place to\r
2155 # enforce that, so we'll allow anything CVS hands us to be a tag:\r
2156 my ($tag_name, $tag_rev) = ($line =~ /^\s+([^:]+): ([\d.]+)$/);\r
2157\r
2158 # A branch number either has an odd number of digit sections\r
2159 # (and hence an even number of dots), or has ".0." as the\r
2160 # second-to-last digit section. Test for these conditions.\r
2161 my $real_branch_rev = '';\r
2162 if ( $tag_rev =~ /^(\d+\.\d+\.)+\d+$/ # Even number of dots...\r
2163 and\r
2164 $tag_rev !~ /^(1\.)+1$/ ) { # ...but not "1.[1.]1"\r
2165 $real_branch_rev = $tag_rev;\r
2166 } elsif ($tag_rev =~ /(\d+\.(\d+\.)+)0.(\d+)/) { # Has ".0."\r
2167 $real_branch_rev = $1 . $3;\r
2168 }\r
2169\r
2170 # If we got a branch, record its number.\r
2171 if ( $real_branch_rev ) {\r
2172 $self->{branch_names}->{$real_branch_rev} = $tag_name;\r
2173 $self->{branch_numbers}->{$tag_name} = $real_branch_rev;\r
2174 } else {\r
2175 # Else it's just a regular (non-branch) tag.\r
2176 push @{$self->{symbolic_names}->{$tag_rev}}, $tag_name;\r
2177 }\r
2178 }\r
2179\r
2180 $self->{collecting_symbolic_names} = 1;\r
2181 return;\r
2182}\r
2183\r
2184# -------------------------------------\r
2185\r
2186sub read_revision {\r
2187 my ($self, $line) = @_;\r
2188\r
2189 my ($revision) = ( $line =~ /^revision (\d+\.[\d.]+)/ );\r
2190\r
2191 return\r
2192 unless $revision;\r
2193\r
2194 $self->{rev_revision} = $revision;\r
2195 return;\r
2196}\r
2197\r
2198# -------------------------------------\r
2199\r
2200{ # Closure over %gecos_warned\r
2201my %gecos_warned;\r
2202sub read_date_author_and_state {\r
2203 my ($self, $line) = @_;\r
2204\r
2205 my ($time, $author, $state) = $self->parse_date_author_and_state($line);\r
2206\r
2207 if ( defined($self->{usermap}->{$author}) and $self->{usermap}->{$author} ) {\r
2208 $author = $self->{usermap}->{$author};\r
2209 } elsif ( defined $Domain or $Gecos == 1 ) {\r
2210 my $email = $author;\r
2211 $email = $author."@".$Domain\r
2212 if defined $Domain && $Domain ne '';\r
2213\r
2214 my $pw = getpwnam($author);\r
2215 my ($fullname, $office, $workphone, $homephone, $gcos);\r
2216 if ( defined $pw ) {\r
2217 $gcos = (getpwnam($author))[6];\r
2218 ($fullname, $office, $workphone, $homephone) =\r
2219 split /\s*,\s*/, $gcos;\r
2220 } else {\r
2221 warn "Couldn't find gecos info for author '$author'\n"\r
2222 unless $gecos_warned{$author}++;\r
2223 $fullname = '';\r
2224 }\r
2225 for (grep defined, $fullname, $office, $workphone, $homephone) {\r
2226 s/&/ucfirst(lc($pw->name))/ge;\r
2227 }\r
2228 $author = $fullname . " <" . $email . ">"\r
2229 if $fullname ne '';\r
2230 }\r
2231\r
2232 $self->{rev_state} = $state;\r
2233 $self->{rev_time} = $time;\r
2234 $self->{rev_author} = $author;\r
2235 return;\r
2236}\r
2237}\r
2238\r
2239# -------------------------------------\r
2240\r
2241sub read_branches {\r
2242 # A "branches: ..." line here indicates that one or more branches\r
2243 # are rooted at this revision. If we're showing branches, then we\r
2244 # want to show that fact as well, so we collect all the branches\r
2245 # that this is the latest ancestor of and store them in\r
2246 # $self->[rev_branch_roots}. Just for reference, the format of the\r
2247 # line we're seeing at this point is:\r
2248 #\r
2249 # branches: 1.5.2; 1.5.4; ...;\r
2250 #\r
2251 # Okay, here goes:\r
2252 my ($self, $line) = @_;\r
2253\r
2254 # Ugh. This really bothers me. Suppose we see a log entry\r
2255 # like this:\r
2256 #\r
2257 # ----------------------------\r
2258 # revision 1.1\r
2259 # date: 1999/10/17 03:07:38; author: jrandom; state: Exp;\r
2260 # branches: 1.1.2;\r
2261 # Intended first line of log message begins here.\r
2262 # ----------------------------\r
2263 #\r
2264 # The question is, how we can tell the difference between that\r
2265 # log message and a *two*-line log message whose first line is\r
2266 #\r
2267 # "branches: 1.1.2;"\r
2268 #\r
2269 # See the problem? The output of "cvs log" is inherently\r
2270 # ambiguous.\r
2271 #\r
2272 # For now, we punt: we liberally assume that people don't\r
2273 # write log messages like that, and just toss a "branches:"\r
2274 # line if we see it but are not showing branches. I hope no\r
2275 # one ever loses real log data because of this.\r
2276 if ( $Show_Branches ) {\r
2277 $line =~ s/(1\.)+1;|(1\.)+1$//; # ignore the trivial branch 1.1.1\r
2278 $self->{rev_branch_roots} = [split /;\s+/, $line]\r
2279 if length $line;\r
2280 }\r
2281}\r
2282\r
2283# -------------------------------------\r
2284\r
2285sub parse_date_author_and_state {\r
2286 my ($self, $line) = @_;\r
2287 # Parses the date/time and author out of a line like:\r
2288 #\r
2289 # date: 1999/02/19 23:29:05; author: apharris; state: Exp;\r
2290 #\r
2291 # or, in CVS 1.12.9:\r
2292 #\r
2293 # date: 2004-06-05 16:10:32 +0000; author: somebody; state: Exp;\r
2294\r
2295 my ($year, $mon, $mday, $hours, $min, $secs, $utcOffset, $author, $state, $rest) =\r
2296 $line =~\r
2297 m!(\d+)[-/](\d+)[-/](\d+)\s+(\d+):(\d+):(\d+)(\s+[+-]\d{4})?;\s+\r
2298 author:\s+([^;]+);\s+state:\s+([^;]+);(.*)!x\r
2299 or die "Couldn't parse date ``$line''";\r
2300 die "Bad date or Y2K issues"\r
2301 unless $year > 1969 and $year < 2258;\r
2302 # Kinda arbitrary, but useful as a sanity check\r
2303 my $time = timegm($secs, $min, $hours, $mday, $mon-1, $year-1900);\r
2304 if ( defined $utcOffset ) {\r
2305 my ($plusminus, $hour, $minute) = ($utcOffset =~ m/([+-])(\d\d)(\d\d)/);\r
2306 my $offset = (($hour * 60) + $minute) * 60 * ($plusminus eq '+' ? -1 : 1);\r
2307 $time += $offset;\r
2308 }\r
2309 if ( $rest =~ m!\s+lines:\s+(.*)! ) {\r
2310 $self->{lines} = $1;\r
2311 }\r
2312\r
2313 return $time, $author, $state;\r
2314}\r
2315\r
2316# Subrs ----------------------------------------------------------------------\r
2317\r
2318package main;\r
2319\r
2320sub delta_check {\r
2321 my ($time, $tags) = @_;\r
2322\r
2323 # If we're in 'delta' mode, update the latest observed times for the\r
2324 # beginning and ending tags, and when we get around to printing output, we\r
2325 # will simply restrict ourselves to that timeframe...\r
2326 return\r
2327 unless $Delta_Mode;\r
2328\r
2329 $Delta_StartTime = $time\r
2330 if $time > $Delta_StartTime and grep { $_ eq $Delta_From } @$tags;\r
2331\r
2332 $Delta_EndTime = $time\r
2333 if $time > $Delta_EndTime and grep { $_ eq $Delta_To } @$tags;\r
2334}\r
2335\r
2336sub run_ext {\r
2337 my ($cmd) = @_;\r
2338 $cmd = [$cmd]\r
2339 unless ref $cmd;\r
2340 local $" = ' ';\r
2341 my $out = qx"@$cmd 2>&1";\r
2342 my $rv = $?;\r
2343 my ($sig, $core, $exit) = ($? & 127, $? & 128, $? >> 8);\r
2344 return $out, $exit, $sig, $core;\r
2345}\r
2346\r
2347# -------------------------------------\r
2348\r
2349# If accumulating, grab the boundary date from pre-existing ChangeLog.\r
2350sub maybe_grab_accumulation_date {\r
2351 if (! $Cumulative || $Update) {\r
2352 return '';\r
2353 }\r
2354\r
2355 # else\r
2356\r
2357 open (LOG, "$Log_File_Name")\r
2358 or die ("trouble opening $Log_File_Name for reading ($!)");\r
2359\r
2360 my $boundary_date;\r
2361 while (<LOG>)\r
2362 {\r
2363 if (/^(\d\d\d\d-\d\d-\d\d\s+\d\d:\d\d)/)\r
2364 {\r
2365 $boundary_date = "$1";\r
2366 last;\r
2367 }\r
2368 }\r
2369\r
2370 close (LOG);\r
2371\r
2372 # convert time from utc to local timezone if the ChangeLog has\r
2373 # dates/times in utc\r
2374 if ($UTC_Times && $boundary_date)\r
2375 {\r
2376 # convert the utc time to a time value\r
2377 my ($year,$mon,$mday,$hour,$min) = $boundary_date =~\r
2378 m#(\d+)-(\d+)-(\d+)\s+(\d+):(\d+)#;\r
2379 my $time = timegm(0,$min,$hour,$mday,$mon-1,$year-1900);\r
2380 # print the timevalue in the local timezone\r
2381 my ($ignore,$wday);\r
2382 ($ignore,$min,$hour,$mday,$mon,$year,$wday) = localtime($time);\r
2383 $boundary_date=sprintf ("%4u-%02u-%02u %02u:%02u",\r
2384 $year+1900,$mon+1,$mday,$hour,$min);\r
2385 }\r
2386\r
2387 return $boundary_date;\r
2388}\r
2389\r
2390# -------------------------------------\r
2391\r
2392# Fills up a ChangeLog structure in the current directory.\r
2393sub derive_changelog {\r
2394 my ($command) = @_;\r
2395\r
2396 # See "The Plan" above for a full explanation.\r
2397\r
2398 # Might be adding to an existing ChangeLog\r
2399 my $accumulation_date = maybe_grab_accumulation_date;\r
2400 if ($accumulation_date) {\r
2401 # Insert -d immediately after 'cvs log'\r
2402 my $Log_Date_Command = "-d\'>${accumulation_date}\'";\r
2403\r
2404 my ($log_index) = grep $command->[$_] eq 'log', 0..$#$command;\r
2405 splice @$command, $log_index+1, 0, $Log_Date_Command;\r
2406 &debug ("(adding log msg starting from $accumulation_date)\n");\r
2407 }\r
2408\r
2409# output_changelog(read_changelog($command));\r
2410 my $builder = CVS::Utils::ChangeLog::EntrySetBuilder->new;\r
2411 $builder->read_changelog($command);\r
2412 $builder->grand_poobah->output_changelog;\r
2413}\r
2414\r
2415# -------------------------------------\r
2416\r
2417sub min { $_[0] < $_[1] ? $_[0] : $_[1] }\r
2418\r
2419# -------------------------------------\r
2420\r
2421sub common_path_prefix {\r
2422 my ($path1, $path2) = @_;\r
2423\r
2424 # For compatibility (with older versions of cvs2cl.pl), we think in UN*X\r
2425 # terms, and mould windoze filenames to match. Is this really appropriate?\r
2426 # If a file is checked in under UN*X, and cvs log run on windoze, which way\r
2427 # do the path separators slope? Can we use fileparse as per the local\r
2428 # conventions? If so, we should probably have a user option to specify an\r
2429 # OS to emulate to handle stdin-fed logs. If we did this, we could avoid\r
2430 # the nasty \-/ transmogrification below.\r
2431\r
2432 my ($dir1, $dir2) = map +(fileparse($_))[1], $path1, $path2;\r
2433\r
2434 # Transmogrify Windows filenames to look like Unix.\r
2435 # (It is far more likely that someone is running cvs2cl.pl under\r
2436 # Windows than that they would genuinely have backslashes in their\r
2437 # filenames.)\r
2438 tr!\\!/!\r
2439 for $dir1, $dir2;\r
2440\r
2441 my ($accum1, $accum2, $last_common_prefix) = ('') x 3;\r
2442\r
2443 my @path1 = grep length($_), split qr!/!, $dir1;\r
2444 my @path2 = grep length($_), split qr!/!, $dir2;\r
2445\r
2446 my @common_path;\r
2447 for (0..min($#path1,$#path2)) {\r
2448 if ( $path1[$_] eq $path2[$_]) {\r
2449 push @common_path, $path1[$_];\r
2450 } else {\r
2451 last;\r
2452 }\r
2453 }\r
2454\r
2455 return join '', map "$_/", @common_path;\r
2456}\r
2457\r
2458# -------------------------------------\r
2459sub parse_options {\r
2460 # Check this internally before setting the global variable.\r
2461 my $output_file;\r
2462\r
2463 # If this gets set, we encountered unknown options and will exit at\r
2464 # the end of this subroutine.\r
2465 my $exit_with_admonishment = 0;\r
2466\r
2467 # command to generate the log\r
2468 my @log_source_command = qw( cvs log );\r
2469\r
2470 my (@Global_Opts, @Local_Opts);\r
2471\r
2472 Getopt::Long::Configure(qw( bundling permute no_getopt_compat\r
2473 pass_through no_ignore_case ));\r
2474 GetOptions('help|usage|h' => \$Print_Usage,\r
2475 'debug' => \$Debug, # unadvertised option, heh\r
2476 'version' => \$Print_Version,\r
2477\r
2478 'file|f=s' => \$output_file,\r
2479 'accum' => \$Cumulative,\r
2480 'update' => \$Update,\r
2481 'fsf' => \$FSF_Style,\r
2482 'rcs=s' => \$RCS_Root,\r
2483 'usermap|U=s' => \$User_Map_File,\r
2484 'gecos' => \$Gecos,\r
2485 'domain=s' => \$Domain,\r
2486 'passwd=s' => \$User_Passwd_File,\r
2487 'window|W=i' => \$Max_Checkin_Duration,\r
2488 'chrono' => \$Chronological_Order,\r
2489 'ignore|I=s' => \@Ignore_Files,\r
2490 'case-insensitive|C' => \$Case_Insensitive,\r
2491 'regexp|R=s' => \$Regexp_Gate,\r
2492 'stdin' => \$Input_From_Stdin,\r
2493 'stdout' => \$Output_To_Stdout,\r
2494 'distributed|d' => sub { CVS::Utils::ChangeLog::FileEntry->distributed(1) },\r
2495 'prune|P' => \$Prune_Empty_Msgs,\r
2496 'no-wrap' => \$No_Wrap,\r
2497 'gmt|utc' => \$UTC_Times,\r
2498 'day-of-week|w' => \$Show_Day_Of_Week,\r
2499 'revisions|r' => \$Show_Revisions,\r
2500 'show-dead' => \$Show_Dead,\r
2501 'tags|t' => \$Show_Tags,\r
2502 'tagdates|T' => \$Show_Tag_Dates,\r
2503 'branches|b' => \$Show_Branches,\r
2504 'follow|F=s' => \@Follow_Branches,\r
2505 'follow-only=s' => \@Follow_Only,\r
2506 'xml-encoding=s' => \$XML_Encoding,\r
2507 'xml' => \$XML_Output,\r
2508 'noxmlns' => \$No_XML_Namespace,\r
2509 'no-xml-iso-date' => \$No_XML_ISO_Date,\r
2510 'no-ancestors' => \$No_Ancestors,\r
2511 'lines-modified' => \$Show_Lines_Modified,\r
2512\r
2513 'no-indent' => sub {\r
2514 $Indent = '';\r
2515 },\r
2516\r
2517 'summary' => sub {\r
2518 $Summary = 1;\r
2519 $After_Header = "\n\n"; # Summary implies --separate-header\r
2520 },\r
2521\r
2522 'no-times' => sub {\r
2523 $Show_Times = 0;\r
2524 },\r
2525\r
2526 'no-hide-branch-additions' => sub {\r
2527 $Hide_Branch_Additions = 0;\r
2528 },\r
2529\r
2530 'no-common-dir' => sub {\r
2531 $Common_Dir = 0;\r
2532 },\r
2533\r
2534 'ignore-tag=s' => sub {\r
2535 $ignore_tags{$_[1]} = 1;\r
2536 },\r
2537\r
2538 'show-tag=s' => sub {\r
2539 $show_tags{$_[1]} = 1;\r
2540 },\r
2541\r
2542 # Deliberately undocumented. This is not a public interface, and\r
2543 # may change/disappear at any time.\r
2544 'test-code=s' => \$TestCode,\r
2545\r
2546 'delta=s' => sub {\r
2547 my $arg = $_[1];\r
2548 if ( $arg =~\r
2549 /^([A-Za-z][A-Za-z0-9_\-\]\[]*):([A-Za-z][A-Za-z0-9_\-\]\[]*)$/ ) {\r
2550 $Delta_From = $1;\r
2551 $Delta_To = $2;\r
2552 $Delta_Mode = 1;\r
2553 } else {\r
2554 die "--delta FROM_TAG:TO_TAG is what you meant to say.\n";\r
2555 }\r
2556 },\r
2557\r
2558 'FSF' => sub {\r
2559 $Show_Times = 0;\r
2560 $Common_Dir = 0;\r
2561 $No_Extra_Indent = 1;\r
2562 $Indent = "\t";\r
2563 },\r
2564\r
2565 'header=s' => sub {\r
2566 my $narg = $_[1];\r
2567 $ChangeLog_Header = &slurp_file ($narg);\r
2568 if (! defined ($ChangeLog_Header)) {\r
2569 $ChangeLog_Header = '';\r
2570 }\r
2571 },\r
2572\r
2573 'global-opts|g=s' => sub {\r
2574 my $narg = $_[1];\r
2575 push @Global_Opts, $narg;\r
2576 splice @log_source_command, 1, 0, $narg;\r
2577 },\r
2578\r
2579 'log-opts|l=s' => sub {\r
2580 my $narg = $_[1];\r
2581 push @Local_Opts, $narg;\r
2582 push @log_source_command, $narg;\r
2583 },\r
2584\r
2585 'mailname=s' => sub {\r
2586 my $narg = $_[1];\r
2587 warn "--mailname is deprecated; please use --domain instead\n";\r
2588 $Domain = $narg;\r
2589 },\r
2590\r
2591 'separate-header|S' => sub {\r
2592 $After_Header = "\n\n";\r
2593 $No_Extra_Indent = 1;\r
2594 },\r
2595\r
2596 'group-within-date' => sub {\r
2597 $GroupWithinDate = 1;\r
2598 $Show_Times = 0;\r
2599 },\r
2600\r
2601 'hide-filenames' => sub {\r
2602 $Hide_Filenames = 1;\r
2603 $After_Header = '';\r
2604 },\r
2605 )\r
2606 or die "options parsing failed\n";\r
2607\r
2608 push @log_source_command, map "'$_'", @ARGV;\r
2609\r
2610 ## Check for contradictions...\r
2611\r
2612 if ($Output_To_Stdout && CVS::Utils::ChangeLog::FileEntry->distributed) {\r
2613 print STDERR "cannot pass both --stdout and --distributed\n";\r
2614 $exit_with_admonishment = 1;\r
2615 }\r
2616\r
2617 if ($Output_To_Stdout && $output_file) {\r
2618 print STDERR "cannot pass both --stdout and --file\n";\r
2619 $exit_with_admonishment = 1;\r
2620 }\r
2621\r
2622 if ($Input_From_Stdin && @Global_Opts) {\r
2623 print STDERR "cannot pass both --stdin and -g\n";\r
2624 $exit_with_admonishment = 1;\r
2625 }\r
2626\r
2627 if ($Input_From_Stdin && @Local_Opts) {\r
2628 print STDERR "cannot pass both --stdin and -l\n";\r
2629 $exit_with_admonishment = 1;\r
2630 }\r
2631\r
2632 if ($XML_Output && $Cumulative) {\r
2633 print STDERR "cannot pass both --xml and --accum\n";\r
2634 $exit_with_admonishment = 1;\r
2635 }\r
2636\r
2637 # Other consistency checks and option-driven logic\r
2638\r
2639 # Bleargh. Compensate for a deficiency of custom wrapping.\r
2640 if ( ($After_Header ne " ") and $FSF_Style ) {\r
2641 $After_Header .= "\t";\r
2642 }\r
2643\r
2644 @Ignore_Files = map lc, @Ignore_Files\r
2645 if $Case_Insensitive;\r
2646\r
2647 # Or if any other error message has already been printed out, we\r
2648 # just leave now:\r
2649 if ($exit_with_admonishment) {\r
2650 &usage ();\r
2651 exit (1);\r
2652 }\r
2653 elsif ($Print_Usage) {\r
2654 &usage ();\r
2655 exit (0);\r
2656 }\r
2657 elsif ($Print_Version) {\r
2658 &version ();\r
2659 exit (0);\r
2660 }\r
2661\r
2662 ## Else no problems, so proceed.\r
2663\r
2664 if ($output_file) {\r
2665 $Log_File_Name = $output_file;\r
2666 }\r
2667\r
2668 return \@log_source_command;\r
2669}\r
2670\r
2671# -------------------------------------\r
2672\r
2673sub slurp_file {\r
2674 my $filename = shift || die ("no filename passed to slurp_file()");\r
2675 my $retstr;\r
2676\r
2677 open (SLURPEE, "<${filename}") or die ("unable to open $filename ($!)");\r
2678 local $/ = undef;\r
2679 $retstr = <SLURPEE>;\r
2680 close (SLURPEE);\r
2681 return $retstr;\r
2682}\r
2683\r
2684# -------------------------------------\r
2685\r
2686sub debug {\r
2687 if ($Debug) {\r
2688 my $msg = shift;\r
2689 print STDERR $msg;\r
2690 }\r
2691}\r
2692\r
2693# -------------------------------------\r
2694\r
2695sub version {\r
2696 print "cvs2cl.pl version ${VERSION}; distributed under the GNU GPL.\n";\r
2697}\r
2698\r
2699# -------------------------------------\r
2700\r
2701sub usage {\r
2702 &version ();\r
2703\r
2704 eval "use Pod::Usage qw( pod2usage )";\r
2705\r
2706 if ( $@ ) {\r
2707 print <<'END';\r
2708\r
2709* Pod::Usage was not found. The formatting may be suboptimal. Consider\r
2710 upgrading your Perl --- Pod::Usage is standard from 5.6 onwards, and\r
2711 versions of perl prior to 5.6 are getting rather rusty, now. Alternatively,\r
2712 install Pod::Usage direct from CPAN.\r
2713END\r
2714\r
2715 local $/ = undef;\r
2716 my $message = <DATA>;\r
2717 $message =~ s/^=(head1|item) //gm;\r
2718 $message =~ s/^=(over|back).*\n//gm;\r
2719 $message =~ s/\n{3,}/\n\n/g;\r
2720 print $message;\r
2721 } else {\r
2722 print "\n";\r
2723 pod2usage( -exitval => 'NOEXIT',\r
2724 -verbose => 1,\r
2725 -output => \*STDOUT,\r
2726 );\r
2727 }\r
2728\r
2729 return;\r
2730}\r
2731\r
2732# Main -----------------------------------------------------------------------\r
2733\r
2734my $log_source_command = parse_options;\r
2735if ( defined $TestCode ) {\r
2736 eval $TestCode;\r
2737 die "Eval failed: '$@'\n"\r
2738 if $@;\r
2739} else {\r
2740 derive_changelog($log_source_command);\r
2741}\r
2742\r
2743__DATA__\r
2744\r
2745=head1 NAME\r
2746\r
2747cvs2cl.pl - convert cvs log messages to changelogs\r
2748\r
2749=head1 SYNOPSIS\r
2750\r
2751B<cvs2cl> [I<options>] [I<FILE1> [I<FILE2> ...]]\r
2752\r
2753=head1 DESCRIPTION\r
2754\r
2755cvs2cl produces a GNU-style ChangeLog for CVS-controlled sources by\r
2756running "cvs log" and parsing the output. Duplicate log messages get\r
2757unified in the Right Way.\r
2758\r
2759The default output of cvs2cl is designed to be compact, formally unambiguous,\r
2760but still easy for humans to read. It should be largely self-explanatory; the\r
2761one abbreviation that might not be obvious is "utags". That stands for\r
2762"universal tags" -- a universal tag is one held by all the files in a given\r
2763change entry.\r
2764\r
2765If you need output that's easy for a program to parse, use the B<--xml> option.\r
2766Note that with XML output, just about all available information is included\r
2767with each change entry, whether you asked for it or not, on the theory that\r
2768your parser can ignore anything it's not looking for.\r
2769\r
2770If filenames are given as arguments cvs2cl only shows log information for the\r
2771named files.\r
2772\r
2773=head1 OPTIONS\r
2774\r
2775=over 4\r
2776\r
2777=item B<-h>, B<-help>, B<--help>, B<-?>\r
2778\r
2779Show a short help and exit.\r
2780\r
2781=item B<--version>\r
2782\r
2783Show version and exit.\r
2784\r
2785=item B<-r>, B<--revisions>\r
2786\r
2787Show revision numbers in output.\r
2788\r
2789=item B<-b>, B<--branches>\r
2790\r
2791Show branch names in revisions when possible.\r
2792\r
2793=item B<-t>, B<--tags>\r
2794\r
2795Show tags (symbolic names) in output.\r
2796\r
2797=item B<-T>, B<--tagdates>\r
2798\r
2799Show tags in output on their first occurance.\r
2800\r
2801=item B<--show-dead>\r
2802\r
2803Show dead files.\r
2804\r
2805=item B<--stdin>\r
2806\r
2807Read from stdin, don't run cvs log.\r
2808\r
2809=item B<--stdout>\r
2810\r
2811Output to stdout not to ChangeLog.\r
2812\r
2813=item B<-d>, B<--distributed>\r
2814\r
2815Put ChangeLogs in subdirs.\r
2816\r
2817=item B<-f> I<FILE>, B<--file> I<FILE>\r
2818\r
2819Write to I<FILE> instead of ChangeLog.\r
2820\r
2821=item B<--fsf>\r
2822\r
2823Use this if log data is in FSF ChangeLog style.\r
2824\r
2825=item B<--FSF>\r
2826\r
2827Attempt strict FSF-standard compatible output.\r
2828\r
2829=item B<-W> I<SECS>, B<--window> I<SECS>\r
2830\r
2831Window of time within which log entries unify.\r
2832\r
2833=item -B<U> I<UFILE>, B<--usermap> I<UFILE>\r
2834\r
2835Expand usernames to email addresses from I<UFILE>.\r
2836\r
2837=item B<--passwd> I<PASSWORDFILE>\r
2838\r
2839Use system passwd file for user name expansion. If no mail domain is provided\r
2840(via B<--domain>), it tries to read one from B</etc/mailname>, output of B<hostname\r
2841-d>, B<dnsdomainname>, or B<domain-name>. cvs2cl exits with an error if none of\r
2842those options is successful. Use a domain of '' to prevent the addition of a\r
2843mail domain.\r
2844\r
2845=item B<--domain> I<DOMAIN>\r
2846\r
2847Domain to build email addresses from.\r
2848\r
2849=item B<--gecos>\r
2850\r
2851Get user information from GECOS data.\r
2852\r
2853=item B<-R> I<REGEXP>, B<--regexp> I<REGEXP>\r
2854\r
2855Include only entries that match I<REGEXP>. This option may be used multiple\r
2856times.\r
2857\r
2858=item B<-I> I<REGEXP>, B<--ignore> I<REGEXP>\r
2859\r
2860Ignore files whose names match I<REGEXP>. This option may be used multiple\r
2861times.\r
2862\r
2863=item B<-C>, B<--case-insensitive>\r
2864\r
2865Any regexp matching is done case-insensitively.\r
2866\r
2867=item B<-F> I<BRANCH>, B<--follow> I<BRANCH>\r
2868\r
2869Show only revisions on or ancestral to I<BRANCH>.\r
2870\r
2871=item B<--follow-only> I<BRANCH>\r
2872\r
2873Like --follow, but sub-branches are not followed.\r
2874\r
2875=item B<--no-ancestors>\r
2876\r
2877When using B<-F>, only track changes since the I<BRANCH> started.\r
2878\r
2879=item B<--no-hide-branch-additions>\r
2880\r
2881By default, entries generated by cvs for a file added on a branch (a dead 1.1\r
2882entry) are not shown. This flag reverses that action.\r
2883\r
2884=item B<-S>, B<--separate-header>\r
2885\r
2886Blank line between each header and log message.\r
2887\r
2888=item B<--summary>\r
2889\r
2890Add CVS change summary information.\r
2891\r
2892=item B<--no-wrap>\r
2893\r
2894Don't auto-wrap log message (recommend B<-S> also).\r
2895\r
2896=item B<--no-indent>\r
2897\r
2898Don't indent log message\r
2899\r
2900=item B<--gmt>, B<--utc>\r
2901\r
2902Show times in GMT/UTC instead of local time.\r
2903\r
2904=item B<--accum>\r
2905\r
2906Add to an existing ChangeLog (incompatible with B<--xml>).\r
2907\r
2908=item B<-w>, B<--day-of-week>\r
2909\r
2910Show day of week.\r
2911\r
2912=item B<--no-times>\r
2913\r
2914Don't show times in output.\r
2915\r
2916=item B<--chrono>\r
2917\r
2918Output log in chronological order (default is reverse chronological order).\r
2919\r
2920=item B<--header> I<FILE>\r
2921\r
2922Get ChangeLog header from I<FILE> ("B<->" means stdin).\r
2923\r
2924=item B<--xml>\r
2925\r
2926Output XML instead of ChangeLog format.\r
2927\r
2928=item B<--xml-encoding> I<ENCODING.>\r
2929\r
2930Insert encoding clause in XML header.\r
2931\r
2932=item B<--noxmlns>\r
2933\r
2934Don't include xmlns= attribute in root element.\r
2935\r
2936=item B<--hide-filenames>\r
2937\r
2938Don't show filenames (ignored for XML output).\r
2939\r
2940=item B<--no-common-dir>\r
2941\r
2942Don't shorten directory names from filenames.\r
2943\r
2944=item B<--rcs> I<CVSROOT>\r
2945\r
2946Handle filenames from raw RCS, for instance those produced by "cvs rlog"\r
2947output, stripping the prefix I<CVSROOT>.\r
2948\r
2949=item B<-P>, B<--prune>\r
2950\r
2951Don't show empty log messages.\r
2952\r
2953=item B<--lines-modified>\r
2954\r
2955Output the number of lines added and the number of lines removed for\r
2956each checkin (if applicable). At the moment, this only affects the\r
2957XML output mode.\r
2958\r
2959=item B<--ignore-tag> I<TAG>\r
2960\r
2961Ignore individual changes that are associated with a given tag.\r
2962May be repeated, if so, changes that are associated with any of\r
2963the given tags are ignored.\r
2964\r
2965=item B<--show-tag> I<TAG>\r
2966\r
2967Log only individual changes that are associated with a given\r
2968tag. May be repeated, if so, changes that are associated with\r
2969any of the given tags are logged.\r
2970\r
2971=item B<--delta> I<FROM_TAG>B<:>I<TO_TAG>\r
2972\r
2973Attempt a delta between two tags (since I<FROM_TAG> up to and\r
2974including I<TO_TAG>). The algorithm is a simple date-based one\r
2975(this is a hard problem) so results are imperfect.\r
2976\r
2977=item B<-g> I<OPTS>, B<--global-opts> I<OPTS>\r
2978\r
2979Pass I<OPTS> to cvs like in "cvs I<OPTS> log ...".\r
2980\r
2981=item B<-l> I<OPTS>, B<--log-opts> I<OPTS>\r
2982\r
2983Pass I<OPTS> to cvs log like in "cvs ... log I<OPTS>".\r
2984\r
2985=back\r
2986\r
2987Notes about the options and arguments:\r
2988\r
2989=over 4\r
2990\r
2991=item *\r
2992\r
2993The B<-I> and B<-F> options may appear multiple times.\r
2994\r
2995=item *\r
2996\r
2997To follow trunk revisions, use "B<-F trunk>" ("B<-F TRUNK>" also works). This is\r
2998okay because no would ever, ever be crazy enough to name a branch "trunk",\r
2999right? Right.\r
3000\r
3001=item *\r
3002\r
3003For the B<-U> option, the I<UFILE> should be formatted like CVSROOT/users. That is,\r
3004each line of I<UFILE> looks like this:\r
3005\r
3006 jrandom:jrandom@red-bean.com\r
3007\r
3008or maybe even like this\r
3009\r
3010 jrandom:'Jesse Q. Random <jrandom@red-bean.com>'\r
3011\r
3012Don't forget to quote the portion after the colon if necessary.\r
3013\r
3014=item *\r
3015\r
3016Many people want to filter by date. To do so, invoke cvs2cl.pl like this:\r
3017\r
3018 cvs2cl.pl -l "-d'DATESPEC'"\r
3019\r
3020where DATESPEC is any date specification valid for "cvs log -d". (Note that\r
3021CVS 1.10.7 and below requires there be no space between -d and its argument).\r
3022\r
3023=item *\r
3024\r
3025Dates/times are interpreted in the local time zone.\r
3026\r
3027=item *\r
3028\r
3029Remember to quote the argument to `B<-l>' so that your shell doesn't interpret\r
3030spaces as argument separators.\r
3031\r
3032=item *\r
3033\r
3034See the 'Common Options' section of the cvs manual ('info cvs' on UNIX-like\r
3035systems) for more information.\r
3036\r
3037=item *\r
3038\r
3039Note that the rules for quoting under windows shells are different.\r
3040\r
3041=back\r
3042\r
3043=head1 EXAMPLES\r
3044\r
3045Some examples (working on UNIX shells):\r
3046\r
3047 # logs after 6th March, 2003 (inclusive)\r
3048 cvs2cl.pl -l "-d'>2003-03-06'"\r
3049 # logs after 4:34PM 6th March, 2003 (inclusive)\r
3050 cvs2cl.pl -l "-d'>2003-03-06 16:34'"\r
3051 # logs between 4:46PM 6th March, 2003 (exclusive) and\r
3052 # 4:34PM 6th March, 2003 (inclusive)\r
3053 cvs2cl.pl -l "-d'2003-03-06 16:46>2003-03-06 16:34'"\r
3054\r
3055Some examples (on non-UNIX shells):\r
3056\r
3057 # Reported to work on windows xp/2000\r
3058 cvs2cl.pl -l "-d"">2003-10-18;today<"""\r
3059\r
3060=head1 AUTHORS\r
3061\r
3062=over 4\r
3063\r
3064=item Karl Fogel\r
3065\r
3066=item Melissa O'Neill\r
3067\r
3068=item Martyn J. Pearce\r
3069\r
3070=back\r
3071\r
3072Contributions from\r
3073\r
3074=over 4\r
3075\r
3076=item Mike Ayers\r
3077\r
3078=item Tim Bradshaw\r
3079\r
3080=item Richard Broberg\r
3081\r
3082=item Nathan Bryant\r
3083\r
3084=item Oswald Buddenhagen\r
3085\r
3086=item Neil Conway\r
3087\r
3088=item Arthur de Jong\r
3089\r
3090=item Mark W. Eichin\r
3091\r
3092=item Dave Elcock\r
3093\r
3094=item Reid Ellis\r
3095\r
3096=item Simon Josefsson\r
3097\r
3098=item Robin Hugh Johnson\r
3099\r
3100=item Terry Kane\r
3101\r
3102=item Akos Kiss\r
3103\r
3104=item Claus Klein\r
3105\r
3106=item Eddie Kohler\r
3107\r
3108=item Richard Laager\r
3109\r
3110=item Kevin Lilly\r
3111\r
3112=item Karl-Heinz Marbaise\r
3113\r
3114=item Mitsuaki Masuhara\r
3115\r
3116=item Henrik Nordstrom\r
3117\r
3118=item Joe Orton\r
3119\r
3120=item Peter Palfrader\r
3121\r
3122=item Thomas Parmelan\r
3123\r
3124=item Johanne Stezenbach\r
3125\r
3126=item Joseph Walton\r
3127\r
3128=item Ernie Zapata\r
3129\r
3130=back\r
3131\r
3132=head1 BUGS\r
3133\r
3134Please report bugs to C<bug-cvs2cl@red-bean.com>.\r
3135\r
3136=head1 PREREQUISITES\r
3137\r
3138This script requires C<Text::Wrap>, C<Time::Local>, and C<File::Basename>. It\r
3139also seems to require C<Perl 5.004_04> or higher.\r
3140\r
3141=head1 OPERATING SYSTEM COMPATIBILITY\r
3142\r
3143Should work on any OS.\r
3144\r
3145=head1 SCRIPT CATEGORIES\r
3146\r
3147Version_Control/CVS\r
3148\r
3149=head1 COPYRIGHT\r
3150\r
3151(C) 2001,2002,2003,2004 Martyn J. Pearce <fluffy@cpan.org>, under the GNU GPL.\r
3152\r
3153(C) 1999 Karl Fogel <kfogel@red-bean.com>, under the GNU GPL.\r
3154\r
3155cvs2cl.pl is free software; you can redistribute it and/or modify\r
3156it under the terms of the GNU General Public License as published by\r
3157the Free Software Foundation; either version 2, or (at your option)\r
3158any later version.\r
3159\r
3160cvs2cl.pl is distributed in the hope that it will be useful,\r
3161but WITHOUT ANY WARRANTY; without even the implied warranty of\r
3162MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\r
3163GNU General Public License for more details.\r
3164\r
3165You may have received a copy of the GNU General Public License\r
3166along with cvs2cl.pl; see the file COPYING. If not, write to the\r
3167Free Software Foundation, Inc., 59 Temple Place - Suite 330,\r
3168Boston, MA 02111-1307, USA.\r
3169\r
3170=head1 SEE ALSO\r
3171\r
3172cvs(1)\r
3173\r
3174\r