#!/usr/bin/perl

use AptPkg::Config '$_config';
use AptPkg::System '$_system';
use AptPkg::Version;

$_config->init;
$_system = $_config->system;
my $vs = $_system->versioning;
use strict;

=head1 NAME

cvs-autoreleasedeb - Automatic Release of debian packages from CVS

=head1 DESCRIPTION

This script generates and uploads the debian package
for cvs modules managed by cvs-buildpackage.

cvs-autoreleasedeb will maintain a state file of all
the packages you want to be automatically published,
and every time you commit the debian/changelog file
of your package, changing the debian version to a
greater value, it will be published.

All the parameters to the script are configured in the
conffile. There is no command-line switch. See
cvs-autoreleasedeb.conf(5) for more information.

=head1 USING

There are two ways of using this script:

1) Run as user cvs-autoreleasedeb in cron. This is very
useful for software houses that want to have the "nightily
build" version of the software published automatically.
In this case, the config file will be "/etc/cvs-autoreleasedeb.conf"
and it will use /var/lib/cvs-autoreleasedeb/ as scratch dir.

  NOTE: edit /etc/default/cvs-autoreleasedeb to control this behavior
  NOTE 2: all output will be thrown in /var/log/cvs-autoreleasedeb/run.log

2) Run as yourself, it will automatizate the work you
will have if you have your packages in CVS.
In this case, the config file will be $HOME/.cvs-autoreleasedeb/conf
and the scratch dir will be $HOME/.cvs-autoreleasedeb.
cvs-autoreleasedeb will not create defaults, you must have the
configuration file created before running cvs-autoreleasedeb. See
cvs-autoreleasedeb.conf(5).

=head1 TODO

 - Use a snapshot of the time of the commit in
   the changelog to checkout the source
 - Localize the messages.
 - Work with other than all lowercase in conffile.
 - Use a better format for conffile.

=head1 _EXIT CODES

 _exit codes:
 0 = Clean _exit
 1 = Config file not found
 2 = No packages in config file
 3 = Couldn't open the state file
 4 = Couldn't open the state file for writing
 5 = Couldn't determine architecture

=head1 SEE ALSO

cvs-buildpackage(1), cvs(1), cvs-autoreleasedeb.conf(5), dupload(1)

=head1 AUTHOR

This  manual page was written by Daniel Ruoso <daniel@ruoso.com>, for the
Debian GNU/Linux system.

=cut

# Constants
$::USERCONF = $ENV{HOME}."/.cvs-autoreleasedeb/conf";
$::CONFFILE = "/etc/cvs-autoreleasedeb.conf";

# Read the configfile. This function defines if
# the script is running as the cvs-autoreleasedeb
# user. And in this case, it will use the directory
# in /var/lib, else will use $HOME/.cvs-autoreleasedeb/
# The definition of what directory will be used is setted
# in $::VARDIR.
if (getpwuid($>) eq "cvs-autoreleasedeb") {
	$::VARDIR = "/var/lib/cvs-autoreleasedeb/";
} else {
	$::VARDIR = $ENV{HOME}."/.cvs-autoreleasedeb/";
}
$::STATEFILE = $::VARDIR."packages.state";
$::CVSDIR = $::VARDIR."cvs/";
$::PACKDIR = $::VARDIR."packages/";
$::CVS = "cvs -Q";


# before anything, will see if another cvs-autoreleasedeb is running
if (-e $::VARDIR."cvs-autoreleasedeb.lock") {
	open PIDFILE, $::VARDIR."cvs-autoreleasedeb.lock";
	my $pid = <PIDFILE>;
	close PIDFILE;
	chomp $pid;
	if (kill 0, $pid) {
		# Another instance is running
		# will hung up now.
		print "Another instance is already running, will not try to run now.\n";
		exit 0;
	} else {
		# stale lock file, will overwrite
		print "Overwriting tale lock file.\n";
	}
}

open PIDFILE, ">".$::VARDIR."cvs-autoreleasedeb.lock";
print PIDFILE $$;
close PIDFILE;

