path: root/src/echangelog/echangelog

#!/usr/bin/perl
#
# echangelog: Update the ChangeLog for an ebuild.  For example:
#
#   $ echangelog 'Add ~alpha to KEYWORDS'
#   4a5,7
#   >   10 Feb 2003; Aron Griffis <agriffis@gentoo.org> oaf-0.6.8-r1.ebuild :
#   >   Add ~alpha to KEYWORDS
#   >

use warnings;
use strict;
use POSIX qw(locale_h strftime getcwd setlocale);
use File::Basename;
use Getopt::Long;
use Pod::Usage;

# Fix bug 21022 by restricting to C locale
setlocale(LC_ALL, "C");

use Text::Wrap;
$Text::Wrap::columns = 80;
$Text::Wrap::unexpand = 0;

# Global variables
my (@files, @ebuilds, @conflicts, @trivial, @unknown, @new_versions, %actions);
my ($input, $editor, $entry, $user, $date, $text, $vcs);
my ($fh);
my ($opt_man, $opt_help, $opt_nostrict, $opt_force_vcs, $opt_version, $opt_strict);

$date = strftime("%d %b %Y", gmtime);

$opt_help = 0;
$opt_nostrict = 0;
$opt_version = 0;
# DEPRECATED
$opt_strict = 0;

my %vcs = (
	bzr => {
		directory => ".bzr",
		diff => "bzr diff",
		status => "bzr status -S .",
		add => "bzr add",
		skip => 3,
		# The same as for hg.
		regex => qr/^=== \S+ file '\S+\/\S+\/((\S+)\.ebuild)/
	},
	cvs => {
		directory => "CVS",
		diff => "cvs -f diff -U0",
		status => "cvs -fn up",
		add => "cvs -f add",
		skip => 6,
		regex => qr/^Index: (([^\/]*?)\.ebuild)\s*$/
	},
	git => {
		directory => ".git",
		diff => "git diff",
		status => "git diff-index HEAD --name-status",
		add => "git add",
		# This value should usually be 3 but on new file mode we need skip+1.
		# So 4 should be fine anyway.
		skip => 4,
		regex => qr/^diff \-\-git \S*\/((\S*)\.ebuild)/
	},
	hg => {
		directory => ".hg",
		diff => "hg diff",
		status => "hg status .",
		add => "hg add",
		skip => 3,
		# hg diff is relative to the root.
		# TODO: Write a proper regex :)
		regex => qr/diff \-r \S+ \S+\/\S+\/((\S+)\.ebuild)/
	},
	svn => {
		directory => ".svn",
		diff => "svn diff -N",
		status => "svn status",
		add => "svn add",
		skip => 4,
		regex => qr/^Index: (([^\/]*?)\.ebuild)\s*$/
	},
);

sub version {
	my $Revision = "Last svn change rev";
	my $Date = "Last svn change date";
	my $foo = "";
	print "echangelog\n$Revision$foo \n$Date$foo\n";
	exit 0;
}

sub getenv ($) {
    my $key = shift;

    # Check for key: defined and not empty
    return if !$key or $key eq '';

    # Fetch key in %ENV hash
    my $env = $ENV{$key};

    # Make sure the variable does exist,
    # check for its length
    # and return it
    return $env if $env and (length($env) > 0);
}

# Bug 264146.
# Copied from Text::Wrap.
# The only modified thing is:
# We trim _just_ tab/space etc. but not \n/\r.
# \s treats even \n/\r as whitespace.
# BUGS:
# ' test'
# ' test'
# Will end up in:
# ' test'
# ''
# 'test'
# See 'my $ps = ($ip eq $xp) ? "\n\n" : "\n";'
sub text_fill {
	my ($ip, $xp, @raw) = @_;
	my @para;

	for my $pp ( split(/\n\s+/, join("\n", @raw)) ) {
		$pp =~ s/[\x09\x0B\x0C\x20]+/ /g;
		my $x = Text::Wrap::wrap($ip, $xp, $pp);
		push(@para, $x);
	}

	# if paragraph_indent is the same as line_indent,
	# separate paragraphs with blank lines
	my $ps = ($ip eq $xp) ? "\n\n" : "\n";
	return join ($ps, @para);
}

