-#!/bin/sh\r
-exec perl -w -x $0 ${1+"$@"} # -*- mode: perl; perl-indent-level: 2; -*-\r
-#!perl -w\r
-\r
-\r
-##############################################################\r
-### ###\r
-### cvs2cl.pl: produce ChangeLog(s) from `cvs log` output. ###\r
-### ###\r
-##############################################################\r
-\r
-## $Revision: 1.1.2.1 $\r
-## $Date: 2004/08/12 23:40:08 $\r
-## $Author: gespinasse $\r
-##\r
-\r
-use strict;\r
-\r
-use File::Basename qw( fileparse );\r
-use Getopt::Long qw( GetOptions );\r
-use Text::Wrap qw( );\r
-use User::pwent qw( getpwnam );\r
-\r
-# The Plan:\r
-#\r
-# Read in the logs for multiple files, spit out a nice ChangeLog that\r
-# mirrors the information entered during `cvs commit'.\r
-#\r
-# The problem presents some challenges. In an ideal world, we could\r
-# detect files with the same author, log message, and checkin time --\r
-# each <filelist, author, time, logmessage> would be a changelog entry.\r
-# We'd sort them; and spit them out. Unfortunately, CVS is *not atomic*\r
-# so checkins can span a range of times. Also, the directory structure\r
-# could be hierarchical.\r
-#\r
-# Another question is whether we really want to have the ChangeLog\r
-# exactly reflect commits. An author could issue two related commits,\r
-# with different log entries, reflecting a single logical change to the\r
-# source. GNU style ChangeLogs group these under a single author/date.\r
-# We try to do the same.\r
-#\r
-# So, we parse the output of `cvs log', storing log messages in a\r
-# multilevel hash that stores the mapping:\r
-# directory => author => time => message => filelist\r
-# As we go, we notice "nearby" commit times and store them together\r
-# (i.e., under the same timestamp), so they appear in the same log\r
-# entry.\r
-#\r
-# When we've read all the logs, we twist this mapping into\r
-# a time => author => message => filelist mapping for each directory.\r
-#\r
-# If we're not using the `--distributed' flag, the directory is always\r
-# considered to be `./', even as descend into subdirectories.\r
-\r
-# Call Tree\r
-\r
-# name number of lines (10.xii.03)\r
-# parse_options 192\r
-# derive_changelog 13\r
-# +-maybe_grab_accumulation_date 38\r
-# +-read_changelog 277\r
-# +-maybe_read_user_map_file 94\r
-# +-run_ext 9\r
-# +-read_file_path 29\r
-# +-read_symbolic_name 43\r
-# +-read_revision 49\r
-# +-read_date_author_and_state 25\r
-# +-parse_date_author_and_state 20\r
-# +-read_branches 36\r
-# +-output_changelog 424\r
-# +-pretty_file_list 290\r
-# +-common_path_prefix 35\r
-# +-preprocess_msg_text 30\r
-# +-min 1\r
-# +-mywrap 16\r
-# +-last_line_len 5\r
-# +-wrap_log_entry 177\r
-#\r
-# Utilities\r
-#\r
-# xml_escape 6\r
-# slurp_file 11\r
-# debug 5\r
-# version 2\r
-# usage 142\r
-\r
-# -*- -*- -*- -*- -*- -*- -*- -*- -*- -*- -*- -*- -*- -*- -*- -*- -*- -*-\r
-#\r
-# Note about a bug-slash-opportunity:\r
-# -----------------------------------\r
-#\r
-# There's a bug in Text::Wrap, which affects cvs2cl. This script\r
-# reveals it:\r
-#\r
-# #!/usr/bin/perl -w\r
-#\r
-# use Text::Wrap;\r
-#\r
-# my $test_text =\r
-# "This script demonstrates a bug in Text::Wrap. The very long line\r
-# following this paragraph will be relocated relative to the surrounding\r
-# text:\r
-#\r
-# ====================================================================\r
-#\r
-# See? When the bug happens, we'll get the line of equal signs below\r
-# this paragraph, even though it should be above.";\r
-#\r
-#\r
-# # Print out the test text with no wrapping:\r
-# print "$test_text";\r
-# print "\n";\r
-# print "\n";\r
-#\r
-# # Now print it out wrapped, and see the bug:\r
-# print wrap ("\t", " ", "$test_text");\r
-# print "\n";\r
-# print "\n";\r
-#\r
-# If the line of equal signs were one shorter, then the bug doesn't\r
-# happen. Interesting.\r
-#\r
-# Anyway, rather than fix this in Text::Wrap, we might as well write a\r
-# new wrap() which has the following much-needed features:\r
-#\r
-# * initial indentation, like current Text::Wrap()\r
-# * subsequent line indentation, like current Text::Wrap()\r
-# * user chooses among: force-break long words, leave them alone, or die()?\r
-# * preserve existing indentation: chopped chunks from an indented line\r
-# are indented by same (like this line, not counting the asterisk!)\r
-# * optional list of things to preserve on line starts, default ">"\r
-#\r
-# Note that the last two are essentially the same concept, so unify in\r
-# implementation and give a good interface to controlling them.\r
-#\r
-# And how about:\r
-#\r
-# Optionally, when encounter a line pre-indented by same as previous\r
-# line, then strip the newline and refill, but indent by the same.\r
-# Yeah...\r
-\r
-# Globals --------------------------------------------------------------------\r
-\r
-# In case we have to print it out:\r
-my $VERSION = '$Revision: 1.1.2.1 $';\r
-$VERSION =~ s/\S+\s+(\S+)\s+\S+/$1/;\r
-\r
-## Vars set by options:\r
-\r
-# Print debugging messages?\r
-my $Debug = 0;\r
-\r
-# Just show version and exit?\r
-my $Print_Version = 0;\r
-\r
-# Just print usage message and exit?\r
-my $Print_Usage = 0;\r
-\r
-# What file should we generate (defaults to "ChangeLog")?\r
-my $Log_File_Name = "ChangeLog";\r
-\r
-# Grab most recent entry date from existing ChangeLog file, just add\r
-# to that ChangeLog.\r
-my $Cumulative = 0;\r
-\r
-# `cvs log -d`, this will repeat the last entry in the old log. This is OK,\r
-# as it guarantees at least one entry in the update changelog, which means\r
-# that there will always be a date to extract for the next update. The repeat\r
-# entry can be removed in postprocessing, if necessary.\r
-\r
-# MJP 2003-08-02\r
-# I don't think this actually does anything useful\r
-my $Update = 0;\r
-\r
-# Expand usernames to email addresses based on a map file?\r
-my $User_Map_File = '';\r
-my $User_Passwd_File;\r
-my $Mail_Domain;\r
-\r
-# Output log in chronological order? [default is reverse chronological order]\r
-my $Chronological_Order = 0;\r
-\r
-# Grab user details via gecos\r
-my $Gecos = 0;\r
-\r
-# User domain for gecos email addresses\r
-my $Domain;\r
-\r
-# Output to a file or to stdout?\r
-my $Output_To_Stdout = 0;\r
-\r
-# Eliminate empty log messages?\r
-my $Prune_Empty_Msgs = 0;\r
-\r
-# Tags of which not to output\r
-my %ignore_tags;\r
-\r
-# Show only revisions with Tags\r
-my %show_tags;\r
-\r
-# Don't call Text::Wrap on the body of the message\r
-my $No_Wrap = 0;\r
-\r
-# Indentation of log messages\r
-my $Indent = "\t";\r
-\r
-# Don't do any pretty print processing\r
-my $Summary = 0;\r
-\r
-# Separates header from log message. Code assumes it is either " " or\r
-# "\n\n", so if there's ever an option to set it to something else,\r
-# make sure to go through all conditionals that use this var.\r
-my $After_Header = " ";\r
-\r
-# XML Encoding\r
-my $XML_Encoding = '';\r
-\r
-# Format more for programs than for humans.\r
-my $XML_Output = 0;\r
-my $No_XML_Namespace = 0;\r
-my $No_XML_ISO_Date = 0;\r
-\r
-# Do some special tweaks for log data that was written in FSF\r
-# ChangeLog style.\r
-my $FSF_Style = 0;\r
-\r
-# Show times in UTC instead of local time\r
-my $UTC_Times = 0;\r
-\r
-# Show times in output?\r
-my $Show_Times = 1;\r
-\r
-# Show day of week in output?\r
-my $Show_Day_Of_Week = 0;\r
-\r
-# Show revision numbers in output?\r
-my $Show_Revisions = 0;\r
-\r
-# Show dead files in output?\r
-my $Show_Dead = 0;\r
-\r
-# Hide dead trunk files which were created as a result of additions on a\r
-# branch?\r
-my $Hide_Branch_Additions = 1;\r
-\r
-# Show tags (symbolic names) in output?\r
-my $Show_Tags = 0;\r
-\r
-# Show tags separately in output?\r
-my $Show_Tag_Dates = 0;\r
-\r
-# Show branches by symbolic name in output?\r
-my $Show_Branches = 0;\r
-\r
-# Show only revisions on these branches or their ancestors.\r
-my @Follow_Branches;\r
-# Show only revisions on these branches or their ancestors; ignore descendent\r
-# branches.\r
-my @Follow_Only;\r
-\r
-# Don't bother with files matching this regexp.\r
-my @Ignore_Files;\r
-\r
-# How exactly we match entries. We definitely want "o",\r
-# and user might add "i" by using --case-insensitive option.\r
-my $Case_Insensitive = 0;\r
-\r
-# Maybe only show log messages matching a certain regular expression.\r
-my $Regexp_Gate = '';\r
-\r
-# Pass this global option string along to cvs, to the left of `log':\r
-my $Global_Opts = '';\r
-\r
-# Pass this option string along to the cvs log subcommand:\r
-my $Command_Opts = '';\r
-\r
-# Read log output from stdin instead of invoking cvs log?\r
-my $Input_From_Stdin = 0;\r
-\r
-# Don't show filenames in output.\r
-my $Hide_Filenames = 0;\r
-\r
-# Don't shorten directory names from filenames.\r
-my $Common_Dir = 1;\r
-\r
-# Max checkin duration. CVS checkin is not atomic, so we may have checkin\r
-# times that span a range of time. We assume that checkins will last no\r
-# longer than $Max_Checkin_Duration seconds, and that similarly, no\r
-# checkins will happen from the same users with the same message less\r
-# than $Max_Checkin_Duration seconds apart.\r
-my $Max_Checkin_Duration = 180;\r
-\r
-# What to put at the front of [each] ChangeLog.\r
-my $ChangeLog_Header = '';\r
-\r
-# Whether to enable 'delta' mode, and for what start/end tags.\r
-my $Delta_Mode = 0;\r
-my $Delta_From = '';\r
-my $Delta_To = '';\r
-\r
-my $TestCode;\r
-\r
-# Whether to parse filenames from the RCS filename, and if so what\r
-# prefix to strip.\r
-my $RCS_Root;\r
-\r
-# Whether to output information on the # of lines added and removed\r
-# by each file modification.\r
-my $Show_Lines_Modified = 0;\r
-\r
-## end vars set by options.\r
-\r
-# latest observed times for the start/end tags in delta mode\r
-my $Delta_StartTime = 0;\r
-my $Delta_EndTime = 0;\r
-\r
-my $No_Ancestors = 0;\r
-\r
-my $No_Extra_Indent = 0;\r
-\r
-my $GroupWithinDate = 0;\r
-\r
-# ----------------------------------------------------------------------------\r
-\r
-package CVS::Utils::ChangeLog::EntrySet;\r
-\r
-sub new {\r
- my $class = shift;\r
- my %self;\r
- bless \%self, $class;\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub output_changelog {\r
- my $output_type = $XML_Output ? 'XML' : 'Text';\r
- my $output_class = "CVS::Utils::ChangeLog::EntrySet::Output::${output_type}";\r
- my $output = $output_class->new(follow_branches => \@Follow_Branches,\r
- follow_only => \@Follow_Only,\r
- ignore_tags => \%ignore_tags,\r
- show_tags => \%show_tags,\r
- );\r
- $output->output_changelog(@_);\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub add_fileentry {\r
- my ($self, $file_full_path, $time, $revision, $state, $lines,\r
- $branch_names, $branch_roots, $branch_numbers,\r
- $symbolic_names, $author, $msg_txt) = @_;\r
-\r
- my $qunk =\r
- CVS::Utils::ChangeLog::FileEntry->new($file_full_path, $time, $revision,\r
- $state, $lines,\r
- $branch_names, $branch_roots,\r
- $branch_numbers,\r
- $symbolic_names);\r
-\r
- # We might be including revision numbers and/or tags and/or\r
- # branch names in the output. Most of the code from here to\r
- # loop-end deals with organizing these in qunk.\r
-\r
- unless ( $Hide_Branch_Additions\r
- and\r
- $msg_txt =~ /file .+ was initially added on branch \S+./ ) {\r
- # Add this file to the list\r
- # (We use many spoonfuls of autovivication magic. Hashes and arrays\r
- # will spring into existence if they aren't there already.)\r
-\r
- &main::debug ("(pushing log msg for ". $qunk->dir_key . $qunk->filename . ")\n");\r
-\r
- # Store with the files in this commit. Later we'll loop through\r
- # again, making sure that revisions with the same log message\r
- # and nearby commit times are grouped together as one commit.\r
- $self->{$qunk->dir_key}{$author}{$time}{$msg_txt} =\r
- CVS::Utils::ChangeLog::Message->new($msg_txt)\r
- unless exists $self->{$qunk->dir_key}{$author}{$time}{$msg_txt};\r
- $self->{$qunk->dir_key}{$author}{$time}{$msg_txt}->add_fileentry($qunk);\r
- }\r
-\r
-}\r
-\r
-# ----------------------------------------------------------------------------\r
-\r
-package CVS::Utils::ChangeLog::EntrySet::Output::Text;\r
-\r
-use base qw( CVS::Utils::ChangeLog::EntrySet::Output );\r
-\r
-use File::Basename qw( fileparse );\r
-\r
-sub new {\r
- my $class = shift;\r
- my $self = $class->SUPER::new(@_);\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub wday {\r
- my $self = shift; my $class = ref $self;\r
- my ($wday) = @_;\r
-\r
- return $Show_Day_Of_Week ? ' ' . $class->weekday_en($wday) : '';\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub header_line {\r
- my $self = shift;\r
- my ($time, $author, $lastdate) = @_;\r
-\r
- my $header_line = '';\r
-\r
- my (undef,$min,$hour,$mday,$mon,$year,$wday)\r
- = $UTC_Times ? gmtime($time) : localtime($time);\r
-\r
- my $date = $self->fdatetime($time);\r
-\r
- if ($Show_Times) {\r
- $header_line =\r
- sprintf "%s %s\n\n", $date, $author;\r
- } else {\r
- if ( ! defined $lastdate or $date ne $lastdate or ! $GroupWithinDate ) {\r
- if ( $GroupWithinDate ) {\r
- $header_line = "$date\n\n";\r
- } else {\r
- $header_line = "$date $author\n\n";\r
- }\r
- } else {\r
- $header_line = '';\r
- }\r
- }\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub preprocess_msg_text {\r
- my $self = shift;\r
- my ($text) = @_;\r
-\r
- $text = $self->SUPER::preprocess_msg_text($text);\r
-\r
- unless ( $No_Wrap ) {\r
- # Strip off lone newlines, but only for lines that don't begin with\r
- # whitespace or a mail-quoting character, since we want to preserve\r
- # that kind of formatting. Also don't strip newlines that follow a\r
- # period; we handle those specially next. And don't strip\r
- # newlines that precede an open paren.\r
- 1 while $text =~ s/(^|\n)([^>\s].*[^.\n])\n([^>\n])/$1$2 $3/g;\r
-\r
- # If a newline follows a period, make sure that when we bring up the\r
- # bottom sentence, it begins with two spaces.\r
- 1 while $text =~ s/(^|\n)([^>\s].*)\n([^>\n])/$1$2 $3/g;\r
- }\r
-\r
- return $text;\r
-}\r
-\r
-# -------------------------------------\r
-\r
-# Here we take a bunch of qunks and convert them into printed\r
-# summary that will include all the information the user asked for.\r
-sub pretty_file_list {\r
- my $self = shift;\r
-\r
- return ''\r
- if $Hide_Filenames;\r
-\r
- my $qunksref = shift;\r
-\r
- my @filenames;\r
- my $beauty = ''; # The accumulating header string for this entry.\r
- my %non_unanimous_tags; # Tags found in a proper subset of qunks\r
- my %unanimous_tags; # Tags found in all qunks\r
- my %all_branches; # Branches found in any qunk\r
- my $fbegun = 0; # Did we begin printing filenames yet?\r
-\r
- my ($common_dir, $qunkrefs) =\r
- $self->_pretty_file_list(\(%unanimous_tags, %non_unanimous_tags, %all_branches), $qunksref);\r
-\r
- my @qunkrefs = @$qunkrefs;\r
-\r
- # Not XML output, so complexly compactify for chordate consumption. At this\r
- # point we have enough global information about all the qunks to organize\r
- # them non-redundantly for output.\r
-\r
- if ($common_dir) {\r
- # Note that $common_dir still has its trailing slash\r
- $beauty .= "$common_dir: ";\r
- }\r
-\r
- if ($Show_Branches)\r
- {\r
- # For trailing revision numbers.\r
- my @brevisions;\r
-\r
- foreach my $branch (keys (%all_branches))\r
- {\r
- foreach my $qunkref (@qunkrefs)\r
- {\r
- if ((defined ($qunkref->branch))\r
- and ($qunkref->branch eq $branch))\r
- {\r
- if ($fbegun) {\r
- # kff todo: comma-delimited in XML too? Sure.\r
- $beauty .= ", ";\r
- }\r
- else {\r
- $fbegun = 1;\r
- }\r
- my $fname = substr ($qunkref->filename, length ($common_dir));\r
- $beauty .= $fname;\r
- $qunkref->{'printed'} = 1; # Just setting a mark bit, basically\r
-\r
- if ( $Show_Tags and defined $qunkref->tags ) {\r
- my @tags = grep ($non_unanimous_tags{$_}, @{$qunkref->tags});\r
-\r
- if (@tags) {\r
- $beauty .= " (tags: ";\r
- $beauty .= join (', ', @tags);\r
- $beauty .= ")";\r
- }\r
- }\r
-\r
- if ($Show_Revisions) {\r
- # Collect the revision numbers' last components, but don't\r
- # print them -- they'll get printed with the branch name\r
- # later.\r
- $qunkref->revision =~ /.+\.([\d]+)$/;\r
- push (@brevisions, $1);\r
-\r
- # todo: we're still collecting branch roots, but we're not\r
- # showing them anywhere. If we do show them, it would be\r
- # nifty to just call them revision "0" on a the branch.\r
- # Yeah, that's the ticket.\r
- }\r
- }\r
- }\r
- $beauty .= " ($branch";\r
- if (@brevisions) {\r
- if ((scalar (@brevisions)) > 1) {\r
- $beauty .= ".[";\r
- $beauty .= (join (',', @brevisions));\r
- $beauty .= "]";\r
- }\r
- else {\r
- # Square brackets are spurious here, since there's no range to\r
- # encapsulate\r
- $beauty .= ".$brevisions[0]";\r
- }\r
- }\r
- $beauty .= ")";\r
- }\r
- }\r
-\r
- # Okay; any qunks that were done according to branch are taken care\r
- # of, and marked as printed. Now print everyone else.\r
-\r
- my %fileinfo_printed;\r
- foreach my $qunkref (@qunkrefs)\r
- {\r
- next if (defined ($qunkref->{'printed'})); # skip if already printed\r
-\r
- my $b = substr ($qunkref->filename, length ($common_dir));\r
- # todo: Shlomo's change was this:\r
- # $beauty .= substr ($qunkref->filename,\r
- # (($common_dir eq "./") ? '' : length ($common_dir)));\r
- $qunkref->{'printed'} = 1; # Set a mark bit.\r
-\r
- if ($Show_Revisions || $Show_Tags || $Show_Dead)\r
- {\r
- my $started_addendum = 0;\r
-\r
- if ($Show_Revisions) {\r
- $started_addendum = 1;\r
- $b .= " (";\r
- $b .= $qunkref->revision;\r
- }\r
- if ($Show_Dead && $qunkref->state =~ /dead/)\r
- {\r
- # Deliberately not using $started_addendum. Keeping it simple.\r
- $b .= "[DEAD]";\r
- }\r
- if ($Show_Tags && (defined $qunkref->tags)) {\r
- my @tags = grep ($non_unanimous_tags{$_}, @{$qunkref->tags});\r
- if ((scalar (@tags)) > 0) {\r
- if ($started_addendum) {\r
- $b .= ", ";\r
- }\r
- else {\r
- $b .= " (tags: ";\r
- }\r
- $b .= join (', ', @tags);\r
- $started_addendum = 1;\r
- }\r
- }\r
- if ($started_addendum) {\r
- $b .= ")";\r
- }\r
- }\r
-\r
- unless ( exists $fileinfo_printed{$b} ) {\r
- if ($fbegun) {\r
- $beauty .= ", ";\r
- } else {\r
- $fbegun = 1;\r
- }\r
- $beauty .= $b, $fileinfo_printed{$b} = 1;\r
- }\r
- }\r
-\r
- # Unanimous tags always come last.\r
- if ($Show_Tags && %unanimous_tags)\r
- {\r
- $beauty .= " (utags: ";\r
- $beauty .= join (', ', sort keys (%unanimous_tags));\r
- $beauty .= ")";\r
- }\r
-\r
- # todo: still have to take care of branch_roots?\r
-\r
- $beauty = "$beauty:";\r
-\r
- return $beauty;\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub output_tagdate {\r
- my $self = shift;\r
- my ($fh, $time, $tag) = @_;\r
-\r
- my $fdatetime = $self->fdatetime($time);\r
- print $fh "$fdatetime tag $tag\n\n";\r
- return;\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub format_body {\r
- my $self = shift;\r
- my ($msg, $files, $qunklist) = @_;\r
-\r
- my $body;\r
-\r
- if ( $No_Wrap and ! $Summary ) {\r
- $msg = $self->preprocess_msg_text($msg);\r
- $files = $self->mywrap("\t", "\t ", "* $files");\r
- $msg =~ s/\n(.+)/\n$Indent$1/g;\r
- unless ($After_Header eq " ") {\r
- $msg =~ s/^(.+)/$Indent$1/g;\r
- }\r
- if ( $Hide_Filenames ) {\r
- $body = $After_Header . $msg;\r
- } else {\r
- $body = $files . $After_Header . $msg;\r
- }\r
- } elsif ( $Summary ) {\r
- my ($filelist, $qunk);\r
- my (@DeletedQunks, @AddedQunks, @ChangedQunks);\r
-\r
- $msg = $self->preprocess_msg_text($msg);\r
- #\r
- # Sort the files (qunks) according to the operation that was\r
- # performed. Files which were added have no line change\r
- # indicator, whereas deleted files have state dead.\r
- #\r
- foreach $qunk ( @$qunklist ) {\r
- if ( "dead" eq $qunk->state) {\r
- push @DeletedQunks, $qunk;\r
- } elsif ( ! defined $qunk->lines ) {\r
- push @AddedQunks, $qunk;\r
- } else {\r
- push @ChangedQunks, $qunk;\r
- }\r
- }\r
- #\r
- # The qunks list was originally in tree search order. Let's\r
- # get that back. The lists, if they exist, will be reversed upon\r
- # processing.\r
- #\r
-\r
- #\r
- # Now write the three sections onto $filelist\r
- #\r
- if ( @DeletedQunks ) {\r
- $filelist .= "\tDeleted:\n";\r
- foreach $qunk ( @DeletedQunks ) {\r
- $filelist .= "\t\t" . $qunk->filename;\r
- $filelist .= " (" . $qunk->revision . ")";\r
- $filelist .= "\n";\r
- }\r
- undef @DeletedQunks;\r
- }\r
-\r
- if ( @AddedQunks ) {\r
- $filelist .= "\tAdded:\n";\r
- foreach $qunk (@AddedQunks) {\r
- $filelist .= "\t\t" . $qunk->filename;\r
- $filelist .= " (" . $qunk->revision . ")";\r
- $filelist .= "\n";\r
- }\r
- undef @AddedQunks ;\r
- }\r
-\r
- if ( @ChangedQunks ) {\r
- $filelist .= "\tChanged:\n";\r
- foreach $qunk (@ChangedQunks) {\r
- $filelist .= "\t\t" . $qunk->filename;\r
- $filelist .= " (" . $qunk->revision . ")";\r
- $filelist .= ", \"" . $qunk->state . "\"";\r
- $filelist .= ", lines: " . $qunk->lines;\r
- $filelist .= "\n";\r
- }\r
- undef @ChangedQunks;\r
- }\r
-\r
- chomp $filelist;\r
-\r
- if ( $Hide_Filenames ) {\r
- $filelist = '';\r
- }\r
-\r
- $msg =~ s/\n(.*)/\n$Indent$1/g;\r
- unless ( $After_Header eq " " or $FSF_Style ) {\r
- $msg =~ s/^(.*)/$Indent$1/g;\r
- }\r
-\r
- unless ( $No_Wrap ) {\r
- if ( $FSF_Style ) {\r
- $msg = $self->wrap_log_entry($msg, '', 69, 69);\r
- chomp($msg);\r
- chomp($msg);\r
- } else {\r
- $msg = $self->mywrap('', $Indent, "$msg");\r
- $msg =~ s/[ \t]+\n/\n/g;\r
- }\r
- }\r
-\r
- $body = $filelist . $After_Header . $msg;\r
- } else { # do wrapping, either FSF-style or regular\r
- my $latter_wrap = $No_Extra_Indent ? $Indent : "$Indent ";\r
-\r
- if ( $FSF_Style ) {\r
- $files = $self->mywrap($Indent, $latter_wrap, "* $files");\r
-\r
- my $files_last_line_len = 0;\r
- if ( $After_Header eq " " ) {\r
- $files_last_line_len = $self->last_line_len($files);\r
- $files_last_line_len += 1; # for $After_Header\r
- }\r
-\r
- $msg = $self->wrap_log_entry($msg, $latter_wrap, 69-$files_last_line_len, 69);\r
- $body = $files . $After_Header . $msg;\r
- } else { # not FSF-style\r
- $msg = $self->preprocess_msg_text($msg);\r
- $body = $files . $After_Header . $msg;\r
- $body = $self->mywrap($Indent, $latter_wrap, "* $body");\r
- $body =~ s/[ \t]+\n/\n/g;\r
- }\r
- }\r
-\r
- return $body;\r
-}\r
-\r
-# ----------------------------------------------------------------------------\r
-\r
-package CVS::Utils::ChangeLog::EntrySet::Output::XML;\r
-\r
-use base qw( CVS::Utils::ChangeLog::EntrySet::Output );\r
-\r
-use File::Basename qw( fileparse );\r
-\r
-sub new {\r
- my $class = shift;\r
- my $self = $class->SUPER::new(@_);\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub header_line {\r
- my $self = shift;\r
- my ($time, $author, $lastdate) = @_;\r
-\r
- my $header_line = '';\r
-\r
- my $isoDate;\r
-\r
- my ($y, $m, $d, $H, $M, $S) = (gmtime($time))[5,4,3,2,1,0];\r
-\r
- # Ideally, this would honor $UTC_Times and use +HH:MM syntax\r
- $isoDate = sprintf("%04d-%02d-%02dT%02d:%02d:%02dZ",\r
- $y + 1900, $m + 1, $d, $H, $M, $S);\r
-\r
- my (undef,$min,$hour,$mday,$mon,$year,$wday)\r
- = $UTC_Times ? gmtime($time) : localtime($time);\r
-\r
- my $date = $self->fdatetime($time);\r
- $wday = $self->wday($wday);\r
-\r
- $header_line =\r
- sprintf ("<date>%4u-%02u-%02u</date>\n${wday}<time>%02u:%02u</time>\n",\r
- $year+1900, $mon+1, $mday, $hour, $min);\r
- $header_line .= "<isoDate>$isoDate</isoDate>\n"\r
- unless $No_XML_ISO_Date;\r
- $header_line .= sprintf("<author>%s</author>\n" , $author);\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub wday {\r
- my $self = shift; my $class = ref $self;\r
- my ($wday) = @_;\r
-\r
- return '<weekday>' . $class->weekday_en($wday) . "</weekday>\n";\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub escape {\r
- my $self = shift;\r
-\r
- my $txt = shift;\r
- $txt =~ s/&/&/g;\r
- $txt =~ s/</</g;\r
- $txt =~ s/>/>/g;\r
- return $txt;\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub output_header {\r
- my $self = shift;\r
- my ($fh) = @_;\r
-\r
- my $encoding =\r
- length $XML_Encoding ? qq'encoding="$XML_Encoding"' : '';\r
- my $version = 'version="1.0"';\r
- my $declaration =\r
- sprintf '<?xml %s?>', join ' ', grep length, $version, $encoding;\r
- my $root =\r
- $No_XML_Namespace ?\r
- '<changelog>' :\r
- '<changelog xmlns="http://www.red-bean.com/xmlns/cvs2cl/">';\r
- print $fh "$declaration\n\n$root\n\n";\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub output_footer {\r
- my $self = shift;\r
- my ($fh) = @_;\r
-\r
- print $fh "</changelog>\n";\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub preprocess_msg_text {\r
- my $self = shift;\r
- my ($text) = @_;\r
-\r
- $text = $self->SUPER::preprocess_msg_text($text);\r
-\r
- $text = $self->escape($text);\r
- chomp $text;\r
- $text = "<msg>${text}</msg>\n";\r
-\r
- return $text;\r
-}\r
-\r
-# -------------------------------------\r
-\r
-# Here we take a bunch of qunks and convert them into a printed\r
-# summary that will include all the information the user asked for.\r
-sub pretty_file_list {\r
- my $self = shift;\r
- my ($qunksref) = @_;\r
-\r
- my $beauty = ''; # The accumulating header string for this entry.\r
- my %non_unanimous_tags; # Tags found in a proper subset of qunks\r
- my %unanimous_tags; # Tags found in all qunks\r
- my %all_branches; # Branches found in any qunk\r
- my $fbegun = 0; # Did we begin printing filenames yet?\r
-\r
- my ($common_dir, $qunkrefs) =\r
- $self->_pretty_file_list(\(%unanimous_tags, %non_unanimous_tags, %all_branches),\r
- $qunksref);\r
-\r
- my @qunkrefs = @$qunkrefs;\r
-\r
- # If outputting XML, then our task is pretty simple, because we\r
- # don't have to detect common dir, common tags, branch prefixing,\r
- # etc. We just output exactly what we have, and don't worry about\r
- # redundancy or readability.\r
-\r
- foreach my $qunkref (@qunkrefs)\r
- {\r
- my $filename = $qunkref->filename;\r
- my $state = $qunkref->state;\r
- my $revision = $qunkref->revision;\r
- my $tags = $qunkref->tags;\r
- my $branch = $qunkref->branch;\r
- my $branchroots = $qunkref->roots;\r
- my $lines = $qunkref->lines;\r
-\r
- $filename = $self->escape($filename); # probably paranoia\r
- $revision = $self->escape($revision); # definitely paranoia\r
-\r
- $beauty .= "<file>\n";\r
- $beauty .= "<name>${filename}</name>\n";\r
- $beauty .= "<cvsstate>${state}</cvsstate>\n";\r
- $beauty .= "<revision>${revision}</revision>\n";\r
-\r
- if ($Show_Lines_Modified\r
- && $lines && $lines =~ m/\+(\d+)\s+-(\d+)/) {\r
- $beauty .= "<linesadded>$1</linesadded>\n";\r
- $beauty .= "<linesremoved>$2</linesremoved>\n";\r
- }\r
-\r
- if ($branch) {\r
- $branch = $self->escape($branch); # more paranoia\r
- $beauty .= "<branch>${branch}</branch>\n";\r
- }\r
- foreach my $tag (@$tags) {\r
- $tag = $self->escape($tag); # by now you're used to the paranoia\r
- $beauty .= "<tag>${tag}</tag>\n";\r
- }\r
- foreach my $root (@$branchroots) {\r
- $root = $self->escape($root); # which is good, because it will continue\r
- $beauty .= "<branchroot>${root}</branchroot>\n";\r
- }\r
- $beauty .= "</file>\n";\r
- }\r
-\r
- # Theoretically, we could go home now. But as long as we're here,\r
- # let's print out the common_dir and utags, as a convenience to\r
- # the receiver (after all, earlier code calculated that stuff\r
- # anyway, so we might as well take advantage of it).\r
-\r
- if ((scalar (keys (%unanimous_tags))) > 1) {\r
- foreach my $utag ((keys (%unanimous_tags))) {\r
- $utag = $self->escape($utag); # the usual paranoia\r
- $beauty .= "<utag>${utag}</utag>\n";\r
- }\r
- }\r
- if ($common_dir) {\r
- $common_dir = $self->escape($common_dir);\r
- $beauty .= "<commondir>${common_dir}</commondir>\n";\r
- }\r
-\r
- # That's enough for XML, time to go home:\r
- return $beauty;\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub output_tagdate {\r
- # NOT YET DONE\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub output_entry {\r
- my $self = shift;\r
- my ($fh, $entry) = @_;\r
- print $fh "<entry>\n$entry</entry>\n\n";\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub format_body {\r
- my $self = shift;\r
- my ($msg, $files, $qunklist) = @_;\r
-\r
- $msg = $self->preprocess_msg_text($msg);\r
- return $files . $msg;\r
-}\r
-\r
-# ----------------------------------------------------------------------------\r
-\r
-package CVS::Utils::ChangeLog::EntrySet::Output;\r
-\r
-use Carp qw( croak );\r
-use File::Basename qw( fileparse );\r
-\r
-# Class Utility Functions -------------\r
-\r
-{ # form closure\r
-\r
-my @weekdays = (qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday));\r
-sub weekday_en {\r
- my $class = shift;\r
- return $weekdays[$_[0]];\r
-}\r
-\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub new {\r
- my ($proto, %args) = @_;\r
- my $class = ref $proto || $proto;\r
-\r
- my $follow_branches = delete $args{follow_branches};\r
- my $follow_only = delete $args{follow_only};\r
- my $ignore_tags = delete $args{ignore_tags};\r
- my $show_tags = delete $args{show_tags};\r
- die "Unrecognized arg to EntrySet::Output::new: '$_'\n"\r
- for keys %args;\r
-\r
- bless +{follow_branches => $follow_branches,\r
- follow_only => $follow_only,\r
- show_tags => $show_tags,\r
- ignore_tags => $ignore_tags,\r
- }, $class;\r
-}\r
-\r
-# Abstract Subrs ----------------------\r
-\r
-sub wday { croak "Whoops. Abtract method call (wday).\n" }\r
-sub pretty_file_list { croak "Whoops. Abtract method call (pretty_file_list).\n" }\r
-sub output_tagdate { croak "Whoops. Abtract method call (output_tagdate).\n" }\r
-sub header_line { croak "Whoops. Abtract method call (header_line).\n" }\r
-\r
-# Instance Subrs ----------------------\r
-\r
-sub output_header { }\r
-\r
-# -------------------------------------\r
-\r
-sub output_entry {\r
- my $self = shift;\r
- my ($fh, $entry) = @_;\r
- print $fh "$entry\n";\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub output_footer { }\r
-\r
-# -------------------------------------\r
-\r
-sub escape { return $_[1] }\r
-\r
-# -------------------------------------\r
-\r
-sub _revision_is_wanted {\r
- my ($self, $qunk) = @_;\r
-\r
- my ($revision, $branch_numbers) = @{$qunk}{qw( revision branch_numbers )};\r
- my $follow_branches = $self->{follow_branches};\r
- my $follow_only = $self->{follow_only};\r
-\r
-#print STDERR "IG: ", join(',', keys %{$self->{ignore_tags}}), "\n";\r
-#print STDERR "IX: ", join(',', @{$qunk->{tags}}), "\n" if defined $qunk->{tags};\r
-#print STDERR "IQ: ", join(',', keys %{$qunk->{branch_numbers}}), "\n" if defined $qunk->{branch_numbers};\r
-#use Data::Dumper; print STDERR Dumper $qunk;\r
-\r
- for my $ignore_tag (keys %{$self->{ignore_tags}}) {\r
- return\r
- if defined $qunk->{tags} and grep $_ eq $ignore_tag, @{$qunk->{tags}};\r
- }\r
-\r
- if ( keys %{$self->{show_tags}} ) {\r
- for my $show_tag (keys %{$self->{show_tags}}) {\r
- return\r
- if ! defined $qunk->{tags} or ! grep $_ eq $show_tag, @{$qunk->{tags}};\r
- }\r
- }\r
-\r
- return 1\r
- unless @$follow_branches + @$follow_only; # no follow is follow all\r
-\r
- for my $x (map([$_, 1], @$follow_branches),\r
- map([$_, 0], @$follow_only )) {\r
- my ($branch, $followsub) = @$x;\r
-\r
- # Special case for following trunk revisions\r
- return 1\r
- if $branch =~ /^trunk$/i and $revision =~ /^[0-9]+\.[0-9]+$/;\r
-\r
- if ( my $branch_number = $branch_numbers->{$branch} ) {\r
- # Are we on one of the follow branches or an ancestor of same?\r
-\r
- # If this revision is a prefix of the branch number, or possibly is less\r
- # in the minormost number, OR if this branch number is a prefix of the\r
- # revision, then yes. Otherwise, no.\r
-\r
- # So below, we determine if any of those conditions are met.\r
-\r
- # Trivial case: is this revision on the branch? (Compare this way to\r
- # avoid regexps that screw up Emacs indentation, argh.)\r
- if ( substr($revision, 0, (length($branch_number) + 1))\r
- eq\r
- ($branch_number . ".") ) {\r
- if ( $followsub ) {\r
- return 1;\r
- } elsif (length($revision) == length($branch_number)+2 ) {\r
- return 1;\r
- }\r
- } elsif ( length($branch_number) > length($revision)\r
- and\r
- $No_Ancestors ) {\r
- # Non-trivial case: check if rev is ancestral to branch\r
-\r
- # r_left still has the trailing "."\r
- my ($r_left, $r_end) = ($revision =~ /^((?:\d+\.)+)(\d+)$/);\r
-\r
- # b_left still has trailing "."\r
- # b_mid has no trailing "."\r
- my ($b_left, $b_mid) = ($branch_number =~ /^((?:\d+\.)+)(\d+)\.\d+$/);\r
- return 1\r
- if $r_left eq $b_left and $r_end <= $b_mid;\r
- }\r
- }\r
- }\r
-\r
- return;\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub output_changelog {\r
-my $self = shift; my $class = ref $self;\r
- my ($grand_poobah) = @_;\r
- ### Process each ChangeLog\r
-\r
- while (my ($dir,$authorhash) = each %$grand_poobah)\r
- {\r
- &main::debug ("DOING DIR: $dir\n");\r
-\r
- # Here we twist our hash around, from being\r
- # author => time => message => filelist\r
- # in %$authorhash to\r
- # time => author => message => filelist\r
- # in %changelog.\r
- #\r
- # This is also where we merge entries. The algorithm proceeds\r
- # through the timeline of the changelog with a sliding window of\r
- # $Max_Checkin_Duration seconds; within that window, entries that\r
- # have the same log message are merged.\r
- #\r
- # (To save space, we zap %$authorhash after we've copied\r
- # everything out of it.)\r
-\r
- my %changelog;\r
- while (my ($author,$timehash) = each %$authorhash)\r
- {\r
- my %stamptime;\r
- foreach my $time (sort {$a <=> $b} (keys %$timehash))\r
- {\r
- my $msghash = $timehash->{$time};\r
- while (my ($msg,$qunklist) = each %$msghash)\r
- {\r
- my $stamptime = $stamptime{$msg};\r
- if ((defined $stamptime)\r
- and (($time - $stamptime) < $Max_Checkin_Duration)\r
- and (defined $changelog{$stamptime}{$author}{$msg}))\r
- {\r
- push(@{$changelog{$stamptime}{$author}{$msg}}, $qunklist->files);\r
- }\r
- else {\r
- $changelog{$time}{$author}{$msg} = $qunklist->files;\r
- $stamptime{$msg} = $time;\r
- }\r
- }\r
- }\r
- }\r
- undef (%$authorhash);\r
-\r
- ### Now we can write out the ChangeLog!\r
-\r
- my ($logfile_here, $logfile_bak, $tmpfile);\r
- my $lastdate;\r
-\r
- if (! $Output_To_Stdout) {\r
- $logfile_here = $dir . $Log_File_Name;\r
- $logfile_here =~ s/^\.\/\//\//; # fix any leading ".//" problem\r
- $tmpfile = "${logfile_here}.cvs2cl$$.tmp";\r
- $logfile_bak = "${logfile_here}.bak";\r
-\r
- open (LOG_OUT, ">$tmpfile") or die "Unable to open \"$tmpfile\"";\r
- }\r
- else {\r
- open (LOG_OUT, ">-") or die "Unable to open stdout for writing";\r
- }\r
-\r
- print LOG_OUT $ChangeLog_Header;\r
-\r
- my %tag_date_printed;\r
-\r
- $self->output_header(\*LOG_OUT);\r
-\r
- my @key_list = ();\r
- if($Chronological_Order) {\r
- @key_list = sort {$a <=> $b} (keys %changelog);\r
- } else {\r
- @key_list = sort {$b <=> $a} (keys %changelog);\r
- }\r
- foreach my $time (@key_list)\r
- {\r
- next if ($Delta_Mode &&\r
- (($time <= $Delta_StartTime) ||\r
- ($time > $Delta_EndTime && $Delta_EndTime)));\r
-\r
- # Set up the date/author line.\r
- # kff todo: do some more XML munging here, on the header\r
- # part of the entry:\r
- my (undef,$min,$hour,$mday,$mon,$year,$wday)\r
- = $UTC_Times ? gmtime($time) : localtime($time);\r
-\r
- $wday = $self->wday($wday);\r
- # XML output includes everything else, we might as well make\r
- # it always include Day Of Week too, for consistency.\r
- my $authorhash = $changelog{$time};\r
- if ($Show_Tag_Dates) {\r
- my %tags;\r
- while (my ($author,$mesghash) = each %$authorhash) {\r
- while (my ($msg,$qunk) = each %$mesghash) {\r
- foreach my $qunkref2 (@$qunk) {\r
- if (defined ($qunkref2->tags)) {\r
- foreach my $tag (@{$qunkref2->tags}) {\r
- $tags{$tag} = 1;\r
- }\r
- }\r
- }\r
- }\r
- }\r
- # Sort here for determinism to ease testing\r
- foreach my $tag (sort keys %tags) {\r
- if ( ! defined $tag_date_printed{$tag} ) {\r
- $tag_date_printed{$tag} = $time;\r
- $self->output_tagdate(\*LOG_OUT, $time, $tag);\r
- }\r
- }\r
- }\r
- while (my ($author,$mesghash) = each %$authorhash)\r
- {\r
- # If XML, escape in outer loop to avoid compound quoting:\r
- $author = $self->escape($author);\r
-\r
- FOOBIE:\r
- # We sort here to enable predictable ordering for the testing porpoises\r
- for my $msg (sort keys %$mesghash)\r
- {\r
- my $qunklist = $mesghash->{$msg};\r
-\r
- my @qunklist =\r
- grep $self->_revision_is_wanted($_), @$qunklist;\r
-\r
- next FOOBIE unless @qunklist;\r
-\r
- my $files = $self->pretty_file_list(\@qunklist);\r
- my $header_line; # date and author\r
- my $wholething; # $header_line + $body\r
-\r
- my $date = $self->fdatetime($time);\r
- $header_line = $self->header_line($time, $author, $lastdate);\r
- $lastdate = $date;\r
-\r
- $Text::Wrap::huge = 'overflow'\r
- if $Text::Wrap::VERSION >= 2001.0130;\r
- # Reshape the body according to user preferences.\r
- my $body = $self->format_body($msg, $files, \@qunklist);\r
-\r
- $body =~ s/[ \t]+\n/\n/g;\r
- $wholething = $header_line . $body;\r
-\r
- # One last check: make sure it passes the regexp test, if the\r
- # user asked for that. We have to do it here, so that the\r
- # test can match against information in the header as well\r
- # as in the text of the log message.\r
-\r
- # How annoying to duplicate so much code just because I\r
- # can't figure out a way to evaluate scalars on the trailing\r
- # operator portion of a regular expression. Grrr.\r
- if ($Case_Insensitive) {\r
- unless ( $Regexp_Gate and ( $wholething !~ /$Regexp_Gate/oi ) ) {\r
- $self->output_entry(\*LOG_OUT, $wholething);\r
- }\r
- }\r
- else {\r
- unless ( $Regexp_Gate and ( $wholething !~ /$Regexp_Gate/o ) ) {\r
- $self->output_entry(\*LOG_OUT, $wholething);\r
- }\r
- }\r
- }\r
- }\r
- }\r
-\r
- $self->output_footer(\*LOG_OUT);\r
-\r
- close (LOG_OUT);\r
-\r
- if ( ! $Output_To_Stdout ) {\r
- # If accumulating, append old data to new before renaming. But\r
- # don't append the most recent entry, since it's already in the\r
- # new log due to CVS's idiosyncratic interpretation of "log -d".\r
- if ($Cumulative && -f $logfile_here) {\r
- open NEW_LOG, ">>$tmpfile"\r
- or die "trouble appending to $tmpfile ($!)";\r
-\r
- open OLD_LOG, "<$logfile_here"\r
- or die "trouble reading from $logfile_here ($!)";\r
-\r
- my $started_first_entry = 0;\r
- my $passed_first_entry = 0;\r
- while (<OLD_LOG>) {\r
- if ( ! $passed_first_entry ) {\r
- if ( ( ! $started_first_entry )\r
- and /^(\d\d\d\d-\d\d-\d\d\s+\d\d:\d\d)/ ) {\r
- $started_first_entry = 1;\r
- } elsif ( /^(\d\d\d\d-\d\d-\d\d\s+\d\d:\d\d)/ ) {\r
- $passed_first_entry = 1;\r
- print NEW_LOG $_;\r
- }\r
- } else {\r
- print NEW_LOG $_;\r
- }\r
- }\r
-\r
- close NEW_LOG;\r
- close OLD_LOG;\r
- }\r
-\r
- if ( -f $logfile_here ) {\r
- rename $logfile_here, $logfile_bak;\r
- }\r
- rename $tmpfile, $logfile_here;\r
- }\r
- }\r
-}\r
-\r
-# -------------------------------------\r
-\r
-# Don't call this wrap, because with 5.5.3, that clashes with the\r
-# (unconditional :-( ) export of wrap() from Text::Wrap\r
-sub mywrap {\r
- my $self = shift;\r
- my ($indent1, $indent2, @text) = @_;\r
- # If incoming text looks preformatted, don't get clever\r
- my $text = Text::Wrap::wrap($indent1, $indent2, @text);\r
- if ( grep /^\s+/m, @text ) {\r
- return $text;\r
- }\r
- my @lines = split /\n/, $text;\r
- $indent2 =~ s!^((?: {8})+)!"\t" x (length($1)/8)!e;\r
- $lines[0] =~ s/^$indent1\s+/$indent1/;\r
- s/^$indent2\s+/$indent2/\r
- for @lines[1..$#lines];\r
- my $newtext = join "\n", @lines;\r
- $newtext .= "\n"\r
- if substr($text, -1) eq "\n";\r
- return $newtext;\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub preprocess_msg_text {\r
- my $self = shift;\r
- my ($text) = @_;\r
-\r
- # Strip out carriage returns (as they probably result from DOSsy editors).\r
- $text =~ s/\r\n/\n/g;\r
- # If it *looks* like two newlines, make it *be* two newlines:\r
- $text =~ s/\n\s*\n/\n\n/g;\r
-\r
- return $text;\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub last_line_len {\r
- my $self = shift;\r
-\r
- my $files_list = shift;\r
- my @lines = split (/\n/, $files_list);\r
- my $last_line = pop (@lines);\r
- return length ($last_line);\r
-}\r
-\r
-# -------------------------------------\r
-\r
-# A custom wrap function, sensitive to some common constructs used in\r
-# log entries.\r
-sub wrap_log_entry {\r
- my $self = shift;\r
-\r
- my $text = shift; # The text to wrap.\r
- my $left_pad_str = shift; # String to pad with on the left.\r
-\r
- # These do NOT take left_pad_str into account:\r
- my $length_remaining = shift; # Amount left on current line.\r
- my $max_line_length = shift; # Amount left for a blank line.\r
-\r
- my $wrapped_text = ''; # The accumulating wrapped entry.\r
- my $user_indent = ''; # Inherited user_indent from prev line.\r
-\r
- my $first_time = 1; # First iteration of the loop?\r
- my $suppress_line_start_match = 0; # Set to disable line start checks.\r
-\r
- my @lines = split (/\n/, $text);\r
- while (@lines) # Don't use `foreach' here, it won't work.\r
- {\r
- my $this_line = shift (@lines);\r
- chomp $this_line;\r
-\r
- if ($this_line =~ /^(\s+)/) {\r
- $user_indent = $1;\r
- }\r
- else {\r
- $user_indent = '';\r
- }\r
-\r
- # If it matches any of the line-start regexps, print a newline now...\r
- if ($suppress_line_start_match)\r
- {\r
- $suppress_line_start_match = 0;\r
- }\r
- elsif (($this_line =~ /^(\s*)\*\s+[a-zA-Z0-9]/)\r
- || ($this_line =~ /^(\s*)\* [a-zA-Z0-9_\.\/\+-]+/)\r
- || ($this_line =~ /^(\s*)\([a-zA-Z0-9_\.\/\+-]+(\)|,\s*)/)\r
- || ($this_line =~ /^(\s+)(\S+)/)\r
- || ($this_line =~ /^(\s*)- +/)\r
- || ($this_line =~ /^()\s*$/)\r
- || ($this_line =~ /^(\s*)\*\) +/)\r
- || ($this_line =~ /^(\s*)[a-zA-Z0-9](\)|\.|\:) +/))\r
- {\r
- # Make a line break immediately, unless header separator is set\r
- # and this line is the first line in the entry, in which case\r
- # we're getting the blank line for free already and shouldn't\r
- # add an extra one.\r
- unless (($After_Header ne " ") and ($first_time))\r
- {\r
- if ($this_line =~ /^()\s*$/) {\r
- $suppress_line_start_match = 1;\r
- $wrapped_text .= "\n${left_pad_str}";\r
- }\r
-\r
- $wrapped_text .= "\n${left_pad_str}";\r
- }\r
-\r
- $length_remaining = $max_line_length - (length ($user_indent));\r
- }\r
-\r
- # Now that any user_indent has been preserved, strip off leading\r
- # whitespace, so up-folding has no ugly side-effects.\r
- $this_line =~ s/^\s*//;\r
-\r
- # Accumulate the line, and adjust parameters for next line.\r
- my $this_len = length ($this_line);\r
- if ($this_len == 0)\r
- {\r
- # Blank lines should cancel any user_indent level.\r
- $user_indent = '';\r
- $length_remaining = $max_line_length;\r
- }\r
- elsif ($this_len >= $length_remaining) # Line too long, try breaking it.\r
- {\r
- # Walk backwards from the end. At first acceptable spot, break\r
- # a new line.\r
- my $idx = $length_remaining - 1;\r
- if ($idx < 0) { $idx = 0 };\r
- while ($idx > 0)\r
- {\r
- if (substr ($this_line, $idx, 1) =~ /\s/)\r
- {\r
- my $line_now = substr ($this_line, 0, $idx);\r
- my $next_line = substr ($this_line, $idx);\r
- $this_line = $line_now;\r
-\r
- # Clean whitespace off the end.\r
- chomp $this_line;\r
-\r
- # The current line is ready to be printed.\r
- $this_line .= "\n${left_pad_str}";\r
-\r
- # Make sure the next line is allowed full room.\r
- $length_remaining = $max_line_length - (length ($user_indent));\r
-\r
- # Strip next_line, but then preserve any user_indent.\r
- $next_line =~ s/^\s*//;\r
-\r
- # Sneak a peek at the user_indent of the upcoming line, so\r
- # $next_line (which will now precede it) can inherit that\r
- # indent level. Otherwise, use whatever user_indent level\r
- # we currently have, which might be none.\r
- my $next_next_line = shift (@lines);\r
- if ((defined ($next_next_line)) && ($next_next_line =~ /^(\s+)/)) {\r
- $next_line = $1 . $next_line if (defined ($1));\r
- # $length_remaining = $max_line_length - (length ($1));\r
- $next_next_line =~ s/^\s*//;\r
- }\r
- else {\r
- $next_line = $user_indent . $next_line;\r
- }\r
- if (defined ($next_next_line)) {\r
- unshift (@lines, $next_next_line);\r
- }\r
- unshift (@lines, $next_line);\r
-\r
- # Our new next line might, coincidentally, begin with one of\r
- # the line-start regexps, so we temporarily turn off\r
- # sensitivity to that until we're past the line.\r
- $suppress_line_start_match = 1;\r
-\r
- last;\r
- }\r
- else\r
- {\r
- $idx--;\r
- }\r
- }\r
-\r
- if ($idx == 0)\r
- {\r
- # We bottomed out because the line is longer than the\r
- # available space. But that could be because the space is\r
- # small, or because the line is longer than even the maximum\r
- # possible space. Handle both cases below.\r
-\r
- if ($length_remaining == ($max_line_length - (length ($user_indent))))\r
- {\r
- # The line is simply too long -- there is no hope of ever\r
- # breaking it nicely, so just insert it verbatim, with\r
- # appropriate padding.\r
- $this_line = "\n${left_pad_str}${this_line}";\r
- }\r
- else\r
- {\r
- # Can't break it here, but may be able to on the next round...\r
- unshift (@lines, $this_line);\r
- $length_remaining = $max_line_length - (length ($user_indent));\r
- $this_line = "\n${left_pad_str}";\r
- }\r
- }\r
- }\r
- else # $this_len < $length_remaining, so tack on what we can.\r
- {\r
- # Leave a note for the next iteration.\r
- $length_remaining = $length_remaining - $this_len;\r
-\r
- if ($this_line =~ /\.$/)\r
- {\r
- $this_line .= " ";\r
- $length_remaining -= 2;\r
- }\r
- else # not a sentence end\r
- {\r
- $this_line .= " ";\r
- $length_remaining -= 1;\r
- }\r
- }\r
-\r
- # Unconditionally indicate that loop has run at least once.\r
- $first_time = 0;\r
-\r
- $wrapped_text .= "${user_indent}${this_line}";\r
- }\r
-\r
- # One last bit of padding.\r
- $wrapped_text .= "\n";\r
-\r
- return $wrapped_text;\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub _pretty_file_list {\r
- my $self = shift;\r
-\r
- my ($unanimous_tags, $non_unanimous_tags, $all_branches, $qunksref) = @_;\r
-\r
- my @qunkrefs =\r
- grep +( ( ! $_->tags_exists\r
- or\r
- ! grep exists $ignore_tags{$_}, @{$_->tags})\r
- and\r
- ( ! keys %show_tags\r
- or\r
- ( $_->tags_exists\r
- and\r
- grep exists $show_tags{$_}, @{$_->tags} )\r
- )\r
- ),\r
- @$qunksref;\r
-\r
- my $common_dir; # Dir prefix common to all files ('' if none)\r
-\r
- # First, loop over the qunks gathering all the tag/branch names.\r
- # We'll put them all in non_unanimous_tags, and take out the\r
- # unanimous ones later.\r
- QUNKREF:\r
- foreach my $qunkref (@qunkrefs)\r
- {\r
- # Keep track of whether all the files in this commit were in the\r
- # same directory, and memorize it if so. We can make the output a\r
- # little more compact by mentioning the directory only once.\r
- if ($Common_Dir && (scalar (@qunkrefs)) > 1)\r
- {\r
- if (! (defined ($common_dir)))\r
- {\r
- my ($base, $dir);\r
- ($base, $dir, undef) = fileparse ($qunkref->filename);\r
-\r
- if ((! (defined ($dir))) # this first case is sheer paranoia\r
- or ($dir eq '')\r
- or ($dir eq "./")\r
- or ($dir eq ".\\"))\r
- {\r
- $common_dir = '';\r
- }\r
- else\r
- {\r
- $common_dir = $dir;\r
- }\r
- }\r
- elsif ($common_dir ne '')\r
- {\r
- # Already have a common dir prefix, so how much of it can we preserve?\r
- $common_dir = &main::common_path_prefix ($qunkref->filename, $common_dir);\r
- }\r
- }\r
- else # only one file in this entry anyway, so common dir not an issue\r
- {\r
- $common_dir = '';\r
- }\r
-\r
- if (defined ($qunkref->branch)) {\r
- $all_branches->{$qunkref->branch} = 1;\r
- }\r
- if (defined ($qunkref->tags)) {\r
- foreach my $tag (@{$qunkref->tags}) {\r
- $non_unanimous_tags->{$tag} = 1;\r
- }\r
- }\r
- }\r
-\r
- # Any tag held by all qunks will be printed specially... but only if\r
- # there are multiple qunks in the first place!\r
- if ((scalar (@qunkrefs)) > 1) {\r
- foreach my $tag (keys (%$non_unanimous_tags)) {\r
- my $everyone_has_this_tag = 1;\r
- foreach my $qunkref (@qunkrefs) {\r
- if ((! (defined ($qunkref->tags)))\r
- or (! (grep ($_ eq $tag, @{$qunkref->tags})))) {\r
- $everyone_has_this_tag = 0;\r
- }\r
- }\r
- if ($everyone_has_this_tag) {\r
- $unanimous_tags->{$tag} = 1;\r
- delete $non_unanimous_tags->{$tag};\r
- }\r
- }\r
- }\r
-\r
- return $common_dir, \@qunkrefs;\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub fdatetime {\r
- my $self = shift;\r
-\r
- my ($year, $mday, $mon, $wday, $hour, $min);\r
-\r
- if ( @_ > 1 ) {\r
- ($year, $mday, $mon, $wday, $hour, $min) = @_;\r
- } else {\r
- my ($time) = @_;\r
- (undef, $min, $hour, $mday, $mon, $year, $wday) =\r
- $UTC_Times ? gmtime($time) : localtime($time);\r
-\r
- $year += 1900;\r
- $mon += 1;\r
- $wday = $self->wday($wday);\r
- }\r
-\r
- my $fdate = $self->fdate($year, $mon, $mday, $wday);\r
-\r
- if ($Show_Times) {\r
- my $ftime = $self->ftime($hour, $min);\r
- return "$fdate $ftime";\r
- } else {\r
- return $fdate;\r
- }\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub fdate {\r
- my $self = shift;\r
-\r
- my ($year, $mday, $mon, $wday);\r
-\r
- if ( @_ > 1 ) {\r
- ($year, $mon, $mday, $wday) = @_;\r
- } else {\r
- my ($time) = @_;\r
- (undef, undef, undef, $mday, $mon, $year, $wday) =\r
- $UTC_Times ? gmtime($time) : localtime($time);\r
-\r
- $year += 1900;\r
- $mon += 1;\r
- $wday = $self->wday($wday);\r
- }\r
-\r
- return sprintf '%4u-%02u-%02u%s', $year, $mon, $mday, $wday;\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub ftime {\r
- my $self = shift;\r
-\r
- my ($hour, $min);\r
-\r
- if ( @_ > 1 ) {\r
- ($hour, $min) = @_;\r
- } else {\r
- my ($time) = @_;\r
- (undef, $min, $hour) = $UTC_Times ? gmtime($time) : localtime($time);\r
- }\r
-\r
- return sprintf '%02u:%02u', $hour, $min;\r
-}\r
-\r
-# ----------------------------------------------------------------------------\r
-\r
-package CVS::Utils::ChangeLog::Message;\r
-\r
-sub new {\r
- my $class = shift;\r
- my ($msg) = @_;\r
-\r
- my %self = (msg => $msg, files => []);\r
-\r
- bless \%self, $class;\r
-}\r
-\r
-sub add_fileentry {\r
- my $self = shift;\r
- my ($fileentry) = @_;\r
-\r
- die "Not a fileentry: $fileentry"\r
- unless $fileentry->isa('CVS::Utils::ChangeLog::FileEntry');\r
-\r
- push @{$self->{files}}, $fileentry;\r
-}\r
-\r
-sub files { wantarray ? @{$_[0]->{files}} : $_[0]->{files} }\r
-\r
-# ----------------------------------------------------------------------------\r
-\r
-package CVS::Utils::ChangeLog::FileEntry;\r
-\r
-use File::Basename qw( fileparse );\r
-\r
-# Each revision of a file has a little data structure (a `qunk')\r
-# associated with it. That data structure holds not only the\r
-# file's name, but any additional information about the file\r
-# that might be needed in the output, such as the revision\r
-# number, tags, branches, etc. The reason to have these things\r
-# arranged in a data structure, instead of just appending them\r
-# textually to the file's name, is that we may want to do a\r
-# little rearranging later as we write the output. For example,\r
-# all the files on a given tag/branch will go together, followed\r
-# by the tag in parentheses (so trunk or otherwise non-tagged\r
-# files would go at the end of the file list for a given log\r
-# message). This rearrangement is a lot easier to do if we\r
-# don't have to reparse the text.\r
-#\r
-# A qunk looks like this:\r
-#\r
-# {\r
-# filename => "hello.c",\r
-# revision => "1.4.3.2",\r
-# time => a timegm() return value (moment of commit)\r
-# tags => [ "tag1", "tag2", ... ],\r
-# branch => "branchname" # There should be only one, right?\r
-# roots => [ "branchtag1", "branchtag2", ... ]\r
-# lines => "+x -y" # or undefined; x and y are integers\r
-# }\r
-\r
-# Single top-level ChangeLog, or one per subdirectory?\r
-my $distributed;\r
-sub distributed { $#_ ? ($distributed = $_[1]) : $distributed; }\r
-\r
-sub new {\r
- my $class = shift;\r
- my ($path, $time, $revision, $state, $lines,\r
- $branch_names, $branch_roots, $branch_numbers, $symbolic_names) = @_;\r
-\r
- my %self = (time => $time,\r
- revision => $revision,\r
- state => $state,\r
- lines => $lines,\r
- branch_numbers => $branch_numbers,\r
- );\r
-\r
- if ( $distributed ) {\r
- @self{qw(filename dir_key)} = fileparse($path);\r
- } else {\r
- @self{qw(filename dir_key)} = ($path, './');\r
- }\r
-\r
- { # Scope for $branch_prefix\r
- (my ($branch_prefix) = ($revision =~ /((?:\d+\.)+)\d+/));\r
- $branch_prefix =~ s/\.$//;\r
- if ( $branch_names->{$branch_prefix} ) {\r
- my $branch_name = $branch_names->{$branch_prefix};\r
- $self{branch} = $branch_name;\r
- $self{branches} = [$branch_name];\r
- }\r
- while ( $branch_prefix =~ s/^(\d+(?:\.\d+\.\d+)+)\.\d+\.\d+$/$1/ ) {\r
- push @{$self{branches}}, $branch_names->{$branch_prefix}\r
- if exists $branch_names->{$branch_prefix};\r
- }\r
- }\r
-\r
- # If there's anything in the @branch_roots array, then this\r
- # revision is the root of at least one branch. We'll display\r
- # them as branch names instead of revision numbers, the\r
- # substitution for which is done directly in the array:\r
- $self{'roots'} = [ map { $branch_names->{$_} } @$branch_roots ]\r
- if @$branch_roots;\r
-\r
- if ( exists $symbolic_names->{$revision} ) {\r
- $self{tags} = delete $symbolic_names->{$revision};\r
- &main::delta_check($time, $self{tags});\r
- }\r
-\r
- bless \%self, $class;\r
-}\r
-\r
-sub filename { $_[0]->{filename} }\r
-sub dir_key { $_[0]->{dir_key} }\r
-sub revision { $_[0]->{revision} }\r
-sub branch { $_[0]->{branch} }\r
-sub state { $_[0]->{state} }\r
-sub lines { $_[0]->{lines} }\r
-sub roots { $_[0]->{roots} }\r
-sub branch_numbers { $_[0]->{branch_numbers} }\r
-\r
-sub tags { $_[0]->{tags} }\r
-sub tags_exists {\r
- exists $_[0]->{tags};\r
-}\r
-\r
-# This may someday be used in a more sophisticated calculation of what other\r
-# files are involved in this commit. For now, we don't use it much except for\r
-# delta mode, because the common-commit-detection algorithm is hypothesized to\r
-# be "good enough" as it stands.\r
-sub time { $_[0]->{time} }\r
-\r
-# ----------------------------------------------------------------------------\r
-\r
-package CVS::Utils::ChangeLog::EntrySetBuilder;\r
-\r
-use File::Basename qw( fileparse );\r
-use Time::Local qw( timegm );\r
-\r
-use constant MAILNAME => "/etc/mailname";\r
-\r
-# In 'cvs log' output, one long unbroken line of equal signs separates files:\r
-use constant FILE_SEPARATOR => '=' x 77;# . "\n";\r
-# In 'cvs log' output, a shorter line of dashes separates log messages within\r
-# a file:\r
-use constant REV_SEPARATOR => '-' x 28;# . "\n";\r
-\r
-use constant EMPTY_LOG_MESSAGE => '*** empty log message ***';\r
-\r
-# -------------------------------------\r
-\r
-sub new {\r
- my ($proto) = @_;\r
- my $class = ref $proto || $proto;\r
-\r
- my $poobah = CVS::Utils::ChangeLog::EntrySet->new;\r
- my $self = bless +{ grand_poobah => $poobah }, $class;\r
-\r
- $self->clear_file;\r
- $self->maybe_read_user_map_file;\r
- return $self;\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub clear_msg {\r
- my ($self) = @_;\r
-\r
- # Make way for the next message\r
- undef $self->{rev_msg};\r
- undef $self->{rev_time};\r
- undef $self->{rev_revision};\r
- undef $self->{rev_author};\r
- undef $self->{rev_state};\r
- undef $self->{lines};\r
- $self->{rev_branch_roots} = []; # For showing which files are branch\r
- # ancestors.\r
- $self->{collecting_symbolic_names} = 0;\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub clear_file {\r
- my ($self) = @_;\r
- $self->clear_msg;\r
-\r
- undef $self->{filename};\r
- $self->{branch_names} = +{}; # We'll grab branch names while we're\r
- # at it.\r
- $self->{branch_numbers} = +{}; # Save some revisions for\r
- # @Follow_Branches\r
- $self->{symbolic_names} = +{}; # Where tag names get stored.\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub grand_poobah { $_[0]->{grand_poobah} }\r
-\r
-# -------------------------------------\r
-\r
-sub read_changelog {\r
- my ($self, $command) = @_;\r
-\r
-# my $grand_poobah = CVS::Utils::ChangeLog::EntrySet->new;\r
-\r
- if (! $Input_From_Stdin) {\r
- my $Log_Source_Command = join(' ', @$command);\r
- &main::debug ("(run \"${Log_Source_Command}\")\n");\r
- open (LOG_SOURCE, "$Log_Source_Command |")\r
- or die "unable to run \"${Log_Source_Command}\"";\r
- }\r
- else {\r
- open (LOG_SOURCE, "-") or die "unable to open stdin for reading";\r
- }\r
-\r
- binmode LOG_SOURCE;\r
-\r
- XX_Log_Source:\r
- while (<LOG_SOURCE>) {\r
- chomp;\r
- s!\r$!!;\r
-\r
- # If on a new file and don't see filename, skip until we find it, and\r
- # when we find it, grab it.\r
- if ( ! defined $self->{filename} ) {\r
- $self->read_file_path($_);\r
- } elsif ( /^symbolic names:$/ ) {\r
- $self->{collecting_symbolic_names} = 1;\r
- } elsif ( $self->{collecting_symbolic_names} ) {\r
- $self->read_symbolic_name($_);\r
- } elsif ( $_ eq FILE_SEPARATOR and ! defined $self->{rev_revision} ) {\r
- $self->clear_file;\r
- } elsif ( ! defined $self->{rev_revision} ) {\r
- # If have file name, but not revision, and see revision, then grab\r
- # it. (We collect unconditionally, even though we may or may not\r
- # ever use it.)\r
- $self->read_revision($_);\r
- } elsif ( ! defined $self->{rev_time} ) { # and /^date: /) {\r
- $self->read_date_author_and_state($_);\r
- } elsif ( /^branches:\s+(.*);$/ ) {\r
- $self->read_branches($1);\r
- } elsif ( ! ( $_ eq FILE_SEPARATOR or $_ eq REV_SEPARATOR ) ) {\r
- # If have file name, time, and author, then we're just grabbing\r
- # log message texts:\r
- $self->{rev_msg} .= $_ . "\n"; # Normally, just accumulate the message...\r
- } else {\r
- if ( ! $self->{rev_msg}\r
- or $self->{rev_msg} =~ /^\s*(\.\s*)?$/\r
- or index($self->{rev_msg}, EMPTY_LOG_MESSAGE) > -1 ) {\r
- # ... until a msg separator is encountered:\r
- # Ensure the message contains something:\r
- $self->clear_msg\r
- if $Prune_Empty_Msgs;\r
- $self->{rev_msg} = "[no log message]\n";\r
- }\r
-\r
- $self->add_file_entry;\r
-\r
- if ( $_ eq FILE_SEPARATOR ) {\r
- $self->clear_file;\r
- } else {\r
- $self->clear_msg;\r
- }\r
- }\r
- }\r
-\r
- close LOG_SOURCE\r
- or die sprintf("Problem reading log input (exit/signal/core: %d/%d/%d)\n",\r
- $? >> 8, $? & 127, $? & 128);\r
- return;\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub add_file_entry {\r
- $_[0]->grand_poobah->add_fileentry(@{$_[0]}{qw(filename rev_time rev_revision\r
- rev_state lines branch_names\r
- rev_branch_roots\r
- branch_numbers\r
- symbolic_names\r
- rev_author rev_msg)});\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub maybe_read_user_map_file {\r
- my ($self) = @_;\r
-\r
- my %expansions;\r
- my $User_Map_Input;\r
-\r
- if ($User_Map_File)\r
- {\r
- if ( $User_Map_File =~ m{^([-\w\@+=.,\/]+):([-\w\@+=.,\/:]+)} and\r
- !-f $User_Map_File )\r
- {\r
- my $rsh = (exists $ENV{'CVS_RSH'} ? $ENV{'CVS_RSH'} : 'ssh');\r
- $User_Map_Input = "$rsh $1 'cat $2' |";\r
- &main::debug ("(run \"${User_Map_Input}\")\n");\r
- }\r
- else\r
- {\r
- $User_Map_Input = "<$User_Map_File";\r
- }\r
-\r
- open (MAPFILE, $User_Map_Input)\r
- or die ("Unable to open $User_Map_File ($!)");\r
-\r
- while (<MAPFILE>)\r
- {\r
- next if /^\s*#/; # Skip comment lines.\r
- next if not /:/; # Skip lines without colons.\r
-\r
- # It is now safe to split on ':'.\r
- my ($username, $expansion) = split ':';\r
- chomp $expansion;\r
- $expansion =~ s/^'(.*)'$/$1/;\r
- $expansion =~ s/^"(.*)"$/$1/;\r
-\r
- # If it looks like the expansion has a real name already, then\r
- # we toss the username we got from CVS log. Otherwise, keep\r
- # it to use in combination with the email address.\r
-\r
- if ($expansion =~ /^\s*<{0,1}\S+@.*/) {\r
- # Also, add angle brackets if none present\r
- if (! ($expansion =~ /<\S+@\S+>/)) {\r
- $expansions{$username} = "$username <$expansion>";\r
- }\r
- else {\r
- $expansions{$username} = "$username $expansion";\r
- }\r
- }\r
- else {\r
- $expansions{$username} = $expansion;\r
- }\r
- } # fi ($User_Map_File)\r
-\r
- close (MAPFILE);\r
- }\r
-\r
- if (defined $User_Passwd_File)\r
- {\r
- if ( ! defined $Domain ) {\r
- if ( -e MAILNAME ) {\r
- chomp($Domain = slurp_file(MAILNAME));\r
- } else {\r
- MAILDOMAIN_CMD:\r
- for ([qw(hostname -d)], 'dnsdomainname', 'domainname') {\r
- my ($text, $exit, $sig, $core) = run_ext($_);\r
- if ( $exit == 0 && $sig == 0 && $core == 0 ) {\r
- chomp $text;\r
- if ( length $text ) {\r
- $Domain = $text;\r
- last MAILDOMAIN_CMD;\r
- }\r
- }\r
- }\r
- }\r
- }\r
-\r
- die "No mail domain found\n"\r
- unless defined $Domain;\r
-\r
- open (MAPFILE, "<$User_Passwd_File")\r
- or die ("Unable to open $User_Passwd_File ($!)");\r
- while (<MAPFILE>)\r
- {\r
- # all lines are valid\r
- my ($username, $pw, $uid, $gid, $gecos, $homedir, $shell) = split ':';\r
- my $expansion = '';\r
- ($expansion) = split (',', $gecos)\r
- if defined $gecos && length $gecos;\r
-\r
- my $mailname = $Domain eq '' ? $username : "$username\@$Domain";\r
- $expansions{$username} = "$expansion <$mailname>";\r
- }\r
- close (MAPFILE);\r
- }\r
-\r
- $self->{usermap} = \%expansions;\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub read_file_path {\r
- my ($self, $line) = @_;\r
-\r
- my $path;\r
-\r
- if ( $line =~ /^Working file: (.*)/ ) {\r
- $path = $1;\r
- } elsif ( defined $RCS_Root\r
- and\r
- $line =~ m|^RCS file: $RCS_Root[/\\](.*),v$| ) {\r
- $path = $1;\r
- $path =~ s!Attic/!!;\r
- } else {\r
- return;\r
- }\r
-\r
- if ( @Ignore_Files ) {\r
- my $base;\r
- ($base, undef, undef) = fileparse($path);\r
-\r
- my $xpath = $Case_Insensitive ? lc($path) : $path;\r
- if ( grep index($path, $_) > -1, @Ignore_Files ) {\r
- return;\r
- }\r
- }\r
-\r
- $self->{filename} = $path;\r
- return;\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub read_symbolic_name {\r
- my ($self, $line) = @_;\r
-\r
- # All tag names are listed with whitespace in front in cvs log\r
- # output; so if see non-whitespace, then we're done collecting.\r
- if ( /^\S/ ) {\r
- $self->{collecting_symbolic_names} = 0;\r
- return;\r
- } else {\r
- # we're looking at a tag name, so parse & store it\r
-\r
- # According to the Cederqvist manual, in node "Tags", tag names must start\r
- # with an uppercase or lowercase letter and can contain uppercase and\r
- # lowercase letters, digits, `-', and `_'. However, it's not our place to\r
- # enforce that, so we'll allow anything CVS hands us to be a tag:\r
- my ($tag_name, $tag_rev) = ($line =~ /^\s+([^:]+): ([\d.]+)$/);\r
-\r
- # A branch number either has an odd number of digit sections\r
- # (and hence an even number of dots), or has ".0." as the\r
- # second-to-last digit section. Test for these conditions.\r
- my $real_branch_rev = '';\r
- if ( $tag_rev =~ /^(\d+\.\d+\.)+\d+$/ # Even number of dots...\r
- and\r
- $tag_rev !~ /^(1\.)+1$/ ) { # ...but not "1.[1.]1"\r
- $real_branch_rev = $tag_rev;\r
- } elsif ($tag_rev =~ /(\d+\.(\d+\.)+)0.(\d+)/) { # Has ".0."\r
- $real_branch_rev = $1 . $3;\r
- }\r
-\r
- # If we got a branch, record its number.\r
- if ( $real_branch_rev ) {\r
- $self->{branch_names}->{$real_branch_rev} = $tag_name;\r
- $self->{branch_numbers}->{$tag_name} = $real_branch_rev;\r
- } else {\r
- # Else it's just a regular (non-branch) tag.\r
- push @{$self->{symbolic_names}->{$tag_rev}}, $tag_name;\r
- }\r
- }\r
-\r
- $self->{collecting_symbolic_names} = 1;\r
- return;\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub read_revision {\r
- my ($self, $line) = @_;\r
-\r
- my ($revision) = ( $line =~ /^revision (\d+\.[\d.]+)/ );\r
-\r
- return\r
- unless $revision;\r
-\r
- $self->{rev_revision} = $revision;\r
- return;\r
-}\r
-\r
-# -------------------------------------\r
-\r
-{ # Closure over %gecos_warned\r
-my %gecos_warned;\r
-sub read_date_author_and_state {\r
- my ($self, $line) = @_;\r
-\r
- my ($time, $author, $state) = $self->parse_date_author_and_state($line);\r
-\r
- if ( defined($self->{usermap}->{$author}) and $self->{usermap}->{$author} ) {\r
- $author = $self->{usermap}->{$author};\r
- } elsif ( defined $Domain or $Gecos == 1 ) {\r
- my $email = $author;\r
- $email = $author."@".$Domain\r
- if defined $Domain && $Domain ne '';\r
-\r
- my $pw = getpwnam($author);\r
- my ($fullname, $office, $workphone, $homephone, $gcos);\r
- if ( defined $pw ) {\r
- $gcos = (getpwnam($author))[6];\r
- ($fullname, $office, $workphone, $homephone) =\r
- split /\s*,\s*/, $gcos;\r
- } else {\r
- warn "Couldn't find gecos info for author '$author'\n"\r
- unless $gecos_warned{$author}++;\r
- $fullname = '';\r
- }\r
- for (grep defined, $fullname, $office, $workphone, $homephone) {\r
- s/&/ucfirst(lc($pw->name))/ge;\r
- }\r
- $author = $fullname . " <" . $email . ">"\r
- if $fullname ne '';\r
- }\r
-\r
- $self->{rev_state} = $state;\r
- $self->{rev_time} = $time;\r
- $self->{rev_author} = $author;\r
- return;\r
-}\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub read_branches {\r
- # A "branches: ..." line here indicates that one or more branches\r
- # are rooted at this revision. If we're showing branches, then we\r
- # want to show that fact as well, so we collect all the branches\r
- # that this is the latest ancestor of and store them in\r
- # $self->[rev_branch_roots}. Just for reference, the format of the\r
- # line we're seeing at this point is:\r
- #\r
- # branches: 1.5.2; 1.5.4; ...;\r
- #\r
- # Okay, here goes:\r
- my ($self, $line) = @_;\r
-\r
- # Ugh. This really bothers me. Suppose we see a log entry\r
- # like this:\r
- #\r
- # ----------------------------\r
- # revision 1.1\r
- # date: 1999/10/17 03:07:38; author: jrandom; state: Exp;\r
- # branches: 1.1.2;\r
- # Intended first line of log message begins here.\r
- # ----------------------------\r
- #\r
- # The question is, how we can tell the difference between that\r
- # log message and a *two*-line log message whose first line is\r
- #\r
- # "branches: 1.1.2;"\r
- #\r
- # See the problem? The output of "cvs log" is inherently\r
- # ambiguous.\r
- #\r
- # For now, we punt: we liberally assume that people don't\r
- # write log messages like that, and just toss a "branches:"\r
- # line if we see it but are not showing branches. I hope no\r
- # one ever loses real log data because of this.\r
- if ( $Show_Branches ) {\r
- $line =~ s/(1\.)+1;|(1\.)+1$//; # ignore the trivial branch 1.1.1\r
- $self->{rev_branch_roots} = [split /;\s+/, $line]\r
- if length $line;\r
- }\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub parse_date_author_and_state {\r
- my ($self, $line) = @_;\r
- # Parses the date/time and author out of a line like:\r
- #\r
- # date: 1999/02/19 23:29:05; author: apharris; state: Exp;\r
- #\r
- # or, in CVS 1.12.9:\r
- #\r
- # date: 2004-06-05 16:10:32 +0000; author: somebody; state: Exp;\r
-\r
- my ($year, $mon, $mday, $hours, $min, $secs, $utcOffset, $author, $state, $rest) =\r
- $line =~\r
- m!(\d+)[-/](\d+)[-/](\d+)\s+(\d+):(\d+):(\d+)(\s+[+-]\d{4})?;\s+\r
- author:\s+([^;]+);\s+state:\s+([^;]+);(.*)!x\r
- or die "Couldn't parse date ``$line''";\r
- die "Bad date or Y2K issues"\r
- unless $year > 1969 and $year < 2258;\r
- # Kinda arbitrary, but useful as a sanity check\r
- my $time = timegm($secs, $min, $hours, $mday, $mon-1, $year-1900);\r
- if ( defined $utcOffset ) {\r
- my ($plusminus, $hour, $minute) = ($utcOffset =~ m/([+-])(\d\d)(\d\d)/);\r
- my $offset = (($hour * 60) + $minute) * 60 * ($plusminus eq '+' ? -1 : 1);\r
- $time += $offset;\r
- }\r
- if ( $rest =~ m!\s+lines:\s+(.*)! ) {\r
- $self->{lines} = $1;\r
- }\r
-\r
- return $time, $author, $state;\r
-}\r
-\r
-# Subrs ----------------------------------------------------------------------\r
-\r
-package main;\r
-\r
-sub delta_check {\r
- my ($time, $tags) = @_;\r
-\r
- # If we're in 'delta' mode, update the latest observed times for the\r
- # beginning and ending tags, and when we get around to printing output, we\r
- # will simply restrict ourselves to that timeframe...\r
- return\r
- unless $Delta_Mode;\r
-\r
- $Delta_StartTime = $time\r
- if $time > $Delta_StartTime and grep { $_ eq $Delta_From } @$tags;\r
-\r
- $Delta_EndTime = $time\r
- if $time > $Delta_EndTime and grep { $_ eq $Delta_To } @$tags;\r
-}\r
-\r
-sub run_ext {\r
- my ($cmd) = @_;\r
- $cmd = [$cmd]\r
- unless ref $cmd;\r
- local $" = ' ';\r
- my $out = qx"@$cmd 2>&1";\r
- my $rv = $?;\r
- my ($sig, $core, $exit) = ($? & 127, $? & 128, $? >> 8);\r
- return $out, $exit, $sig, $core;\r
-}\r
-\r
-# -------------------------------------\r
-\r
-# If accumulating, grab the boundary date from pre-existing ChangeLog.\r
-sub maybe_grab_accumulation_date {\r
- if (! $Cumulative || $Update) {\r
- return '';\r
- }\r
-\r
- # else\r
-\r
- open (LOG, "$Log_File_Name")\r
- or die ("trouble opening $Log_File_Name for reading ($!)");\r
-\r
- my $boundary_date;\r
- while (<LOG>)\r
- {\r
- if (/^(\d\d\d\d-\d\d-\d\d\s+\d\d:\d\d)/)\r
- {\r
- $boundary_date = "$1";\r
- last;\r
- }\r
- }\r
-\r
- close (LOG);\r
-\r
- # convert time from utc to local timezone if the ChangeLog has\r
- # dates/times in utc\r
- if ($UTC_Times && $boundary_date)\r
- {\r
- # convert the utc time to a time value\r
- my ($year,$mon,$mday,$hour,$min) = $boundary_date =~\r
- m#(\d+)-(\d+)-(\d+)\s+(\d+):(\d+)#;\r
- my $time = timegm(0,$min,$hour,$mday,$mon-1,$year-1900);\r
- # print the timevalue in the local timezone\r
- my ($ignore,$wday);\r
- ($ignore,$min,$hour,$mday,$mon,$year,$wday) = localtime($time);\r
- $boundary_date=sprintf ("%4u-%02u-%02u %02u:%02u",\r
- $year+1900,$mon+1,$mday,$hour,$min);\r
- }\r
-\r
- return $boundary_date;\r
-}\r
-\r
-# -------------------------------------\r
-\r
-# Fills up a ChangeLog structure in the current directory.\r
-sub derive_changelog {\r
- my ($command) = @_;\r
-\r
- # See "The Plan" above for a full explanation.\r
-\r
- # Might be adding to an existing ChangeLog\r
- my $accumulation_date = maybe_grab_accumulation_date;\r
- if ($accumulation_date) {\r
- # Insert -d immediately after 'cvs log'\r
- my $Log_Date_Command = "-d\'>${accumulation_date}\'";\r
-\r
- my ($log_index) = grep $command->[$_] eq 'log', 0..$#$command;\r
- splice @$command, $log_index+1, 0, $Log_Date_Command;\r
- &debug ("(adding log msg starting from $accumulation_date)\n");\r
- }\r
-\r
-# output_changelog(read_changelog($command));\r
- my $builder = CVS::Utils::ChangeLog::EntrySetBuilder->new;\r
- $builder->read_changelog($command);\r
- $builder->grand_poobah->output_changelog;\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub min { $_[0] < $_[1] ? $_[0] : $_[1] }\r
-\r
-# -------------------------------------\r
-\r
-sub common_path_prefix {\r
- my ($path1, $path2) = @_;\r
-\r
- # For compatibility (with older versions of cvs2cl.pl), we think in UN*X\r
- # terms, and mould windoze filenames to match. Is this really appropriate?\r
- # If a file is checked in under UN*X, and cvs log run on windoze, which way\r
- # do the path separators slope? Can we use fileparse as per the local\r
- # conventions? If so, we should probably have a user option to specify an\r
- # OS to emulate to handle stdin-fed logs. If we did this, we could avoid\r
- # the nasty \-/ transmogrification below.\r
-\r
- my ($dir1, $dir2) = map +(fileparse($_))[1], $path1, $path2;\r
-\r
- # Transmogrify Windows filenames to look like Unix.\r
- # (It is far more likely that someone is running cvs2cl.pl under\r
- # Windows than that they would genuinely have backslashes in their\r
- # filenames.)\r
- tr!\\!/!\r
- for $dir1, $dir2;\r
-\r
- my ($accum1, $accum2, $last_common_prefix) = ('') x 3;\r
-\r
- my @path1 = grep length($_), split qr!/!, $dir1;\r
- my @path2 = grep length($_), split qr!/!, $dir2;\r
-\r
- my @common_path;\r
- for (0..min($#path1,$#path2)) {\r
- if ( $path1[$_] eq $path2[$_]) {\r
- push @common_path, $path1[$_];\r
- } else {\r
- last;\r
- }\r
- }\r
-\r
- return join '', map "$_/", @common_path;\r
-}\r
-\r
-# -------------------------------------\r
-sub parse_options {\r
- # Check this internally before setting the global variable.\r
- my $output_file;\r
-\r
- # If this gets set, we encountered unknown options and will exit at\r
- # the end of this subroutine.\r
- my $exit_with_admonishment = 0;\r
-\r
- # command to generate the log\r
- my @log_source_command = qw( cvs log );\r
-\r
- my (@Global_Opts, @Local_Opts);\r
-\r
- Getopt::Long::Configure(qw( bundling permute no_getopt_compat\r
- pass_through no_ignore_case ));\r
- GetOptions('help|usage|h' => \$Print_Usage,\r
- 'debug' => \$Debug, # unadvertised option, heh\r
- 'version' => \$Print_Version,\r
-\r
- 'file|f=s' => \$output_file,\r
- 'accum' => \$Cumulative,\r
- 'update' => \$Update,\r
- 'fsf' => \$FSF_Style,\r
- 'rcs=s' => \$RCS_Root,\r
- 'usermap|U=s' => \$User_Map_File,\r
- 'gecos' => \$Gecos,\r
- 'domain=s' => \$Domain,\r
- 'passwd=s' => \$User_Passwd_File,\r
- 'window|W=i' => \$Max_Checkin_Duration,\r
- 'chrono' => \$Chronological_Order,\r
- 'ignore|I=s' => \@Ignore_Files,\r
- 'case-insensitive|C' => \$Case_Insensitive,\r
- 'regexp|R=s' => \$Regexp_Gate,\r
- 'stdin' => \$Input_From_Stdin,\r
- 'stdout' => \$Output_To_Stdout,\r
- 'distributed|d' => sub { CVS::Utils::ChangeLog::FileEntry->distributed(1) },\r
- 'prune|P' => \$Prune_Empty_Msgs,\r
- 'no-wrap' => \$No_Wrap,\r
- 'gmt|utc' => \$UTC_Times,\r
- 'day-of-week|w' => \$Show_Day_Of_Week,\r
- 'revisions|r' => \$Show_Revisions,\r
- 'show-dead' => \$Show_Dead,\r
- 'tags|t' => \$Show_Tags,\r
- 'tagdates|T' => \$Show_Tag_Dates,\r
- 'branches|b' => \$Show_Branches,\r
- 'follow|F=s' => \@Follow_Branches,\r
- 'follow-only=s' => \@Follow_Only,\r
- 'xml-encoding=s' => \$XML_Encoding,\r
- 'xml' => \$XML_Output,\r
- 'noxmlns' => \$No_XML_Namespace,\r
- 'no-xml-iso-date' => \$No_XML_ISO_Date,\r
- 'no-ancestors' => \$No_Ancestors,\r
- 'lines-modified' => \$Show_Lines_Modified,\r
-\r
- 'no-indent' => sub {\r
- $Indent = '';\r
- },\r
-\r
- 'summary' => sub {\r
- $Summary = 1;\r
- $After_Header = "\n\n"; # Summary implies --separate-header\r
- },\r
-\r
- 'no-times' => sub {\r
- $Show_Times = 0;\r
- },\r
-\r
- 'no-hide-branch-additions' => sub {\r
- $Hide_Branch_Additions = 0;\r
- },\r
-\r
- 'no-common-dir' => sub {\r
- $Common_Dir = 0;\r
- },\r
-\r
- 'ignore-tag=s' => sub {\r
- $ignore_tags{$_[1]} = 1;\r
- },\r
-\r
- 'show-tag=s' => sub {\r
- $show_tags{$_[1]} = 1;\r
- },\r
-\r
- # Deliberately undocumented. This is not a public interface, and\r
- # may change/disappear at any time.\r
- 'test-code=s' => \$TestCode,\r
-\r
- 'delta=s' => sub {\r
- my $arg = $_[1];\r
- if ( $arg =~\r
- /^([A-Za-z][A-Za-z0-9_\-\]\[]*):([A-Za-z][A-Za-z0-9_\-\]\[]*)$/ ) {\r
- $Delta_From = $1;\r
- $Delta_To = $2;\r
- $Delta_Mode = 1;\r
- } else {\r
- die "--delta FROM_TAG:TO_TAG is what you meant to say.\n";\r
- }\r
- },\r
-\r
- 'FSF' => sub {\r
- $Show_Times = 0;\r
- $Common_Dir = 0;\r
- $No_Extra_Indent = 1;\r
- $Indent = "\t";\r
- },\r
-\r
- 'header=s' => sub {\r
- my $narg = $_[1];\r
- $ChangeLog_Header = &slurp_file ($narg);\r
- if (! defined ($ChangeLog_Header)) {\r
- $ChangeLog_Header = '';\r
- }\r
- },\r
-\r
- 'global-opts|g=s' => sub {\r
- my $narg = $_[1];\r
- push @Global_Opts, $narg;\r
- splice @log_source_command, 1, 0, $narg;\r
- },\r
-\r
- 'log-opts|l=s' => sub {\r
- my $narg = $_[1];\r
- push @Local_Opts, $narg;\r
- push @log_source_command, $narg;\r
- },\r
-\r
- 'mailname=s' => sub {\r
- my $narg = $_[1];\r
- warn "--mailname is deprecated; please use --domain instead\n";\r
- $Domain = $narg;\r
- },\r
-\r
- 'separate-header|S' => sub {\r
- $After_Header = "\n\n";\r
- $No_Extra_Indent = 1;\r
- },\r
-\r
- 'group-within-date' => sub {\r
- $GroupWithinDate = 1;\r
- $Show_Times = 0;\r
- },\r
-\r
- 'hide-filenames' => sub {\r
- $Hide_Filenames = 1;\r
- $After_Header = '';\r
- },\r
- )\r
- or die "options parsing failed\n";\r
-\r
- push @log_source_command, map "'$_'", @ARGV;\r
-\r
- ## Check for contradictions...\r
-\r
- if ($Output_To_Stdout && CVS::Utils::ChangeLog::FileEntry->distributed) {\r
- print STDERR "cannot pass both --stdout and --distributed\n";\r
- $exit_with_admonishment = 1;\r
- }\r
-\r
- if ($Output_To_Stdout && $output_file) {\r
- print STDERR "cannot pass both --stdout and --file\n";\r
- $exit_with_admonishment = 1;\r
- }\r
-\r
- if ($Input_From_Stdin && @Global_Opts) {\r
- print STDERR "cannot pass both --stdin and -g\n";\r
- $exit_with_admonishment = 1;\r
- }\r
-\r
- if ($Input_From_Stdin && @Local_Opts) {\r
- print STDERR "cannot pass both --stdin and -l\n";\r
- $exit_with_admonishment = 1;\r
- }\r
-\r
- if ($XML_Output && $Cumulative) {\r
- print STDERR "cannot pass both --xml and --accum\n";\r
- $exit_with_admonishment = 1;\r
- }\r
-\r
- # Other consistency checks and option-driven logic\r
-\r
- # Bleargh. Compensate for a deficiency of custom wrapping.\r
- if ( ($After_Header ne " ") and $FSF_Style ) {\r
- $After_Header .= "\t";\r
- }\r
-\r
- @Ignore_Files = map lc, @Ignore_Files\r
- if $Case_Insensitive;\r
-\r
- # Or if any other error message has already been printed out, we\r
- # just leave now:\r
- if ($exit_with_admonishment) {\r
- &usage ();\r
- exit (1);\r
- }\r
- elsif ($Print_Usage) {\r
- &usage ();\r
- exit (0);\r
- }\r
- elsif ($Print_Version) {\r
- &version ();\r
- exit (0);\r
- }\r
-\r
- ## Else no problems, so proceed.\r
-\r
- if ($output_file) {\r
- $Log_File_Name = $output_file;\r
- }\r
-\r
- return \@log_source_command;\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub slurp_file {\r
- my $filename = shift || die ("no filename passed to slurp_file()");\r
- my $retstr;\r
-\r
- open (SLURPEE, "<${filename}") or die ("unable to open $filename ($!)");\r
- local $/ = undef;\r
- $retstr = <SLURPEE>;\r
- close (SLURPEE);\r
- return $retstr;\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub debug {\r
- if ($Debug) {\r
- my $msg = shift;\r
- print STDERR $msg;\r
- }\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub version {\r
- print "cvs2cl.pl version ${VERSION}; distributed under the GNU GPL.\n";\r
-}\r
-\r
-# -------------------------------------\r
-\r
-sub usage {\r
- &version ();\r
-\r
- eval "use Pod::Usage qw( pod2usage )";\r
-\r
- if ( $@ ) {\r
- print <<'END';\r
-\r
-* Pod::Usage was not found. The formatting may be suboptimal. Consider\r
- upgrading your Perl --- Pod::Usage is standard from 5.6 onwards, and\r
- versions of perl prior to 5.6 are getting rather rusty, now. Alternatively,\r
- install Pod::Usage direct from CPAN.\r
-END\r
-\r
- local $/ = undef;\r
- my $message = <DATA>;\r
- $message =~ s/^=(head1|item) //gm;\r
- $message =~ s/^=(over|back).*\n//gm;\r
- $message =~ s/\n{3,}/\n\n/g;\r
- print $message;\r
- } else {\r
- print "\n";\r
- pod2usage( -exitval => 'NOEXIT',\r
- -verbose => 1,\r
- -output => \*STDOUT,\r
- );\r
- }\r
-\r
- return;\r
-}\r
-\r
-# Main -----------------------------------------------------------------------\r
-\r
-my $log_source_command = parse_options;\r
-if ( defined $TestCode ) {\r
- eval $TestCode;\r
- die "Eval failed: '$@'\n"\r
- if $@;\r
-} else {\r
- derive_changelog($log_source_command);\r
-}\r
-\r
-__DATA__\r
-\r
-=head1 NAME\r
-\r
-cvs2cl.pl - convert cvs log messages to changelogs\r
-\r
-=head1 SYNOPSIS\r
-\r
-B<cvs2cl> [I<options>] [I<FILE1> [I<FILE2> ...]]\r
-\r
-=head1 DESCRIPTION\r
-\r
-cvs2cl produces a GNU-style ChangeLog for CVS-controlled sources by\r
-running "cvs log" and parsing the output. Duplicate log messages get\r
-unified in the Right Way.\r
-\r
-The default output of cvs2cl is designed to be compact, formally unambiguous,\r
-but still easy for humans to read. It should be largely self-explanatory; the\r
-one abbreviation that might not be obvious is "utags". That stands for\r
-"universal tags" -- a universal tag is one held by all the files in a given\r
-change entry.\r
-\r
-If you need output that's easy for a program to parse, use the B<--xml> option.\r
-Note that with XML output, just about all available information is included\r
-with each change entry, whether you asked for it or not, on the theory that\r
-your parser can ignore anything it's not looking for.\r
-\r
-If filenames are given as arguments cvs2cl only shows log information for the\r
-named files.\r
-\r
-=head1 OPTIONS\r
-\r
-=over 4\r
-\r
-=item B<-h>, B<-help>, B<--help>, B<-?>\r
-\r
-Show a short help and exit.\r
-\r
-=item B<--version>\r
-\r
-Show version and exit.\r
-\r
-=item B<-r>, B<--revisions>\r
-\r
-Show revision numbers in output.\r
-\r
-=item B<-b>, B<--branches>\r
-\r
-Show branch names in revisions when possible.\r
-\r
-=item B<-t>, B<--tags>\r
-\r
-Show tags (symbolic names) in output.\r
-\r
-=item B<-T>, B<--tagdates>\r
-\r
-Show tags in output on their first occurance.\r
-\r
-=item B<--show-dead>\r
-\r
-Show dead files.\r
-\r
-=item B<--stdin>\r
-\r
-Read from stdin, don't run cvs log.\r
-\r
-=item B<--stdout>\r
-\r
-Output to stdout not to ChangeLog.\r
-\r
-=item B<-d>, B<--distributed>\r
-\r
-Put ChangeLogs in subdirs.\r
-\r
-=item B<-f> I<FILE>, B<--file> I<FILE>\r
-\r
-Write to I<FILE> instead of ChangeLog.\r
-\r
-=item B<--fsf>\r
-\r
-Use this if log data is in FSF ChangeLog style.\r
-\r
-=item B<--FSF>\r
-\r
-Attempt strict FSF-standard compatible output.\r
-\r
-=item B<-W> I<SECS>, B<--window> I<SECS>\r
-\r
-Window of time within which log entries unify.\r
-\r
-=item -B<U> I<UFILE>, B<--usermap> I<UFILE>\r
-\r
-Expand usernames to email addresses from I<UFILE>.\r
-\r
-=item B<--passwd> I<PASSWORDFILE>\r
-\r
-Use system passwd file for user name expansion. If no mail domain is provided\r
-(via B<--domain>), it tries to read one from B</etc/mailname>, output of B<hostname\r
--d>, B<dnsdomainname>, or B<domain-name>. cvs2cl exits with an error if none of\r
-those options is successful. Use a domain of '' to prevent the addition of a\r
-mail domain.\r
-\r
-=item B<--domain> I<DOMAIN>\r
-\r
-Domain to build email addresses from.\r
-\r
-=item B<--gecos>\r
-\r
-Get user information from GECOS data.\r
-\r
-=item B<-R> I<REGEXP>, B<--regexp> I<REGEXP>\r
-\r
-Include only entries that match I<REGEXP>. This option may be used multiple\r
-times.\r
-\r
-=item B<-I> I<REGEXP>, B<--ignore> I<REGEXP>\r
-\r
-Ignore files whose names match I<REGEXP>. This option may be used multiple\r
-times.\r
-\r
-=item B<-C>, B<--case-insensitive>\r
-\r
-Any regexp matching is done case-insensitively.\r
-\r
-=item B<-F> I<BRANCH>, B<--follow> I<BRANCH>\r
-\r
-Show only revisions on or ancestral to I<BRANCH>.\r
-\r
-=item B<--follow-only> I<BRANCH>\r
-\r
-Like --follow, but sub-branches are not followed.\r
-\r
-=item B<--no-ancestors>\r
-\r
-When using B<-F>, only track changes since the I<BRANCH> started.\r
-\r
-=item B<--no-hide-branch-additions>\r
-\r
-By default, entries generated by cvs for a file added on a branch (a dead 1.1\r
-entry) are not shown. This flag reverses that action.\r
-\r
-=item B<-S>, B<--separate-header>\r
-\r
-Blank line between each header and log message.\r
-\r
-=item B<--summary>\r
-\r
-Add CVS change summary information.\r
-\r
-=item B<--no-wrap>\r
-\r
-Don't auto-wrap log message (recommend B<-S> also).\r
-\r
-=item B<--no-indent>\r
-\r
-Don't indent log message\r
-\r
-=item B<--gmt>, B<--utc>\r
-\r
-Show times in GMT/UTC instead of local time.\r
-\r
-=item B<--accum>\r
-\r
-Add to an existing ChangeLog (incompatible with B<--xml>).\r
-\r
-=item B<-w>, B<--day-of-week>\r
-\r
-Show day of week.\r
-\r
-=item B<--no-times>\r
-\r
-Don't show times in output.\r
-\r
-=item B<--chrono>\r
-\r
-Output log in chronological order (default is reverse chronological order).\r
-\r
-=item B<--header> I<FILE>\r
-\r
-Get ChangeLog header from I<FILE> ("B<->" means stdin).\r
-\r
-=item B<--xml>\r
-\r
-Output XML instead of ChangeLog format.\r
-\r
-=item B<--xml-encoding> I<ENCODING.>\r
-\r
-Insert encoding clause in XML header.\r
-\r
-=item B<--noxmlns>\r
-\r
-Don't include xmlns= attribute in root element.\r
-\r
-=item B<--hide-filenames>\r
-\r
-Don't show filenames (ignored for XML output).\r
-\r
-=item B<--no-common-dir>\r
-\r
-Don't shorten directory names from filenames.\r
-\r
-=item B<--rcs> I<CVSROOT>\r
-\r
-Handle filenames from raw RCS, for instance those produced by "cvs rlog"\r
-output, stripping the prefix I<CVSROOT>.\r
-\r
-=item B<-P>, B<--prune>\r
-\r
-Don't show empty log messages.\r
-\r
-=item B<--lines-modified>\r
-\r
-Output the number of lines added and the number of lines removed for\r
-each checkin (if applicable). At the moment, this only affects the\r
-XML output mode.\r
-\r
-=item B<--ignore-tag> I<TAG>\r
-\r
-Ignore individual changes that are associated with a given tag.\r
-May be repeated, if so, changes that are associated with any of\r
-the given tags are ignored.\r
-\r
-=item B<--show-tag> I<TAG>\r
-\r
-Log only individual changes that are associated with a given\r
-tag. May be repeated, if so, changes that are associated with\r
-any of the given tags are logged.\r
-\r
-=item B<--delta> I<FROM_TAG>B<:>I<TO_TAG>\r
-\r
-Attempt a delta between two tags (since I<FROM_TAG> up to and\r
-including I<TO_TAG>). The algorithm is a simple date-based one\r
-(this is a hard problem) so results are imperfect.\r
-\r
-=item B<-g> I<OPTS>, B<--global-opts> I<OPTS>\r
-\r
-Pass I<OPTS> to cvs like in "cvs I<OPTS> log ...".\r
-\r
-=item B<-l> I<OPTS>, B<--log-opts> I<OPTS>\r
-\r
-Pass I<OPTS> to cvs log like in "cvs ... log I<OPTS>".\r
-\r
-=back\r
-\r
-Notes about the options and arguments:\r
-\r
-=over 4\r
-\r
-=item *\r
-\r
-The B<-I> and B<-F> options may appear multiple times.\r
-\r
-=item *\r
-\r
-To follow trunk revisions, use "B<-F trunk>" ("B<-F TRUNK>" also works). This is\r
-okay because no would ever, ever be crazy enough to name a branch "trunk",\r
-right? Right.\r
-\r
-=item *\r
-\r
-For the B<-U> option, the I<UFILE> should be formatted like CVSROOT/users. That is,\r
-each line of I<UFILE> looks like this:\r
-\r
- jrandom:jrandom@red-bean.com\r
-\r
-or maybe even like this\r
-\r
- jrandom:'Jesse Q. Random <jrandom@red-bean.com>'\r
-\r
-Don't forget to quote the portion after the colon if necessary.\r
-\r
-=item *\r
-\r
-Many people want to filter by date. To do so, invoke cvs2cl.pl like this:\r
-\r
- cvs2cl.pl -l "-d'DATESPEC'"\r
-\r
-where DATESPEC is any date specification valid for "cvs log -d". (Note that\r
-CVS 1.10.7 and below requires there be no space between -d and its argument).\r
-\r
-=item *\r
-\r
-Dates/times are interpreted in the local time zone.\r
-\r
-=item *\r
-\r
-Remember to quote the argument to `B<-l>' so that your shell doesn't interpret\r
-spaces as argument separators.\r
-\r
-=item *\r
-\r
-See the 'Common Options' section of the cvs manual ('info cvs' on UNIX-like\r
-systems) for more information.\r
-\r
-=item *\r
-\r
-Note that the rules for quoting under windows shells are different.\r
-\r
-=back\r
-\r
-=head1 EXAMPLES\r
-\r
-Some examples (working on UNIX shells):\r
-\r
- # logs after 6th March, 2003 (inclusive)\r
- cvs2cl.pl -l "-d'>2003-03-06'"\r
- # logs after 4:34PM 6th March, 2003 (inclusive)\r
- cvs2cl.pl -l "-d'>2003-03-06 16:34'"\r
- # logs between 4:46PM 6th March, 2003 (exclusive) and\r
- # 4:34PM 6th March, 2003 (inclusive)\r
- cvs2cl.pl -l "-d'2003-03-06 16:46>2003-03-06 16:34'"\r
-\r
-Some examples (on non-UNIX shells):\r
-\r
- # Reported to work on windows xp/2000\r
- cvs2cl.pl -l "-d"">2003-10-18;today<"""\r
-\r
-=head1 AUTHORS\r
-\r
-=over 4\r
-\r
-=item Karl Fogel\r
-\r
-=item Melissa O'Neill\r
-\r
-=item Martyn J. Pearce\r
-\r
-=back\r
-\r
-Contributions from\r
-\r
-=over 4\r
-\r
-=item Mike Ayers\r
-\r
-=item Tim Bradshaw\r
-\r
-=item Richard Broberg\r
-\r
-=item Nathan Bryant\r
-\r
-=item Oswald Buddenhagen\r
-\r
-=item Neil Conway\r
-\r
-=item Arthur de Jong\r
-\r
-=item Mark W. Eichin\r
-\r
-=item Dave Elcock\r
-\r
-=item Reid Ellis\r
-\r
-=item Simon Josefsson\r
-\r
-=item Robin Hugh Johnson\r
-\r
-=item Terry Kane\r
-\r
-=item Akos Kiss\r
-\r
-=item Claus Klein\r
-\r
-=item Eddie Kohler\r
-\r
-=item Richard Laager\r
-\r
-=item Kevin Lilly\r
-\r
-=item Karl-Heinz Marbaise\r
-\r
-=item Mitsuaki Masuhara\r
-\r
-=item Henrik Nordstrom\r
-\r
-=item Joe Orton\r
-\r
-=item Peter Palfrader\r
-\r
-=item Thomas Parmelan\r
-\r
-=item Johanne Stezenbach\r
-\r
-=item Joseph Walton\r
-\r
-=item Ernie Zapata\r
-\r
-=back\r
-\r
-=head1 BUGS\r
-\r
-Please report bugs to C<bug-cvs2cl@red-bean.com>.\r
-\r
-=head1 PREREQUISITES\r
-\r
-This script requires C<Text::Wrap>, C<Time::Local>, and C<File::Basename>. It\r
-also seems to require C<Perl 5.004_04> or higher.\r
-\r
-=head1 OPERATING SYSTEM COMPATIBILITY\r
-\r
-Should work on any OS.\r
-\r
-=head1 SCRIPT CATEGORIES\r
-\r
-Version_Control/CVS\r
-\r
-=head1 COPYRIGHT\r
-\r
-(C) 2001,2002,2003,2004 Martyn J. Pearce <fluffy@cpan.org>, under the GNU GPL.\r
-\r
-(C) 1999 Karl Fogel <kfogel@red-bean.com>, under the GNU GPL.\r
-\r
-cvs2cl.pl is free software; you can redistribute it and/or modify\r
-it under the terms of the GNU General Public License as published by\r
-the Free Software Foundation; either version 2, or (at your option)\r
-any later version.\r
-\r
-cvs2cl.pl is distributed in the hope that it will be useful,\r
-but WITHOUT ANY WARRANTY; without even the implied warranty of\r
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\r
-GNU General Public License for more details.\r
-\r
-You may have received a copy of the GNU General Public License\r
-along with cvs2cl.pl; see the file COPYING. If not, write to the\r
-Free Software Foundation, Inc., 59 Temple Place - Suite 330,\r
-Boston, MA 02111-1307, USA.\r
-\r
-=head1 SEE ALSO\r
-\r
-cvs(1)\r
-\r
-\r