HinzugefĆ¼gt:
[ipfire-2.x.git] / tools / cvs2cl.pl
1 #!/bin/sh\r
2 exec 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
17 use strict;\r
18 \r
19 use File::Basename qw( fileparse );\r
20 use Getopt::Long   qw( GetOptions );\r
21 use Text::Wrap     qw( );\r
22 use 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
145 my $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
151 my $Debug = 0;\r
152 \r
153 # Just show version and exit?\r
154 my $Print_Version = 0;\r
155 \r
156 # Just print usage message and exit?\r
157 my $Print_Usage = 0;\r
158 \r
159 # What file should we generate (defaults to "ChangeLog")?\r
160 my $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
164 my $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
173 my $Update = 0;\r
174 \r
175 # Expand usernames to email addresses based on a map file?\r
176 my $User_Map_File = '';\r
177 my $User_Passwd_File;\r
178 my $Mail_Domain;\r
179 \r
180 # Output log in chronological order? [default is reverse chronological order]\r
181 my $Chronological_Order = 0;\r
182 \r
183 # Grab user details via gecos\r
184 my $Gecos = 0;\r
185 \r
186 # User domain for gecos email addresses\r
187 my $Domain;\r
188 \r
189 # Output to a file or to stdout?\r
190 my $Output_To_Stdout = 0;\r
191 \r
192 # Eliminate empty log messages?\r
193 my $Prune_Empty_Msgs = 0;\r
194 \r
195 # Tags of which not to output\r
196 my %ignore_tags;\r
197 \r
198 # Show only revisions with Tags\r
199 my %show_tags;\r
200 \r
201 # Don't call Text::Wrap on the body of the message\r
202 my $No_Wrap = 0;\r
203 \r
204 # Indentation of log messages\r
205 my $Indent = "\t";\r
206 \r
207 # Don't do any pretty print processing\r
208 my $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
213 my $After_Header = " ";\r
214 \r
215 # XML Encoding\r
216 my $XML_Encoding = '';\r
217 \r
218 # Format more for programs than for humans.\r
219 my $XML_Output = 0;\r
220 my $No_XML_Namespace = 0;\r
221 my $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
225 my $FSF_Style = 0;\r
226 \r
227 # Show times in UTC instead of local time\r
228 my $UTC_Times = 0;\r
229 \r
230 # Show times in output?\r
231 my $Show_Times = 1;\r
232 \r
233 # Show day of week in output?\r
234 my $Show_Day_Of_Week = 0;\r
235 \r
236 # Show revision numbers in output?\r
237 my $Show_Revisions = 0;\r
238 \r
239 # Show dead files in output?\r
240 my $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
244 my $Hide_Branch_Additions = 1;\r
245 \r
246 # Show tags (symbolic names) in output?\r
247 my $Show_Tags = 0;\r
248 \r
249 # Show tags separately in output?\r
250 my $Show_Tag_Dates = 0;\r
251 \r
252 # Show branches by symbolic name in output?\r
253 my $Show_Branches = 0;\r
254 \r
255 # Show only revisions on these branches or their ancestors.\r
256 my @Follow_Branches;\r
257 # Show only revisions on these branches or their ancestors; ignore descendent\r
258 # branches.\r
259 my @Follow_Only;\r
260 \r
261 # Don't bother with files matching this regexp.\r
262 my @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
266 my $Case_Insensitive = 0;\r
267 \r
268 # Maybe only show log messages matching a certain regular expression.\r
269 my $Regexp_Gate = '';\r
270 \r
271 # Pass this global option string along to cvs, to the left of `log':\r
272 my $Global_Opts = '';\r
273 \r
274 # Pass this option string along to the cvs log subcommand:\r
275 my $Command_Opts = '';\r
276 \r
277 # Read log output from stdin instead of invoking cvs log?\r
278 my $Input_From_Stdin = 0;\r
279 \r
280 # Don't show filenames in output.\r
281 my $Hide_Filenames = 0;\r
282 \r
283 # Don't shorten directory names from filenames.\r
284 my $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
291 my $Max_Checkin_Duration = 180;\r
292 \r
293 # What to put at the front of [each] ChangeLog.\r
294 my $ChangeLog_Header = '';\r
295 \r
296 # Whether to enable 'delta' mode, and for what start/end tags.\r
297 my $Delta_Mode = 0;\r
298 my $Delta_From = '';\r
299 my $Delta_To = '';\r
300 \r
301 my $TestCode;\r
302 \r
303 # Whether to parse filenames from the RCS filename, and if so what\r
304 # prefix to strip.\r
305 my $RCS_Root;\r
306 \r
307 # Whether to output information on the # of lines added and removed\r
308 # by each file modification.\r
309 my $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
314 my $Delta_StartTime = 0;\r
315 my $Delta_EndTime = 0;\r
316 \r
317 my $No_Ancestors = 0;\r
318 \r
319 my $No_Extra_Indent = 0;\r
320 \r
321 my $GroupWithinDate = 0;\r
322 \r
323 # ----------------------------------------------------------------------------\r
324 \r
325 package CVS::Utils::ChangeLog::EntrySet;\r
326 \r
327 sub new {\r
328   my $class = shift;\r
329   my %self;\r
330   bless \%self, $class;\r
331 }\r
332 \r
333 # -------------------------------------\r
334 \r
335 sub 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
348 sub 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
386 package CVS::Utils::ChangeLog::EntrySet::Output::Text;\r
387 \r
388 use base qw( CVS::Utils::ChangeLog::EntrySet::Output );\r
389 \r
390 use File::Basename qw( fileparse );\r
391 \r
392 sub new {\r
393   my $class = shift;\r
394   my $self = $class->SUPER::new(@_);\r
395 }\r
396 \r
397 # -------------------------------------\r
398 \r
399 sub 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
408 sub 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
437 sub 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
463 sub 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
629 sub 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
640 sub 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
768 package CVS::Utils::ChangeLog::EntrySet::Output::XML;\r
769 \r
770 use base qw( CVS::Utils::ChangeLog::EntrySet::Output );\r
771 \r
772 use File::Basename qw( fileparse );\r
773 \r
774 sub new {\r
775   my $class = shift;\r
776   my $self = $class->SUPER::new(@_);\r
777 }\r
778 \r
779 # -------------------------------------\r
780 \r
781 sub 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
811 sub 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
820 sub 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
832 sub 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
850 sub 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
859 sub 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
876 sub 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
958 sub output_tagdate {\r
959   # NOT YET DONE\r
960 }\r
961 \r
962 # -------------------------------------\r
963 \r
964 sub 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
972 sub 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
982 package CVS::Utils::ChangeLog::EntrySet::Output;\r
983 \r
984 use Carp           qw( croak );\r
985 use File::Basename qw( fileparse );\r
986 \r
987 # Class Utility Functions -------------\r
988 \r
989 { # form closure\r
990 \r
991 my @weekdays = (qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday));\r
992 sub 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
1001 sub 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
1021 sub wday               { croak "Whoops.  Abtract method call (wday).\n" }\r
1022 sub pretty_file_list   { croak "Whoops.  Abtract method call (pretty_file_list).\n" }\r
1023 sub output_tagdate     { croak "Whoops.  Abtract method call (output_tagdate).\n" }\r
1024 sub header_line        { croak "Whoops.  Abtract method call (header_line).\n" }\r
1025 \r
1026 # Instance Subrs ----------------------\r
1027 \r
1028 sub output_header { }\r
1029 \r
1030 # -------------------------------------\r
1031 \r
1032 sub 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
1040 sub output_footer { }\r
1041 \r
1042 # -------------------------------------\r
1043 \r
1044 sub escape { return $_[1] }\r
1045 \r
1046 # -------------------------------------\r
1047 \r
1048 sub _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
1124 sub output_changelog {\r
1125 my $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
1339 sub 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
1360 sub 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
1374 sub 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
1387 sub 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
1570 sub _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
1663 sub 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
1692 sub 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
1714 sub 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
1731 package CVS::Utils::ChangeLog::Message;\r
1732 \r
1733 sub 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
1742 sub 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
1752 sub files { wantarray ? @{$_[0]->{files}} : $_[0]->{files} }\r
1753 \r
1754 # ----------------------------------------------------------------------------\r
1755 \r
1756 package CVS::Utils::ChangeLog::FileEntry;\r
1757 \r
1758 use 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
1787 my $distributed;\r
1788 sub distributed { $#_ ? ($distributed = $_[1]) : $distributed; }\r
1789 \r
1790 sub 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
1837 sub filename       { $_[0]->{filename}       }\r
1838 sub dir_key        { $_[0]->{dir_key}        }\r
1839 sub revision       { $_[0]->{revision}       }\r
1840 sub branch         { $_[0]->{branch}         }\r
1841 sub state          { $_[0]->{state}          }\r
1842 sub lines          { $_[0]->{lines}          }\r
1843 sub roots          { $_[0]->{roots}          }\r
1844 sub branch_numbers { $_[0]->{branch_numbers} }\r
1845 \r
1846 sub tags        { $_[0]->{tags}     }\r
1847 sub 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
1855 sub time     { $_[0]->{time}     }\r
1856 \r
1857 # ----------------------------------------------------------------------------\r
1858 \r
1859 package CVS::Utils::ChangeLog::EntrySetBuilder;\r
1860 \r
1861 use File::Basename qw( fileparse );\r
1862 use Time::Local    qw( timegm );\r
1863 \r
1864 use constant MAILNAME => "/etc/mailname";\r
1865 \r
1866 # In 'cvs log' output, one long unbroken line of equal signs separates files:\r
1867 use 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
1870 use constant REV_SEPARATOR  => '-' x 28;# . "\n";\r
1871 \r
1872 use constant EMPTY_LOG_MESSAGE => '*** empty log message ***';\r
1873 \r
1874 # -------------------------------------\r
1875 \r
1876 sub 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
1890 sub 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
1907 sub 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
1921 sub grand_poobah { $_[0]->{grand_poobah} }\r
1922 \r
1923 # -------------------------------------\r
1924 \r
1925 sub 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
1999 sub 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
2010 sub 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
2109 sub 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
2141 sub 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
2186 sub 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
2201 my %gecos_warned;\r
2202 sub 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
2241 sub 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
2285 sub 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
2318 package main;\r
2319 \r
2320 sub 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
2336 sub 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
2350 sub 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
2393 sub 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
2417 sub min { $_[0] < $_[1] ? $_[0] : $_[1] }\r
2418 \r
2419 # -------------------------------------\r
2420 \r
2421 sub 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
2459 sub 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
2673 sub 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
2686 sub 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
2695 sub version {\r
2696   print "cvs2cl.pl version ${VERSION}; distributed under the GNU GPL.\n";\r
2697 }\r
2698 \r
2699 # -------------------------------------\r
2700 \r
2701 sub 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
2713 END\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
2734 my $log_source_command = parse_options;\r
2735 if ( 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
2747 cvs2cl.pl - convert cvs log messages to changelogs\r
2748 \r
2749 =head1 SYNOPSIS\r
2750 \r
2751 B<cvs2cl> [I<options>] [I<FILE1> [I<FILE2> ...]]\r
2752 \r
2753 =head1 DESCRIPTION\r
2754 \r
2755 cvs2cl produces a GNU-style ChangeLog for CVS-controlled sources by\r
2756 running "cvs log" and parsing the output. Duplicate log messages get\r
2757 unified in the Right Way.\r
2758 \r
2759 The default output of cvs2cl is designed to be compact, formally unambiguous,\r
2760 but still easy for humans to read.  It should be largely self-explanatory; the\r
2761 one 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
2763 change entry.\r
2764 \r
2765 If you need output that's easy for a program to parse, use the B<--xml> option.\r
2766 Note that with XML output, just about all available information is included\r
2767 with each change entry, whether you asked for it or not, on the theory that\r
2768 your parser can ignore anything it's not looking for.\r
2769 \r
2770 If filenames are given as arguments cvs2cl only shows log information for the\r
2771 named 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
2779 Show a short help and exit.\r
2780 \r
2781 =item B<--version>\r
2782 \r
2783 Show version and exit.\r
2784 \r
2785 =item B<-r>, B<--revisions>\r
2786 \r
2787 Show revision numbers in output.\r
2788 \r
2789 =item B<-b>, B<--branches>\r
2790 \r
2791 Show branch names in revisions when possible.\r
2792 \r
2793 =item B<-t>, B<--tags>\r
2794 \r
2795 Show tags (symbolic names) in output.\r
2796 \r
2797 =item B<-T>, B<--tagdates>\r
2798 \r
2799 Show tags in output on their first occurance.\r
2800 \r
2801 =item B<--show-dead>\r
2802 \r
2803 Show dead files.\r
2804 \r
2805 =item B<--stdin>\r
2806 \r
2807 Read from stdin, don't run cvs log.\r
2808 \r
2809 =item B<--stdout>\r
2810 \r
2811 Output to stdout not to ChangeLog.\r
2812 \r
2813 =item B<-d>, B<--distributed>\r
2814 \r
2815 Put ChangeLogs in subdirs.\r
2816 \r
2817 =item B<-f> I<FILE>, B<--file> I<FILE>\r
2818 \r
2819 Write to I<FILE> instead of ChangeLog.\r
2820 \r
2821 =item B<--fsf>\r
2822 \r
2823 Use this if log data is in FSF ChangeLog style.\r
2824 \r
2825 =item B<--FSF>\r
2826 \r
2827 Attempt strict FSF-standard compatible output.\r
2828 \r
2829 =item B<-W> I<SECS>, B<--window> I<SECS>\r
2830 \r
2831 Window of time within which log entries unify.\r
2832 \r
2833 =item -B<U> I<UFILE>, B<--usermap> I<UFILE>\r
2834 \r
2835 Expand usernames to email addresses from I<UFILE>.\r
2836 \r
2837 =item B<--passwd> I<PASSWORDFILE>\r
2838 \r
2839 Use 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
2842 those options is successful. Use a domain of '' to prevent the addition of a\r
2843 mail domain.\r
2844 \r
2845 =item B<--domain> I<DOMAIN>\r
2846 \r
2847 Domain to build email addresses from.\r
2848 \r
2849 =item B<--gecos>\r
2850 \r
2851 Get user information from GECOS data.\r
2852 \r
2853 =item B<-R> I<REGEXP>, B<--regexp> I<REGEXP>\r
2854 \r
2855 Include only entries that match I<REGEXP>.  This option may be used multiple\r
2856 times.\r
2857 \r
2858 =item B<-I> I<REGEXP>, B<--ignore> I<REGEXP>\r
2859 \r
2860 Ignore files whose names match I<REGEXP>.  This option may be used multiple\r
2861 times.\r
2862 \r
2863 =item B<-C>, B<--case-insensitive>\r
2864 \r
2865 Any regexp matching is done case-insensitively.\r
2866 \r
2867 =item B<-F> I<BRANCH>, B<--follow> I<BRANCH>\r
2868 \r
2869 Show only revisions on or ancestral to I<BRANCH>.\r
2870 \r
2871 =item B<--follow-only> I<BRANCH>\r
2872 \r
2873 Like --follow, but sub-branches are not followed.\r
2874 \r
2875 =item B<--no-ancestors>\r
2876 \r
2877 When using B<-F>, only track changes since the I<BRANCH> started.\r
2878 \r
2879 =item B<--no-hide-branch-additions>\r
2880 \r
2881 By default, entries generated by cvs for a file added on a branch (a dead 1.1\r
2882 entry) are not shown.  This flag reverses that action.\r
2883 \r
2884 =item B<-S>, B<--separate-header>\r
2885 \r
2886 Blank line between each header and log message.\r
2887 \r
2888 =item B<--summary>\r
2889 \r
2890 Add CVS change summary information.\r
2891 \r
2892 =item B<--no-wrap>\r
2893 \r
2894 Don't auto-wrap log message (recommend B<-S> also).\r
2895 \r
2896 =item B<--no-indent>\r
2897 \r
2898 Don't indent log message\r
2899 \r
2900 =item B<--gmt>, B<--utc>\r
2901 \r
2902 Show times in GMT/UTC instead of local time.\r
2903 \r
2904 =item B<--accum>\r
2905 \r
2906 Add to an existing ChangeLog (incompatible with B<--xml>).\r
2907 \r
2908 =item B<-w>, B<--day-of-week>\r
2909 \r
2910 Show day of week.\r
2911 \r
2912 =item B<--no-times>\r
2913 \r
2914 Don't show times in output.\r
2915 \r
2916 =item B<--chrono>\r
2917 \r
2918 Output log in chronological order (default is reverse chronological order).\r
2919 \r
2920 =item B<--header> I<FILE>\r
2921 \r
2922 Get ChangeLog header from I<FILE> ("B<->" means stdin).\r
2923 \r
2924 =item B<--xml>\r
2925 \r
2926 Output XML instead of ChangeLog format.\r
2927 \r
2928 =item B<--xml-encoding> I<ENCODING.>\r
2929 \r
2930 Insert encoding clause in XML header.\r
2931 \r
2932 =item B<--noxmlns>\r
2933 \r
2934 Don't include xmlns= attribute in root element.\r
2935 \r
2936 =item B<--hide-filenames>\r
2937 \r
2938 Don't show filenames (ignored for XML output).\r
2939 \r
2940 =item B<--no-common-dir>\r
2941 \r
2942 Don't shorten directory names from filenames.\r
2943 \r
2944 =item B<--rcs> I<CVSROOT>\r
2945 \r
2946 Handle filenames from raw RCS, for instance those produced by "cvs rlog"\r
2947 output, stripping the prefix I<CVSROOT>.\r
2948 \r
2949 =item B<-P>, B<--prune>\r
2950 \r
2951 Don't show empty log messages.\r
2952 \r
2953 =item B<--lines-modified>\r
2954 \r
2955 Output the number of lines added and the number of lines removed for\r
2956 each checkin (if applicable). At the moment, this only affects the\r
2957 XML output mode.\r
2958 \r
2959 =item B<--ignore-tag> I<TAG>\r
2960 \r
2961 Ignore individual changes that are associated with a given tag.\r
2962 May be repeated, if so, changes that are associated with any of\r
2963 the given tags are ignored.\r
2964 \r
2965 =item B<--show-tag> I<TAG>\r
2966 \r
2967 Log only individual changes that are associated with a given\r
2968 tag.  May be repeated, if so, changes that are associated with\r
2969 any of the given tags are logged.\r
2970 \r
2971 =item B<--delta> I<FROM_TAG>B<:>I<TO_TAG>\r
2972 \r
2973 Attempt a delta between two tags (since I<FROM_TAG> up to and\r
2974 including 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
2979 Pass 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
2983 Pass I<OPTS> to cvs log like in "cvs ... log I<OPTS>".\r
2984 \r
2985 =back\r
2986 \r
2987 Notes about the options and arguments:\r
2988 \r
2989 =over 4\r
2990 \r
2991 =item *\r
2992 \r
2993 The B<-I> and B<-F> options may appear multiple times.\r
2994 \r
2995 =item *\r
2996 \r
2997 To follow trunk revisions, use "B<-F trunk>" ("B<-F TRUNK>" also works).  This is\r
2998 okay because no would ever, ever be crazy enough to name a branch "trunk",\r
2999 right?  Right.\r
3000 \r
3001 =item *\r
3002 \r
3003 For the B<-U> option, the I<UFILE> should be formatted like CVSROOT/users. That is,\r
3004 each line of I<UFILE> looks like this:\r
3005 \r
3006        jrandom:jrandom@red-bean.com\r
3007 \r
3008 or maybe even like this\r
3009 \r
3010        jrandom:'Jesse Q. Random <jrandom@red-bean.com>'\r
3011 \r
3012 Don't forget to quote the portion after the colon if necessary.\r
3013 \r
3014 =item *\r
3015 \r
3016 Many 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
3020 where DATESPEC is any date specification valid for "cvs log -d".  (Note that\r
3021 CVS 1.10.7 and below requires there be no space between -d and its argument).\r
3022 \r
3023 =item *\r
3024 \r
3025 Dates/times are interpreted in the local time zone.\r
3026 \r
3027 =item *\r
3028 \r
3029 Remember to quote the argument to `B<-l>' so that your shell doesn't interpret\r
3030 spaces as argument separators.\r
3031 \r
3032 =item *\r
3033 \r
3034 See the 'Common Options' section of the cvs manual ('info cvs' on UNIX-like\r
3035 systems) for more information.\r
3036 \r
3037 =item *\r
3038 \r
3039 Note that the rules for quoting under windows shells are different.\r
3040 \r
3041 =back\r
3042 \r
3043 =head1 EXAMPLES\r
3044 \r
3045 Some 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
3055 Some 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
3072 Contributions 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
3134 Please report bugs to C<bug-cvs2cl@red-bean.com>.\r
3135 \r
3136 =head1 PREREQUISITES\r
3137 \r
3138 This script requires C<Text::Wrap>, C<Time::Local>, and C<File::Basename>.  It\r
3139 also seems to require C<Perl 5.004_04> or higher.\r
3140 \r
3141 =head1 OPERATING SYSTEM COMPATIBILITY\r
3142 \r
3143 Should work on any OS.\r
3144 \r
3145 =head1 SCRIPT CATEGORIES\r
3146 \r
3147 Version_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
3155 cvs2cl.pl is free software; you can redistribute it and/or modify\r
3156 it under the terms of the GNU General Public License as published by\r
3157 the Free Software Foundation; either version 2, or (at your option)\r
3158 any later version.\r
3159 \r
3160 cvs2cl.pl is distributed in the hope that it will be useful,\r
3161 but WITHOUT ANY WARRANTY; without even the implied warranty of\r
3162 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\r
3163 GNU General Public License for more details.\r
3164 \r
3165 You may have received a copy of the GNU General Public License\r
3166 along with cvs2cl.pl; see the file COPYING.  If not, write to the\r
3167 Free Software Foundation, Inc., 59 Temple Place - Suite 330,\r
3168 Boston, MA 02111-1307, USA.\r
3169 \r
3170 =head1 SEE ALSO\r
3171 \r
3172 cvs(1)\r
3173 \r
3174 \r