sub _exit {
	my $_exit_code = shift;
	unlink $::VARDIR."cvs-autoreleasedeb.lock";
	exit $_exit_code;
}

my $conf_struct = &read_conf_file;

# Get architecture
my $arch = '';
########
# This code was taken from debuild script!!!!!!! THANKS!!!!!
########
if (system("command -v dpkg-architecture >/dev/null 2>&1") == 0) {
	$arch=`dpkg-architecture -qDEB_HOST_ARCH 2>/dev/null`;
	chomp($arch);
}
$arch ||= `dpkg --print-architecture 2>/dev/null`;
chomp($arch);
if (!$arch) {
	print "Couldn't determine architecture!?";
	_exit 5;
}
####
# end of code from debuild
####

# Let's start the action

# Read the state of the packages he want to
# watch
my $state_struct = &read_state_file;

# If there is no state, tell the user that the
# script will create the state file, and
# generate all the packages
if (ref($state_struct) ne "HASH") {
	print "No state was found, this means you never runned this script \n";
	print "before, so, all the packages in $::CONFFILE will be generated.\n";
}

# Grab the actual state of the watched packages
my $newstate_struct = &grab_packages_state($conf_struct);

# Those who have difference will be generated.
my $newpacks_struct = &list_state_diffs($conf_struct,$state_struct,$newstate_struct);

# If no packages to generate
if (ref($newpacks_struct) ne "HASH") {
	print "No packages to generate.\n";
	_exit 0;
}

mkdir $::CVSDIR;
mkdir $::PACKDIR;
my %failed_packages;
foreach my $s (keys %{$newpacks_struct}) {
	$failed_packages{$s} = [];
	next if ref($newpacks_struct->{$s}) ne "HASH";
	print " ======= Starting to work with server $s ======== \n";
	print " creating directory ".$::CVSDIR.$s."\n";
	mkdir($::CVSDIR.$s);
	print " creating directory ".$::PACKDIR.$s."\n";
	mkdir($::PACKDIR.$s);
	my $oldpwd = `pwd`;
	foreach my $p (keys %{$newpacks_struct->{$s}}) {
		print "  = Starting to work with package $p = \n";
		my $cmd;	# var for commands
		######################
		# Checkout the package
		######################
 		# cvsroot MUST be defined,
		# prefix is optional
		unless ($conf_struct->{$s}{$p}{cvsroot} =~ /\S+/) {
			print "Skipping, because no CVSROOT defined.\n";
			push @{$failed_packages{$s}}, $p;
			next;
		}
		
		chdir($::CVSDIR.$s);
		$cmd = "$::CVS -d ".$conf_struct->{$s}{$p}{cvsroot}." checkout ";
		# If the user sets a tag, use it instead of HEAD.
		if ($conf_struct->{$s}{$p}{tag} =~ /S+/) {
			$cmd .= " -r ".$conf_struct->{$s}{$p}{tag}." ";
		} else {
			$cmd .= " -A ";
		}
		$cmd .= $conf_struct->{$s}{$p}{prefix}.$p;
		print $cmd."\n";
		unless (system($cmd) == 0) {
			print "CVS Checkout failed. going to try again in the next run!\n";
			push @{$failed_packages{$s}}, $p;
			next;
		}

		# Generate the package
		mkdir($::PACKDIR.$s."/".$p);
		chdir($::CVSDIR.$s."/".$conf_struct->{$s}{$p}{prefix}."/".$p);
		$cmd = "cvs-buildpackage -W".$::PACKDIR.$s."/".$p." ";
		if ($conf_struct->{$s}{$p}{prefix}) {
			$cmd .= "-x".$conf_struct->{$s}{$p}{prefix};
		}
		$cmd .= " -rfakeroot ";
		$cmd .= $CVSAutoreleasedeb::XMLconf::SERVER_OPT{$s};
		if ($conf_struct->{$s}{$p}{option}{"binary-source"}) {
			$cmd .= " -b";
		}
		print $cmd."\n";

		unless (system($cmd) == 0) {
			print "cvs-buildpackage failed. going to try again in the next run!\n";
			push @{$failed_packages{$s}}, $p;
			next;
		}

		# Upload the packages
		chdir($::PACKDIR.$s."/".$p);

		my $stripedVer = $newstate_struct->{$s}{$p};
		# Remove epoch numbers, that don't go to file name
		if($stripedVer =~ m/^[^:]+:(.+)$/) {
			$stripedVer = $1;
		}
		$cmd = "dupload --to ".$s." ".$p."_".$stripedVer."_".$arch.".changes";

		print $cmd."\n";

		unless (system($cmd) == 0) {
			push @{$failed_packages{$s}}, $p;
			print "dupload failed. going to try again in the next run!\n";
			next;
		}
	}
	# Clean the directories
	my $cmd;
	chdir($oldpwd);
	$cmd = "rm -rf ".$::CVSDIR.$s;
	print $cmd."\n";
	system $cmd;
	$cmd = "rm -rf ".$::PACKDIR.$s;
	print $cmd."\n";
	system $cmd;
}

