#!/usr/bin/perl -w
#
# rpmbuildupdate by Julien Danjou
#
# Copyright (c) 2003-2004 by MandrakeSoft
#
# Permission to use, copy, modify, and distribute this software and its
# documentation under the terms of the GNU General Public License is hereby 
# granted. No representations are made about the suitability of this software 
# for any purpose. It is provided "as is" without express or implied warranty.
# See the GNU General Public License for more details.
#
# $Id$

# TODO
# do not hardcode sudo urpmi command ( to use --deps on cluster )
# rework configuration option

use strict;
use AppConfig;

use File::Copy; 
use MDK::Common::File qw(:all);
use Cwd;

my %config;

sub system_die {
    my ($command, $message) = @_;
    $message ||= "$command failed";
    # do not forget , return value of 1 means failure in unix
    system($command) and die $message;
}

sub build_from_src {
	$_ = shift;
	my $nv = shift;
	my $b = basename($_);
	if ($b =~ m|^(.*)-([^-]+)-([^-]+)\.[^\.]+\.rpm|)
	{ build($1, $nv, $_) }
}

sub file_not_found {
	my ($basename) = @_;
	! -f $basename and return 1;
	# sometimes, the webserver return a webpage when the file is not found, instead of letting wget fails
	# see wget http://www.wesnoth.org/files/wesnoth-0.7.1.tar.bz2 
	# So if the file is a html page, then it is a error and it should be removed.
	is_html($basename) and do { rm_rf($basename); return 1 };
	return 0;
}

sub is_html {
    	my ($basename) = @_;
	`file $basename` =~ /HTML/i and return 1;
	return 0;
}

sub download {
	my $wget = "wget -N -q";
 	my ($url)=@_;
	my $temp = basename($url);
	print "Trying to fetch $url...\n";
	system("$wget $url;");
	-f $temp && ! is_html($temp) && $temp !~ /.bz2$/ && system_die("bzme $temp", "Cannot convert $temp");  
}

sub fetch {
    my ($url) = @_;
    # if you add a handler here, do not forget to add it to the body of build()
    return fetch_http($url) if $url =~ m!^(ftp|https?)://!;
    return fetch_svn($url) if $url =~ m!^svns?://!; 
}

sub fetch_svn {
    my ($url) = @_;
    my ($basename, $repos);
   
    $basename = basename($url);
    ($repos = $url) =~ s|/$basename$||;
    $repos =~ s/^svn/http/;
    die "Cannot extract revision number from the name." if $basename !~ /^(.*)-([^-]*rev)(\d\d*).tar.bz2$/;
    my ($name, $prefix, $release) = ($1, $2, $3);
    my $dir="$ENV{TMP}/rpmbuildupdate-$$"; 
    my $current_dir = cwd();
    mkdir $dir or die "Cannot create dir $dir";
    chdir $dir or die "Cannot change dir to $dir";
    system_die("svn co -r $release $repos", "svn checkout failed on $repos");
    my $basedir = basename($repos);
   
    # FIXME quite inelegant, should use a dedicated cpan module.
    my $complete_name = "$name-$prefix$release";
    move($basedir, $complete_name);
    system_die("find $complete_name -name '.svn' | xargs rm -Rf");
    system_die("tar -cjf $complete_name.tar.bz2 $complete_name", "tar failed");
    system_die("mv -f $complete_name.tar.bz2 $current_dir");
    chdir $current_dir;
}

sub fetch_http {
    my ($url) = @_;
    my $basename = basename($url);
    my $turl;

    rm_rf($basename) if $config{nobuild};
    
    download($url);
    foreach ('.tar.gz', '.tgz', '.zip')
    { 
	    ($turl = $url) =~ s/\.tar\.bz2/$_/;
	    download($turl) if file_not_found($basename);
    }
    return ! file_not_found($basename);
}