sub changelog_info {
	my %changed = @_;

	open(my $fh, '>', 'ChangeLog.new');

	print($fh "\n");
	print($fh "# Please enter the ChangeLog message for your changes. Lines starting\n");
	print($fh "# with '#' will be ignored, and an empty message aborts the ChangeLog.\n");
	print($fh "#\n# Changes:\n");

	foreach my $key (keys(%changed)) {
		if ($changed{$key} eq "+") {
			printf($fh "# new file:\t%s\n", $key);
		}
		elsif ($changed{$key} eq "-") {
			printf($fh "# deleted:\t%s\n", $key);
		}
		else {
			printf($fh "# modified:\t%s\n", $key);
		}
	}

	close($fh);
}

sub update_cat_pn {
	my $t = shift;
	my $cwd = getcwd();

	my $category = basename(dirname($cwd));
	my $package_name = basename($cwd);

	$t =~ s/^(# ChangeLog for).*/$1 $category\/$package_name/;

	return $t;
}

# Check partent dirs recursivevly/backward
sub check_vcs_dir {
	my $type = shift;

	my $dir = getcwd();
	while($dir !~ /^\/$/) {
		return 1 if -d "${dir}/${type}";
		$dir = dirname($dir);
	}
	# Check / as well
	return 1 if -d "/${type}";

	return 0;
}

# Just to ensure we don't get duplicate entries.
sub mypush(\@@) {
	my $aref = shift;

	foreach my $value (@_) {
		push(@{$aref}, $value) if !grep(/^\Q$value\E$/, @{$aref});
	}
}

sub update_copyright {
	my ($t) = @_;
	(my $year = $date) =~ s/.* //;

	$t =~ s/^# Copyright \d+(?= )/$&-$year/m or
	$t =~ s/^(# Copyright) (\d+)-\d+/$1 $2-$year/m;

	return $t;
}

my $ret = GetOptions(
	'no-strict' => \$opt_nostrict,
	'version|v' => \$opt_version,
	'help|h'    => \$opt_help,
	'strict'    => \$opt_strict,
	'vcs=s'     => \$opt_force_vcs,
  'man'       => \$opt_man,
);


pod2usage(-verbose => 1, -exitval => -1) if ($opt_help || $ret ne 1);
pod2usage(-verbose => 2, -exitval => -1) if $opt_man;
version() if $opt_version;

if($opt_strict) {
	print STDERR "Warning: The option '--strict' has been deprecated and will be removed soon!\n";
	print STDERR "--strict behaviour is now default.\n";
}

# Figure out what kind of repo we are in.
# Respect $PATH while looking for the VCS
if(! defined($opt_force_vcs)) {
	foreach my $path ( split(":", (getenv("PATH") || "/bin:/usr/bin:/usr/local/bin")) ) {
		foreach my $_vcs (sort(keys(%vcs))) {
			if ( -X "${path}/${_vcs}" ) {
				$vcs = $_vcs if check_vcs_dir($vcs{$_vcs}{directory});
				last if $vcs;
			}
		}
		last if $vcs;
	}
}
else {
	$vcs = $opt_force_vcs if defined $vcs{$opt_force_vcs};
}

if ( ! $vcs ) {
	print STDERR "Either no CVS, .git, .svn, ... directories found, the specific VCS has not been\n";
	print STDERR "installed or you don't have execute rights!\n";
	exit(1);
}

# Read the current ChangeLog
if (-f 'ChangeLog') {
	open($fh, '<', 'ChangeLog') or die "Can't open ChangeLog for input: $!\n";
	{ local $/ = undef; $text = <$fh>; }
	close($fh);
} else {
	# No ChangeLog here, maybe we should make one...
	if (glob("*.ebuild")) {
		open(my $ph, '-|', "portageq portdir") or die "portageq returned with an error: $!\n";
		my $portdir = <$ph>;
		$portdir =~ s/\s+$//;
		close($ph);

		die "Can't find PORTDIR\n" if (length $portdir == 0);

		open($fh, '<', "$portdir/skel.ChangeLog")
			or die "Can't open $portdir/skel.ChangeLog for input: $!\n";
		{ local $/ = undef; $text = <$fh>; }
		close($fh);

		$text =~ s/^\*.*//ms; # don't need the fake entry
	} else {
		die "This should be run in a directory with ebuilds...\n";
	}
}

# Update the copyright year in the ChangeLog
$text = update_copyright($text);

# New packages and/or ones that have moved around often have stale data here.
# But only do that in places where ebuilds are around (as echangelog can be
# used in profiles/ and such places).
if (glob("*.ebuild")) {
	$text = update_cat_pn($text);
}

# Figure out what has changed around here
open(my $ph_status, "-|", $vcs{$vcs}{status}.' 2>&1') or die "Can't run ".$vcs{$vcs}{status}.": $!\n";
while (<$ph_status>) {
	# I don't want mess our existing stuff with the horrible bazaar stuff.
	# TODO: add stuff for untracked/conflicting files.
	if ($vcs eq "bzr") {
		# NEW, DELETED, MODIFIED
		if (/^[\s\+\-]([NDM])\s+(.*)/) {
			my ($status, $filename) = ($1, $2);
			# strip category/package/ since everything is relative to the repo root.
			$filename =~ s/^([^\/]+\/){2}//;

			# skip empty $filename, e.g. if you add a new package, the first
			# line would be the package directory app-foo/bar/ but thats stripped above.
			next if !$filename;
			# skip directories
			next if -d $filename;

			($actions{$filename} = $status) =~ tr/NDM/+-/d;
			push(@files, $filename);
			next;
			}
		# RENAMED/MOVED/MODIFIED
		elsif (/^RM?\s+(\S+) => (\S+)/) {
			my ($old, $new) = ($1, $2);
			$old =~ s/^([^\/]+\/){2}//;
			$new =~ s/^([^\/]+\/){2}//;

			next if !$old or !$new;
			next if -d $old or -d $new;

			$actions{$old} = '-';
			$actions{$new} = '+';

			push(@files, $old, $new);
			next;
		}
	}
	if (/^C\s+(\S+)/) {
		# NOTE: The git part here might be unused
		if($vcs eq "git") {
			my $filename = $1;
			$filename =~ /\S*\/(\S*)/;

			next if -d $filename;

			push @conflicts, $filename;
			next;
		}

		push @conflicts, $1;
		next;
	}
	elsif (/^\?\s+(\S+)/) {
		push @unknown, $1;
		$actions{$1} = '?';
		next;
	}
	elsif (/^([ARMD])\s+\+?\s*(\S+)/) {
		my ($status, $filename) = ($1,$2);

		if($vcs eq "git") {
			open(my $ph, '-|', "git rev-parse --sq --show-prefix");
			my $prefix = <$ph>;
			close($ph);

			if (defined($prefix)) {
				chomp($prefix);

				if ($filename =~ /\Q$prefix\E(\S*)/) {
					$filename = $1 ;
				}
				else {
					next;
				}
			}
		}

		next if -d $filename;

		push(@files, $filename);
		($actions{$filename} = $status) =~ tr/DARM/-+-/d;
	}
}
close($ph_status);

sub git_unknown_objects {
	open(my $ph, "-|", "${vcs} ls-files --exclude-standard --others");
	while(defined( my $line = <$ph> )) {
		chomp($line);

		# IMHO we can skip those files, even if they're untracked
		#next if $line =~ m/^\.gitignore$/;

		push(@unknown, $line);
	}
	close($ph);
}

# git only shows files already added so we need to check for unknown files
# separately here.
if($vcs eq "git") {
	git_unknown_objects();
}

# Separate out the trivial files for now
@files = grep {
	!/^(Manifest|ChangeLog)$/ or do { push @trivial, $_; 0; }
} @files;

@unknown = grep {
	!/^(Manifest|ChangeLog)$/ or do { push @trivial, $_; 0; }
} @unknown;

# Don't allow any conflicts
if (@conflicts) {
	print STDERR <<EOT;
$vcs reports the following conflicts.  Please resolve them before
running echangelog.
EOT
	print STDERR map "C $_\n", @conflicts;
	exit 1;
}

# Don't allow unknown files (other than the trivial files that were separated
# out above)
if (@unknown) {
	print STDERR <<EOT;
$vcs reports the following unknown files.  Please use "$vcs add" before
running echangelog, or remove the files in question.
EOT
	print STDERR map "? $_\n", @unknown;
	exit 1;
}

# Sort the list of files as portage does.  None of the operations through
# the rest of the script should break this sort.
sub sortfunc($$) {
	my ($a, $b) = @_;
	(my $va = $a) =~ s/.*?-(\d.*?)(?:\.ebuild)?$/$1/;
	(my $vb = $b) =~ s/.*?-(\d.*?)(?:\.ebuild)?$/$1/;
	my ($na, $sa, $sna, $ra) = ($va =~ /^(.*?)(?:_(alpha|beta||pre|rc|p)(\d*))?(?:-r(\d+))?$/);
	my ($nb, $sb, $snb, $rb) = ($vb =~ /^(.*?)(?:_(alpha|beta||pre|rc|p)(\d*))?(?:-r(\d+))?$/);
	my (@na) = split /\.|(?<=\d)(?=[^\d\.])/, $na;
	my (@nb) = split /\.|(?<=\d)(?=[^\d\.])/, $nb;
	my $retval;

	#
	# compare version numbers first
	#
	for (my $i = 0; defined $na[$i] or defined $nb[$i]; $i++) {
		# def vs. undef
		return +1 if defined $na[$i] and !defined $nb[$i];
		return -1 if defined $nb[$i] and !defined $na[$i];

		# num vs. num
		if ($na[$i] =~ /^\d/ and $nb[$i] =~ /^\d/) {
			$retval = ($na[$i] <=> $nb[$i]);
			return $retval if $retval;
			next;
		}

		# char vs. char
		if ($na[$i] =~ /^\D/ and $nb[$i] =~ /^\D/) {
			$retval = ($na[$i] cmp $nb[$i]);
			return $retval if $retval;
			next;
		}

		# num vs. char
		$retval = ($na[$i] =~ /\d/ and -1 or +1);
		return $retval;
	}

	#
	# compare suffix second
	#
	if (defined $sa and !defined $sb) {
		return +2 if $sa eq "p";
		return -2;
	}
	if (defined $sb and !defined $sa) {
		return -3 if $sb eq "p";
		return +3;
	}

	if (defined $sa) { # and defined $sb
		$retval = ($sa cmp $sb);
		if ($retval) {
			return +4 if $sa eq "p";
			return -4 if $sb eq "p";
			return $retval; # suffixes happen to be alphabetical order, mostly
		}

		# compare suffix number
		return +5 if defined $sna and !defined $snb;
		return -5 if defined $snb and !defined $sna;

		if (defined $sna) {  # and defined $snb
			$retval = ($sna <=> $snb);
			return $retval if $retval;
		}
	}

	#
	# compare rev third
	#
	return +6 if defined $ra and !defined $rb;
	return -6 if defined $rb and !defined $ra;

	if (defined $ra) { # and defined $rb
		return ($ra <=> $rb);
	}

	#
	# nothing left to compare
	#
	return 0;
}

# Forget ebuilds that only have changed copyrights, unless that's all
# the changed files we have
@ebuilds = grep(/\.ebuild$/, @files);
@files = grep(!/\.ebuild$/, @files);

if (@ebuilds) {
	my $ph_diff;
	if ($vcs eq "git") {
		open($ph_diff, "-|", $vcs{$vcs}{diff}." HEAD -- @ebuilds 2>&1") or die "Can't run: ".$vcs{$vcs}{diff}."$!\n";
	} else {
		open($ph_diff, "-|", $vcs{$vcs}{diff}." @ebuilds 2>&1") or die "Can't run: ".$vcs{$vcs}{diff}."$!\n";
	}

	while (defined(my $line = <$ph_diff>)) {
		# only possible with cvs
		if ($line =~ m/^$vcs diff: (([^\/]*?)\.ebuild) was removed/) {
			mypush(@ebuilds, $1);
		}
		# We assume GNU diff output format here.
		# git format: diff --git a/app-doc/repodoc/metadata.xml b/app-doc/repodoc/metadata.xml
		elsif ($line =~ m/$vcs{$vcs}{regex}/) {
			my ($file, $version) = ($1, $2);

			if ($vcs eq "git") {
				while (defined($line = <$ph_diff>)) {
					last if $line =~ m/^deleted file mode|^index/;
					if ($line =~ m/^new file mode/) {
						mypush(@ebuilds, $file);
						mypush(@new_versions, $version);
						last;
					}
				}
			}

			if ($vcs eq "bzr") {
				if ($line =~ m/^=== added file/) {
					mypush(@ebuilds, $file);
					mypush(@new_versions, $version);
					last;
				}
				elsif($line =~ /^=== renamed file '.+\/([^\/]+\.ebuild)' => '.+\/(([^\/]+)\.ebuild)'/) {
					mypush(@ebuilds, $1, $2);
					mypush(@new_versions, $3);
					last;
				}
			}

			# check if more than just copyright date changed.
			# skip some lines (vcs dependent)
			foreach(1..$vcs{$vcs}{skip}) {
				$line = <$ph_diff>;
			}


			my $copy_only = 1;
			while(defined($line = <$ph_diff>)) {
				# We just want to check/compare the differences so anything beginning with +/-
				if ($line =~ m/^[-+](?!# Copyright)/m) {
					mypush(@ebuilds, $file);
					$copy_only = 0;
					last;
				}
			}

			# Only the Copyright has been changed so lets remove the file from the array
			if ($copy_only) {
				@ebuilds = grep(!/\Q${file}\E/, @ebuilds);
			}

			# At this point all ebuilds where more than just the copyright has been changed have been added to @ebuilds.
			# So lets go ahead with the next diff.
			next;
		}
		elsif ($line =~ m/^$vcs.*?: (([^\/]*?)\.ebuild) is a new entry/) {
			mypush(@ebuilds, $1);
			mypush(@new_versions, $2);
		}
	}
	close($ph_diff);
}

# Subversion diff doesn't identify new versions. So use the status command
if (($vcs eq "svn" or $vcs eq "hg") and (@ebuilds)) {
	open(my $ph_status, "-|", $vcs{$vcs}{status}." @ebuilds 2>&1") or die "Can't run: ".$vcs{$vcs}{status}."$!\n";

	while (defined(my $line = <$ph_status>)) {
		if ($line =~ m/^A\s+\+?\s*(([^\s]*)\.ebuild)/) {
			mypush(@ebuilds, $1);
			mypush(@new_versions, $2);
		}
	}
	close($ph_status);
}

# When a package move occurs, the versions appear to be new even though they are
# not.  Trim them from @new_versions in that case.
@new_versions = grep { $text !~ /^\*\Q$_\E\s/m } @new_versions;

# Allow ChangeLog entries with no changed files, but give a fat warning
if (!@files && !@ebuilds) {
	print STDERR "**\n";
	print STDERR "** NOTE: No non-trivial changed files found. Normally echangelog\n";
	print STDERR "** should be run after all affected files have been added and/or\n";
	print STDERR "** modified.  Did you forget to $vcs add?\n";
	print STDERR "**\n";

	if (!$opt_nostrict) {
		print STDERR "** In strict mode, exiting\n";
		print STDERR "** If you know what you're doing there pass '--no-strict' to echangelog\n";
		exit(1);
	}

	@files = @trivial;

	# last resort to put something in the list
	unless (@files) {
		@files = qw/ChangeLog/;
		$actions{'ChangeLog'} = "";
	}
}

# sort
@ebuilds = sort sortfunc @ebuilds;
@files = sort sortfunc @files;
@new_versions = sort sortfunc @new_versions;

# Get the input from the cmdline, editor or stdin
if ($ARGV[0]) {
	$input = "@ARGV";
} else {
	$editor = getenv('ECHANGELOG_EDITOR') ? getenv('ECHANGELOG_EDITOR') : getenv('EDITOR') || undef;

	if ($editor) {
		# Append some informations.
		changelog_info(%actions);

		system("$editor ChangeLog.new");

		if ($? != 0) {
			# This usually happens when the editor got forcefully killed; and
			# the terminal is probably messed up: so we reset things.
			system('stty sane');
			print STDERR "Editor died!  Reverting to stdin method.\n";
			undef $editor;
		} else {
			if (open($fh, "<", "ChangeLog.new")) {
				local $/ = undef;
				$input = <$fh>;
				close($fh);

				# Remove comments from changelog_info().
				local $/ = "\n";
				$input =~ s/^#.*//mg;
				local $/ = undef;
			} else {
				print STDERR "Error opening ChangeLog.new: $!\n";
				print STDERR "Reverting to stdin method.\n";
				undef $editor;
			}
		}
		unlink('ChangeLog.new') if -f 'ChangeLog.new';
	}

	unless ($editor) {
		print "Please type the log entry: use Ctrl-d to finish, Ctrl-c to abort...\n";
		local $/ = undef;
		$input = <>;
	}
}
die "Empty entry; aborting\n" unless $input =~ /\S/;

# If there are any long lines, then wrap the input at $columns chars
# (leaving 2 chars on left, one char on right, after adding indentation below).
$input = text_fill('  ', '  ', $input);

# Prepend the user info to the input
# Changes related to bug 213374;
# This sequence should be right:
# 1. GENTOO_COMMITTER_NAME && GENTOO_COMMITTER_EMAIL
# 2. GENTOO_AUTHOR_NAME && GENTOO_AUTHOR_EMAIL
# 3. ECHANGELOG_USER (fallback/obsolete?)
# 4. getpwuid()..
if ( getenv("GENTOO_COMMITTER_NAME") && getenv("GENTOO_COMMITTER_EMAIL") ) {
	$user = sprintf("%s <%s>", getenv("GENTOO_COMMITTER_NAME"), getenv("GENTOO_COMMITTER_EMAIL"));
}
elsif ( getenv("GENTOO_AUTHOR_NAME") && getenv("GENTOO_AUTHOR_EMAIL") ) {
	$user = sprintf("%s <%s>", getenv("GENTOO_AUTHOR_NAME"), getenv("GENTOO_AUTHOR_EMAIL"));
}
elsif ( getenv("ECHANGELOG_USER") ) {
	$user = getenv("ECHANGELOG_USER");
}
else {
	my ($fullname, $username) = (getpwuid($<))[6,0];
	$fullname =~ s/,.*//; # remove GECOS, bug 80011
	$user = sprintf('%s <%s@gentoo.org>', $fullname, $username);
}

# Make sure that we didn't get "root"
die "Please set ECHANGELOG_USER or run as non-root\n" if $user =~ /<root@/;

$entry = "$date; $user ";
if(@ebuilds) {
	$entry .= join(', ', map("$actions{$_}$_", @ebuilds));
	$entry .= ", ".join(', ', map("$actions{$_}$_", @files)) if @files;
}
else {
	$entry .= join ', ', map("$actions{$_}$_", @files);
}
$entry .= ':';
$entry = Text::Wrap::fill('  ', '  ', $entry); # does not append a \n
$entry .= "\n$input";                          # append user input

# Each one of these regular expressions will eat the whitespace
# leading up to the next entry (except the two-space leader on the
# front of a dated entry), so it needs to be replaced with a
# double carriage-return.  This helps to normalize the spacing in
# the ChangeLogs.
if (@new_versions) {
	# Insert at the top with a new version marker
	$text =~ s/^( .*? )               # grab header
		\s*\n(?=\ \ \d|\*|\z)  # suck up trailing whitespace
		/"$1\n\n" .
		join("\n", map "*$_ ($date)", reverse @new_versions) .
		"\n\n$entry\n\n"/sxe
			or die "Failed to insert new entry (4)\n";
} else {
	# Changing an existing patch or ebuild, no new version marker
	# required
	$text =~ s/^( .*? )               # grab header
		\s*\n(?=\ \ \d|\*|\z)  # suck up trailing whitespace
		/$1\n\n$entry\n\n/sx
			or die "Failed to insert new entry (3)\n";
}

# Update affected ebuilds and some other files copyright dates.  There is no reason to update the
# copyright lines on ebuilds that haven't changed. I verified this with an IP
# lawyer. (patches/diffs and binary files are excluded)
for my $e (grep(!/\.(patch|diff)$/, @files), @ebuilds) {
	if (-s $e && ! -B $e) {
		my ($etext, $netext);

		open($fh, "<", $e) or warn("Can't read $e to update copyright year\n"), next;
		{ local $/ = undef; $etext = <$fh>; }
		close($fh);

		# Attempt the substitution and compare
		$netext = update_copyright($etext);
		next if $netext eq $etext; # skip this file if no change.

		# Write the new ebuild
		open($fh, ">", "${e}.new") or warn("Can't open $e.new\n"), next;
		print $fh $netext and
		close($fh) or warn("Can't write $e.new\n"), next;

		# Move things around and show the diff
		system "diff -U 0 $e $e.new";
		rename "$e.new", $e or warn("Can't rename $e.new: $!\n");

		# git requires to re-add this file else it wouln't be included in the commit.
		if ($vcs eq "git") {
			system("$vcs{$vcs}{add} ${e}");
		}
	}
}

# Write the new ChangeLog
open($fh, ">", 'ChangeLog.new') or die "Can't open ChangeLog.new for output: $!\n";
print $fh $text or die "Can't write ChangeLog.new: $!\n";
close($fh) or die "Can't close ChangeLog.new: $!\n";

# Move things around and show the ChangeLog diff
system 'diff -Nu ChangeLog ChangeLog.new';
rename 'ChangeLog.new', 'ChangeLog' or die "Can't rename ChangeLog.new: $!\n";

# Okay, now we have a starter ChangeLog to work with.
# The text will be added just like with any other ChangeLog below.
# Add the new ChangeLog to vcs before continuing.
if ($vcs eq "cvs") {
	if (open($fh, "<", "CVS/Entries")) {
		system("cvs -f add ChangeLog") unless (scalar grep /^\/ChangeLog\//, <$fh>);
		close($fh);
	}
} elsif ($vcs eq "svn") {
	if (open($fh, "<", ".svn/entries")) {
		system("svn add ChangeLog") unless (scalar grep /ChangeLog/, <$fh>);
		close($fh);
	}
} else {
	system("$vcs{$vcs}{add} ChangeLog 2>&1 > /dev/null");
}

# vim: set ts=4 sw=4 tw=0:

__END__

=head1 NAME

echangelog - Update portage ChangeLog files.

=head1 SYNOPSIS

echangelog [options] <changelog message>

  --no-strict
  --vcs <vcs>
  --help|h
  --man
  --version

=head1 OPTIONS

=over 14

=item B<--no-strict>

Do not abort on trivial changes.

=item B<--vcs vcs>

Skip VCS autodetection and use the specified VCS instead.

Supported VCS: bzr, cvs, git, hg, svn

=item B<--help|h>

Display help.

=item B<--man>

Display man page.

=item B<--version>

Display version.

=back

=head1 DESCRIPTION

This tool provides an easy way to create or update portage ChangeLogs in
Gentoo.  The tool scans the current directory, which is assumed to be a package
directory such as /usr/portage/app-editors/vim, finds what files have been
changed or added, and inserts the appropriate entry to ChangeLog.  If text is
not provided on the command-line, echangelog prompts for it.

All modifications should occur before running echangelog so that it can include
the appropriate file information in the ChangeLog entry.  For example, you
should run "cvs add" on your files, otherwise echangelog won't know those files
are part of the update.

If your text would cause the ChangeLog entry to exceed 80 columns, it will be
rewrapped to keep the ChangeLog neat.  If you need special formatting in the
ChangeLog, then you can either (1) run echangelog with no text on the
command-line, and make sure that your text won't be too wide, (2) edit the
ChangeLog manually.  If you prefer (2), I'd recommend something like
"echangelog blah" so that the header lines are computed correctly, then edit
and change "blah" to your preferred text.

In addition to updating the ChangeLog, echangelog will automatically update the
copyright year of all out-of-date ebuilds, as well as the ChangeLog itself.
These updates are included in the diff displayed by echangelog when it finishes
its work.

=head1 EXAMPLES

To create a ChangeLog for a completely new package.  The header is parsed from
skel.ebuild.

  $ cvs add metalog-0.1.ebuild
  cvs server: use 'cvs commit' to add this file permanently
  $ echangelog 'New ebuild, thanks to Harvey McGillicuddy'
  --- ChangeLog   1969-12-31 19:00:00.000000000 -0500
  +++ ChangeLog.new       2003-02-23 14:04:06.000000000 -0500
  @@ -0,0 +1,9 @@
  +# ChangeLog for app-admin/metalog
  +# Copyright 2000-2003 Gentoo Technologies, Inc.; Distributed under the GPL
  v2
  +# $Header$
  + +*metalog-0.1 (23 Feb 2003) +
  +  23 Feb 2003; Aron Griffis <agriffis@gentoo.org> metalog-0.1.ebuild :

  +  New ebuild, thanks to Harvey McGillicuddy
  +
To bump a revision.  Note you need to "cvs add" so that echangelog will notice
the new file.

  $ cvs add metalog-0.1-r1.ebuild
  cvs server: use 'cvs commit' to add this file permanently
  $ echangelog 'Bump revision to fix bug #999'
  --- ChangeLog   2003-02-23 14:04:06.000000000 -0500
  +++ ChangeLog.new       2003-02-23 14:07:48.000000000 -0500
  @@ -2,6 +2,11 @@
   # Copyright 2000-2003 Gentoo Technologies, Inc.; Distributed under the GPL
   # v2
   # $Header$

  +*metalog-0.1-r1 (23 Feb 2003)
  +
  +  23 Feb 2003; Aron Griffis <agriffis@gentoo.org> metalog-0.1-r1.ebuild :
  +  Bump revision to fix bug #999
  +
  *metalog-0.1 (23 Feb 2003)
     23 Feb 2003; Aron Griffis <agriffis@gentoo.org> metalog-0.1.ebuild :

For a multi-line entry, omit the command-line arg.

  $ echangelog
  Please type the log entry, finish with ctrl-d
  Bump revision to fix bug #999.  Necessary to bump the revision because
  the problem appears at run-time, not compile-time.  This should also
  give users the updated default configuration file.
  --- ChangeLog   2003-02-23 14:09:12.000000000 -0500
  +++ ChangeLog.new       2003-02-23 14:12:43.000000000 -0500
  @@ -2,6 +2,13 @@
   # Copyright 2000-2003 Gentoo Technologies, Inc.; Distributed under the GPL
   # v2
   # $Header$
  +*metalog-0.1-r1 (23 Feb 2003)
  +
  +  23 Feb 2003; Aron Griffis <agriffis@gentoo.org> metalog-0.1-r1.ebuild :
  +  Bump revision to fix bug #999.  Necessary to bump the revision because
  +  the problem appears at run-time, not compile-time.  This should also
  +  give users the updated default configuration file.
  + *metalog-0.1 (23 Feb 2003)

     23 Feb 2003; Aron Griffis <agriffis@gentoo.org> metalog-0.1.ebuild :

For a multi-line entry, omit the command-line arg.

  $ echangelog
  Please type the log entry, finish with ctrl-d
  Bump revision to fix bug #999.  Necessary to bump the revision because
  the problem appears at run-time, not compile-time.  This should also
  give users the updated default configuration file.
  --- ChangeLog   2003-02-23 14:09:12.000000000 -0500 +++ ChangeLog.new
  2003-02-23 14:12:43.000000000 -0500 @@ -2,6 +2,13 @@
   # Copyright 2000-2003 Gentoo Technologies, Inc.; Distributed under the GPL
   # v2
   # $Header$

  +*metalog-0.1-r1 (23 Feb 2003)
  +
  +  23 Feb 2003; Aron Griffis <agriffis@gentoo.org> metalog-0.1-r1.ebuild :
  +  Bump revision to fix bug #999.  Necessary to bump the revision because +
  the problem appears at run-time, not compile-time.  This should also +  give
  users the updated default configuration file.  +
  *metalog-0.1 (23 Feb 2003)
     23 Feb 2003; Aron Griffis <agriffis@gentoo.org> metalog-0.1.ebuild :

=head1 ENVIRONMENT VARIABLES

=over 4

=item B<ECHANGELOG_USER>

 If echangelog can't figure out your username for the entry, you should set
 ECHANGELOG_USER like so:
 $ export ECHANGELOG_USER="Aron Griffis <agriffis@gentoo.org"

=back

=head1 NOTES

As of the most recent version of echangelog (when this man-page appeared),
echangelog puts all new entries at the top of the file instead of finding the
appropriate *version line within the file.  This is because that "new"
ChangeLog format was never agreed upon by the Gentoo developers.  Unfortunately
the existence of both formats will undoubtedly cause much confusion.  This also
means that the examples above are wrong, since I just copied them from some old
email.  However they're not much wrong. ;-)

Bugs found should be filed against tools-portage@gentoo.org at http://bugs.gentoo.org/

=head1 AUTHORS

This tool was originally written by Aron Griffis <agriffis@gentoo.org>.

Continued by Christian Ruppert <idl0r@gentoo.org>.

This man page has been turned into a Perl POD document by Patrice Clement
<monsieurp@gentoo.org>.

=cut