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