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