sub build {
	my $pkg = shift;
	my $newversion = shift;
	my $pkgrpm = shift;
	my ($rpm, $log);
	my ($release_prefix, $newrelease, $message);
	my $found = 0;
	my ($version, $release);
	my ($spec, @url, @rpms, %specvars);

	my $top = $config{top} || `rpm --eval '%_topdir'`;
	chomp($top);
	chdir("$top/SOURCES") or die "Unable to chdir to $top/SOURCES";

	$rpm =  qq(rpm --define  "_topdir $top");
	
	if ($newversion) {
    		print "===> Building $pkg $newversion\n";
	} else {    
		print "===> Rebuilding $pkg\n";
	}

	    
	
	my $pkge = $pkg;
	$pkge =~ s/\+/\\+/;
	
	# Search for file if we do not use --src
	if (!$config{src})
	{
		opendir(MP, $config{srpms}) or die "$config{srpms} is not a directory";
		@rpms = readdir(MP);

		foreach (@rpms) 
		{
			if (m|^($pkge)-([^-]+)-([^-]+)\.[^\.]+\.rpm|)
			{ $config{src} = $pkgrpm = "$config{srpms}/$_"; $version = $2; $release = $3; $found = 1; last }
		}
		
		closedir(MP);
		
		if ($found == 0) { print "Package $pkg has no source, skipping.\n\n"; return }
	} else {
		my $pkgrpm_basename = basename($pkgrpm);
		if ($pkgrpm_basename =~ m|^(.*)-([^-]+)-([^-]+)\.[^\.]+\.rpm|)
		{ $pkg=$1; $version = $2; $release = $3; $found = 1 }
	}

	($newrelease,$release_prefix) = ($1,$2) if $release =~ /^(.*\d+)(\D*)$/g;
	
	if (! defined($newversion)) {
		$newversion = $version; 
		my @tmp = split(/\./,$newrelease);
		$tmp[-1]++;
		$newrelease = join('.',@tmp) . $release_prefix;
        	$message = $config{message} || '- Rebuild';
	} else {
        	$message = $config{message} || '- New release %%VERSION';
		$newrelease = "1$release_prefix";
	}
	$newrelease = $config{release} if $config{release};
	
	if ($config{log})
	{
	    my $basename = basename($pkgrpm);
	    mkdir_p("$top/log");
	    $log = " >> $top/log/${basename}.log 2>&1";
	} else {
	    $log = "";
	}
	
	if ($config{deps})
	{
		system_die("sudo /usr/sbin/urpmi --auto --force $pkgrpm $log");
	}
	
	if ($config{src})
	{
		system_die("$rpm -ivh $pkgrpm $log");
	        $config{src} = 0;
	} elsif (!$config{nosource}) {
		system_die("/usr/sbin/urpmi --install-src --force $config{srpms} $log");
	}

	$found = 0;
	
	my $SPECFILE;
	if (!open($SPECFILE, "../SPECS/$pkg.spec"))
	{
		print STDERR "Unable to open spec file !\n";
		return;
	}

	my $tar_ball='';
	while (<$SPECFILE>)
	{
		# Doing a s/// version
		s/\%define\s+version\s+$version/\%define version $newversion/g;
		s/Version:\s+$version/Version: $newversion/g;
		s/Release\s*:\s*$release/Release: $newrelease/;
		s/\%define(\s+)release(\s+)(.*)/\%define release $newrelease/;
		
		$spec .= $_;
		push(@url, $2) if /(Source[0-9]*)\s*:\s+((?:ftp|svns?|https?):\S+)/i;
		$tar_ball=$2 if /(Source[0-9]*)\s*:\s+([^:\s]+)/i && ! $tar_ball;
		
		# For %vars !
		$specvars{$1} = $2 if /\%define\s+(\S+?)\s+(\S+)/g;
		foreach my $i ('url', 'name', 'version', 'release')
		{
			$specvars{$i} = $1 if !$specvars{$i} && /$i\s*:\s+(\S+)/gi;
		}
		 
		if (/\%changelog/)
		{
		    	$message =~ s/\%\%VERSION/$newversion/;
			my @l = getpwuid($<);
			my $packager = `rpm --eval '\%packager'`;
			chomp($packager);
			# if macro is undefined
			$packager =~ s/\%packager//g;
			my $email = $packager ? $packager : $l[6] . ($ENV{EMAIL} ? " <$ENV{EMAIL}>" : " <$l[0]\@mandrakesoft.com>");
			$spec .= "* " . `LC_TIME=C date '+%a %b %e %Y'|tr -d '\n'` . " $email $newversion-$newrelease\n";
			$spec .= "$message\n\n";
		}
	}
	close($SPECFILE);


	if (!$url[0] )
	{ 
		print "URL of sources was not found ! Trying to guess it with url tag ...\n";
		my $url = $specvars{url};
		if ($url =~ m!http://(.*)\.((?:sourceforge|sf)\.net)/(.*)!)
		{
			$url="http://prdownloads.$2/$1/$3" unless $1 eq 'prdownloads';
		}
 		push(@url, "$url/$tar_ball")
	}
	
	$found = 0;
	
	foreach (@url)
	{
		# Replace variable from spec (%blabla)
		while (/\%/)
		{
		    s/\%\{(.*?)\}/$specvars{$1}/g;
		    s/\%(\w+)/$specvars{$1}/g;
		    s/\%\{name\}/$pkg/gi;
		    s/\%\{version\}/$newversion/gi;
		}

		my $basename = basename($_);

		rm_rf("${top}/SOURCES/$basename") if $config{nobuild};
		
		# GNOME: add the major version to the URL automatically
		# for example: ftp://ftp://ftp.gnome.org/pub/GNOME/sources/ORbit2/ORbit2-2.10.0.tar.bz2
		# is rewritten in ftp://ftp.gnome.org/pub/GNOME/sources/ORbit2/2.10/ORbit2-2.10.0.tar.bz2
		if (m!ftp.gnome.org/pub/GNOME/sources/!)
		{
		    (my $major = $newversion) =~ s/([^.]+\.[^.]+).*/$1/;
		    s!(.*/)(.*)!$1$major/$2!;
		}
		
		# download from Fedora rpms
		if (/ftp\.redhat\.com/)
		{
			opendir(MP, $config{fedora}) or die "$config{fedora} is not a directory";
			my @rpmsrh = readdir(MP);
			
			my $pkgrpmrh;
			foreach (@rpmsrh) 
			{
				if (m|^($pkge)-([^-]+)-([^-]+)\.[^\.]+\.rpm|)
				{ $pkgrpmrh = $_; last }
			}
			
			closedir(MP);

			print "Trying from fedora($basename): $config{fedora}/$pkgrpmrh\n";
			system_die("cd ${top}/SOURCES; rpm2cpio $config{fedora}/$pkgrpmrh | cpio -id $basename", "Rpm extraction failed");

			if (! -f "${top}/SOURCES/$basename")
			{
			    (my $bname = $basename) =~ s/bz2/gz/;
			    print "Trying from fedora($bname): $config{fedora}/$pkgrpmrh\n";
			    system("cd ${top}/SOURCES; rpm2cpio $config{fedora}/$pkgrpmrh | cpio -id $bname; bzme $bname", "rpm recompression failed");
			}
		}
		# download from sourceforge mirrors
		if (m!http://prdownloads.sourceforge.net!)
		{
		    foreach my $site ("http://ovh.dl.sourceforge.net/sourceforge/",
				      "http://heanet.dl.sourceforge.net/sourceforge/",
				      "http://aleron.dl.sourceforge.net/sourceforge/",
				      "http://keihanna.dl.sourceforge.net/sourceforge/",
				      "http://belnet.dl.sourceforge.net/sourceforge/",
				      "http://unc.dl.sourceforge.net/sourceforge/",
				      "http://twtelecom.dl.sourceforge.net/sourceforge/",
				      )
		    {
			(my $dest = $_) =~ s!http://prdownloads.sourceforge.net/!$site!;
			last if fetch_http($dest);
		    }
		}
		# download specified url
		if (! -f "${top}/SOURCES/$basename")
		{
		    fetch($_);
		}

		$found++ if -e $basename;
		chmod(0644, "${top}/SOURCES/$basename");
	}

	# some specs have no source ( php )
	$found++ if ! $tar_ball;
	
	# TODO use output ? 	
	open($SPECFILE, ">../SPECS/$pkg.spec") or die "Unable to open $pkg.spec";
	print $SPECFILE $spec;
	close($SPECFILE);


	if (!$found)
	{
	    print "Unable to download file: URL is not valid ! :-(\n\n";
	    return;
	} elsif ($config{nobuild}) {
	    print "All files downloaded\n";
	    return;
	}

	if (system("$rpm -ba ../SPECS/$pkg.spec $log"))
	{
		print "Binary build fails: building source only\n";
		system("$rpm -bs --nodeps ../SPECS/$pkg.spec $log");
	}
}

sub wget_check {
	my $wgetv = `wget --version`;
	$wgetv =~ /Wget/ or die "You need `wget' binary for FTP/HTTP download\n";
}

sub parse_argv {
	my $conf = AppConfig->new({ CASE => 1, ERROR => \&usage });
	
	$conf->define("rpmmon",
								{	ARGS => "=s",
									ALIAS => "r",
									ARGCOUNT => AppConfig::ARGCOUNT_ONE	}
								);

	$conf->define("release",
								{	ARGS => "=s",
									DEFAULT => "",
									ARGCOUNT => AppConfig::ARGCOUNT_ONE	}
								);

	$conf->define("srpms",
								{	ARGS => "=s",
									ALIAS => "m",
									DEFAULT => "/mnt/BIG/distrib/cooker/SRPMS/",
									ARGCOUNT => AppConfig::ARGCOUNT_ONE	}
								);

	$conf->define("src",
								{	ARGS => "=s",
									ALIAS => "s",
									ARGCOUNT => AppConfig::ARGCOUNT_ONE	}
								);

	$conf->define("fedora",
								{	ARGS => "=s",
									ALIAS => "h",
									DEFAULT => "/mnt/BIG/distrib/fedora/development/SRPMS/",
									ARGCOUNT => AppConfig::ARGCOUNT_ONE	}
								);

	$conf->define("deps",
								{	ALIAS => "d",
									DEFAULT => 0,
									ARGCOUNT => AppConfig::ARGCOUNT_NONE }
								);

	$conf->define("nosource",
								{	ALIAS => "n",
									DEFAULT => 0,
									ARGCOUNT => AppConfig::ARGCOUNT_NONE	}
								);
	
	$conf->define("top",
								{	ARGS => "=t",
									ALIAS => "h",
									DEFAULT => 0,
									ARGCOUNT => AppConfig::ARGCOUNT_ONE	}
								);
	$conf->define("nobuild",
								{	ALIAS => "c",
									DEFAULT => 0,
									ARGCOUNT => AppConfig::ARGCOUNT_NONE	}
								);

	$conf->define("log",
								{	ALIAS => "l",
									DEFAULT => 0,
									ARGCOUNT => AppConfig::ARGCOUNT_NONE	}
								);
	$conf->define("changelog",
								{
									ARGS => "=s",
									# default is defined at the beggining of build
									# as it depend if this is a new version or a simple rebuild
									DEFAULT => "",
									ARGCOUNT => AppConfig::ARGCOUNT_ONE 	}
								);	
	
	foreach my $f ('/etc/rpmbuildupdate.conf', "$ENV{HOME}/.rpmbuildupdate.conf")
	{	
		-f $f && $conf->file($f);
	}	
	$conf->args;
	$config{rpmmon} = $conf->get("rpmmon");
	$config{deps} = $conf->get("deps");
	$config{srpms} = $conf->get("srpms");
	$config{src} = $conf->get("src");
	$config{release} = $conf->get("release");
	$config{nosource} = $conf->get("nosource");
	$config{fedora} = $conf->get("fedora");
	$config{top} = $conf->get("top");
	$config{nobuild} = $conf->get("nobuild");
	$config{message} = $conf->get("changelog");
	$config{log} = $conf->get("log");

}

sub usage {
	print "rpmbuildupdate v0.4 helps you build up to date RPMs.\n\n";
	print "By Julien Danjou\n";
	print "Copyright (c) 2003-2004 by MandrakeSoft.\n";
	print "This is free software under the GPL License.\n";
	print "Usage: rpmbuildupdate [options] [pkg] [newversion]\n\n";

	print " --rpmmon <file>: parse output of rpmmon from file\n";
	print " --srpms <path_to_srpms>: specify SRPMS path\n";
	print " --src <src.rpm file> <new version>: build new version from this source RPM\n";
	print " --release <mdk_release>: release version of package (default: 1mdk)\n";
	print " --changelog <changelog message>: use a alternate message. \%\%VERSION is replace by version\n";
	print " --deps: install builds dependencies\n";
	print " --log: log builds\n";
	print " --nosource: do not install source from (urpmi x.src.rpm)\n";
	print " --top <dir>: specify rpm top dir (default: `rpm --eval %_topdir`)\n";
	print " --nobuild|-c: do not build the package. Only download files.\n";
	exit 0;
}

sub parse_rpmmon {
	my $f = shift;
	-f $f or die "Error: $f is not a file.\n";
	
	open(my $RPMMON, $f);
	while (<$RPMMON>)
	{
		build($1, $3) if /^\s+(\S+)\s+(\S+)\s+(\S+)$/ && ! /Package/; 
		build($2, $4) if /^(\S+)\s+(\S+)\s+(\S+)\s+(\S+)$/ && ! /Package/; 
	}
	close($RPMMON);
}

sub check_dir {
	$_ = shift;
	-d $_ or die $_ . " is not a directory.\n";
}


sub main {
	parse_argv;

	wget_check;
	
	if ($config{rpmmon}) {
		print($config{srpms});
		parse_rpmmon($config{rpmmon})
	} elsif ($config{src} && $ARGV[0]) {
		build_from_src($config{src}, $ARGV[0]) 
	} elsif ($ARGV[0] && $ARGV[1]) { 
		check_dir($config{srpms});
		build($ARGV[0], $ARGV[1])
	} elsif ($config{src}) {
		 build_from_src($config{src})
	} else {
	    usage 
	}
}

main;