# revert to the old state the failed packages, so they
# will be generated again in next run.
foreach my $s (keys %failed_packages) {
	foreach my $p (@{$failed_packages{$s}}) {
		if (exists $state_struct->{$s}{$p}) {
			$newstate_struct->{$s}{$p} = $state_struct->{$s}{$p};
		} else {
			delete $newstate_struct->{$s}{$p};
		}
	}
}

# Save the new state
&write_state_file($newstate_struct);

# Everything was ok!!!
# Clean _exit
_exit 0;

###################################################
# SUBROUTINES
###################################################


###################################################
# read_conf_file
# READS THE CONFIGURATION FILE, AND RETURNS AS A
# HASH_REF.
###################################################
sub read_conf_file {
	# if the script is running as a user different
	# of "cvs-autoreleasedeb", it will use the
	# file in the home of the user, else it will use
	# the file in /etc/
	my $conffile;
	if (getpwuid($>) eq "cvs-autoreleasedeb") {
		$conffile = $::CONFFILE;
	} else {
		$conffile = $::USERCONF;
	}
	my $conf_struct;
	if (!-f $conffile) {
		print "The file $conffile was not found.\n";
		_exit 1;
	} else {
		require XML::Parser;
		my $p = eval {
			my $conf_parser = new XML::Parser(Style => "CVSAutoreleasedeb::XMLconf");
			$conf_struct = $conf_parser->parsefile($conffile); # parser package below
		};
		if ($@ || !$p) {
			print "There were errors while trying to read $conffile. Follows the error:$@\n";
			_exit 2;
		}	
	}

	# If the configfile is empty, send message of
	# what the user must do and _exit
	if (ref($conf_struct) ne "HASH") {
		print "No servers in $conffile. See cvs-autoreleasedeb.conf(5).\n";
		_exit 2;
	} else {
		my ($first) = keys %{$conf_struct};
		if (ref($conf_struct->{$first}) ne "HASH") {
			print "No packages in $conffile. See cvs-autoreleasedeb.conf(5).\n";
			_exit 2;
		}
	}
	return $conf_struct;
}

###################################################
# read_state_file
# READS THE STATE FILE, AND RETURNS AS A
# HASH_REF.
###################################################
sub read_state_file {
	my $state_struct;
	if (-f $::STATEFILE) {
		unless (open (STATE, $::STATEFILE)) {
			print "Cannot open $::STATEFILE, I don't know why! Follows the error: $!\n";
			_exit 3;
		}
		while (<STATE>) {
			my ($s,$p,$v) = split(/;/, $_);
			$state_struct->{$s}{$p} = $v;
		}
		close STATE;
	}	
	return $state_struct;
}

##################################################
# write_state_file ($state_struct)
# WRITES THE STATE FILE
##################################################
sub write_state_file {
	my $state_struct = shift;
	return undef unless ref($state_struct) eq "HASH";
	unless (open (STATE, ">".$::STATEFILE)) {
		print "Cannot open $::STATEFILE for writing,\n I don't know why! Follows the error: \n$!\n";
		_exit 4;
	}
	foreach my $s (keys %{$state_struct}) {
		next if ref($state_struct->{$s}) ne "HASH";
		foreach my $p (keys %{$state_struct->{$s}}) {
			print STATE join(';',($s,$p,$state_struct->{$s}{$p}));
			print STATE "\n";
		}
	}
	close STATE;
	return 1;
}

