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