#################################################
# grab_packages_state ($conf_struct)
# GRAB THE ACTUAL STATE OF THE PACKAGES
#################################################
sub grab_packages_state {
	my $conf_struct = shift;
	my $newstate_struct;
	return undef unless ref ($conf_struct) eq "HASH";
	foreach my $s (keys %{$conf_struct}) {
		print "Grabbing the state of packages in server $s\n";
		next if ref $conf_struct->{$s} ne "HASH";
		foreach my $p (keys %{$conf_struct->{$s}}) {
			my $cmd; # Used for commands;
			# cvsroot MUST be defined,
			# prefix is optional
			unless ($conf_struct->{$s}{$p}{cvsroot} =~ /\S+/) {
				print "Skipping $p, because no CVSROOT defined.\n";
				next;
			}
			$cmd = "$::CVS -d ".$conf_struct->{$s}{$p}{cvsroot}." checkout -A -p ".
			  $conf_struct->{$s}{$p}{prefix}.$p."/debian/changelog";
			my $changelog = `$cmd`;
			my $version;
			($version = $changelog) =~ s/^$p \((.+?)\).+$/$1/s;
			print "Package $p in version $version\n";
			$newstate_struct->{$s}{$p} = $version;
		}
	}
	return $newstate_struct;
}

#################################################
# list_state_diffs ($conf_struct,$state_struct,$newstate_struct)
# LIST THE PACKAGES THAT MUST BE GENERATED
#################################################
sub list_state_diffs {
	my $conf_struct = shift;
	my $state_struct = shift;
	my $newstate_struct = shift;
	my $newpacks_struct;
	return undef if ref $conf_struct ne "HASH";
	foreach my $s (keys %{$conf_struct}) {
		next if ref $conf_struct->{$s} ne "HASH";
		foreach my $p (keys %{$conf_struct->{$s}}) {
			if ($vs->compare($newstate_struct->{$s}{$p}, $state_struct->{$s}{$p}) > 0) {
				# Use the date of the commit here.
				$newpacks_struct->{$s}{$p} = scalar(localtime);
			}
		}
	}
	return $newpacks_struct;
}


#################################################################
# PACKAGE FOR XML READING
#################################################################
package CVSAutoreleasedeb::XMLconf;

$CVSAutoreleasedeb::XMLconf::SERVER = '';
$CVSAutoreleasedeb::XMLconf::PACKAGE = '';
%CVSAutoreleasedeb::XMLconf::STRUCT = ();

sub Start {
	my $p = shift;
	my $elem = shift;
	my %vars = @_;
	if ($elem eq "server") {
		$CVSAutoreleasedeb::XMLconf::SERVER = $vars{name};
		$CVSAutoreleasedeb::XMLconf::SERVER_OPT{$vars{name}} = $vars{options};
	} elsif ($elem eq "package") {
		$CVSAutoreleasedeb::XMLconf::PACKAGE = $vars{name};
		$CVSAutoreleasedeb::XMLconf::STRUCT{$CVSAutoreleasedeb::XMLconf::SERVER}{$CVSAutoreleasedeb::XMLconf::PACKAGE} = \%vars;
	} elsif ($elem eq "option") {
		$CVSAutoreleasedeb::XMLconf::STRUCT{$CVSAutoreleasedeb::XMLconf::SERVER}{$CVSAutoreleasedeb::XMLconf::PACKAGE}{option}{$vars{name}} = $vars{value};
	}
}

sub End {
	my $p = shift;
	my $elem = shift;
	if ($elem eq "server") {
		$CVSAutoreleasedeb::XMLconf::SERVER = ''
	} elsif ($elem eq "package") {
		$CVSAutoreleasedeb::XMLconf::PACKAGE = '';
	}
}

sub Final {
	return \%CVSAutoreleasedeb::XMLconf::STRUCT;
}

