#!/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;
use File::Spec;

my %config;

my ($log, $top, $rpm);

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 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 fill_global_variable {
    	my ($pkgrpm) = @_;
	$top = $config{top} || `rpm --eval '%_topdir'`;
	chomp($top);
	if ($config{log})
	{
	    my $basename = basename($pkgrpm);
	    mkdir_p("$top/log");
	    my $logfile = "$top/log/${basename}.log";
	    $log = " >> $logfile 2>&1";
	    print "Logs are in $logfile\n";
	} else {
	    $log = "";
	}
	$rpm =  qq(rpm --define  "_topdir $top");
}


sub build_from_spec {
	my ($spec_path, $newversion) = @_;
	my $rpm_tag = (split(/\n/,`rpm -q  $config{rpmoption}  --queryformat  '%{NAME} %{VERSION} %{RELEASE}\n' --specfile $spec_path`))[0];
	my ($pkg, $version, $release) = split(/ /, $rpm_tag);
	fill_global_variable($pkg);
	$spec_path = File::Spec->rel2abs($spec_path);
	chdir("$top/SOURCES") or die "Unable to chdir to $top/SOURCES";
	build($spec_path,$pkg,$version,$release,$newversion);
}

sub build_from_repository {
	my ($pkg, $newversion) = @_;
	my $pkge = $pkg;
	$pkge =~ s/\+/\\+/;
	my $found = 0;
	my $pkgrpm;

	foreach my $srpm_dir (split(/,/, $config{srpms})) {
		opendir(MP, $srpm_dir) or die "$srpm_dir is not a directory";
		my @rpms = readdir(MP);
		foreach (@rpms) 
		{
			if (m|^($pkge)-([^-]+)-([^-]+)\.[^\.]+\.rpm|)
			{ $config{src} = $pkgrpm = "$srpm_dir/$_"; $found = 1; last }
		}
		closedir(MP);
		last if $found;
	}	
	if ($found == 0) { print "Package $pkg has no source, skipping.\n\n"; return }
	build_from_src($pkgrpm,$newversion);
}

sub build_from_src {
	$_ = shift;
	my $newversion = shift;
	my $b = basename($_);
	die "Cannot parse the name of rpm " if $b !~ m|^(.*)-([^-]+)-([^-]+)\.[^\.]+\.rpm|;

	my $pkgrpm = $_;
	my $pkg = $1;
	
	$pkgrpm = File::Spec->rel2abs($pkgrpm);
	fill_global_variable($pkgrpm);
	my $found = 0;
	my ($version, $release);

	chdir("$top/SOURCES") or die "Unable to chdir to $top/SOURCES";
	
	my $pkge = $pkg;
	$pkge =~ s/\+/\\+/;
	
	my $pkgrpm_basename = basename($pkgrpm);
	if ($pkgrpm_basename =~ m|^(.*)-([^-]+)-([^-]+)\.[^\.]+\.rpm|)
	{ $pkg=$1; $version = $2; $release = $3 }
	
	if ($config{deps})
	{
		system_die("sudo /usr/sbin/urpmi --auto --force $pkgrpm $log");
	}
	
	system_die("$rpm -ivh $pkgrpm $log");
	
	my $spec_path="../SPECS/$pkg.spec";
	build($spec_path,$pkg,$version,$release,$newversion);
}
    
sub build {
	my ($spec_path, $pkg, $version, $release, $newversion) = @_;
	my ($message, $spec, @url, %specvars);
	my ($newrelease, $release_prefix) = ($1,$2) if $release =~ /^(.*\d+)(\D*)$/g;

	if ($newversion) {
    		print "===> Building $pkg $newversion\n";
	} else {    
		print "===> Rebuilding $pkg\n";
	}

	
	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};

	
	my $SPECFILE;
	if (!open($SPECFILE, $spec_path))
	{
		print STDERR "Unable to open spec file $spec_path.\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/;

		eval $config{execute} if $config{execute};
		
		$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/g)
		{
		    	$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 %d %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};
		# add jabberstudio, collabnet, http://www.sourcefubar.net/, http://sarovar.org/
		my @sf_like = ( {
		    download => 'http://prdownloads.sourceforge.net/$1/$2' ,
		    regexp => 'http://(.*)\.(?:sourceforge|sf)\.net/?(.*)'
		},
		{ # to test
		    download => 'http://download.gna.org/$1/$2',
		    regexp => 'https?://gna.org/projects/([^/]*)/(.*)'
		},
		{
		    download => 'http://download.berlios.de/$1/$2' ,
		    regexp => 'http://(.*)\.berlios.de/(.*)'
		},
		{ # to test , and to merge with regular savanah ?
		    download => 'http://savannah.nongnu.org/download//$1/$2',
		    regexp => 'https?://savannah.nongnu.org/projects/([^/]*)/(.*)'
		},
		{ # to test
		    download => 'http://savannah.gnu.org/download//$1/$2',
		    regexp => 'https?://savannah.gnu.org/projects/([^/]*)/(.*)'
		},
		);
		
		# http://jabberstudio.org/files/ejogger/
		# http://jabberstudio.org/projects/ejogger/project/view.php	
		foreach my $sf (@sf_like)	
		{
			if  ( $url =~ m/$sf->{regexp}/ )
			{
			    $sf->{download} =~ s/^/"/;
			    $sf->{download} =~  s/$/"/;
			    $url =~ s/$sf->{regexp}/"$sf->{download}"/eeg;
			}    
		}
		
 		push(@url, "$url/$tar_ball")
	}
	
	my $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;
			my $pkge = $pkg;
			$pkge =~ s/\+/\\+/;

			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;
	
	unless ($config{noupdate})
	{
		# TODO use output ? 	
		open($SPECFILE, ">$spec_path") 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 $config{rpmoption} $spec_path $log"))
	{
		print "Binary build fails: building source only\n";
		system("$rpm -bs $config{rpmoption} --nodeps $spec_path $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("spec",
								{	ARGS => "=s",
									ARGCOUNT => AppConfig::ARGCOUNT_ONE	}
								);
								
	$conf->define("rpmoption",
								{	ARGS => "=s",
									DEFAULT => "",
									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("noupdate",
								{
	    								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 	}
								);	

	$conf->define("execute",
								{	ARGS => "=s",
									DEFAULT => "",
									ARGCOUNT => AppConfig::ARGCOUNT_ONE	}
								);
	
	foreach my $f ('/etc/rpmbuildupdate.conf', "$ENV{HOME}/.rpmbuildupdaterc")
	{	
		-f $f && $conf->file($f);
	}	
	$conf->args;
	$config{rpmmon} = $conf->get("rpmmon");
	$config{deps} = $conf->get("deps");
	$config{srpms} = $conf->get("srpms");
	$config{spec} = $conf->get("spec");
	$config{src} = $conf->get("src");
	$config{release} = $conf->get("release");
	$config{noupdate} = $conf->get("noupdate");
	$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{rpmoption} = $conf->get("rpmoption");
	$config{log} = $conf->get("log");
	$config{execute} = $conf->get("execute");

}

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, separate folder with a comma\n";
	print " --src <src.rpm file> <new version>: build new version from this source RPM\n";
	print " --spec <spec file> <new version>: build new version from this spec file\n";
	print " --rpmoption <rpm option>: use this option when rebuilding ( --with , mainly )\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 " --noupdate: do not touch to the spec file\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";
	print " --execute <command>: execute an arbitrary perl command for each line of the spec file\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_from_repository($1, $3) if /^\s+(\S+)\s+(\S+)\s+(\S+)$/ && ! /Package/; 
		build_from_repository($2, $4) if /^(\S+)\s+(\S+)\s+(\S+)\s+(\S+)$/ && ! /Package/; 
	}
	close($RPMMON);
}

sub check_dir {
	$_ = shift;
	foreach my $dir (split(/,/))
	{
		-d $dir or die $dir . " is not a directory.\n";
	}	
}


sub main {
	parse_argv;
	wget_check;
	if ($config{rpmmon}) {
		print($config{srpms});
		parse_rpmmon($config{rpmmon})
	} else  {
	    my ($new_version,$name);
	    if ($config{src} or $config{spec}) 
	    {
		$new_version = $ARGV[0] || undef;
	    }
    	    elsif ($ARGV[0])
	    {
		$name= $ARGV[0]; $new_version = $ARGV[1];
		if (-f $name) 
		{
	    	    $name =~ /.spec$/ and $config{spec} = $name;
		    # FIXME better auto detection with nosrc.rpm ?
		    $name =~ /.src.rpm$/ and $config{src} = $name;
		}    
	    }
	    if ($config{src}) {
			build_from_src($config{src}, $new_version)
	    } elsif ($config{spec}) {
			build_from_spec($config{spec},$new_version)
	    } elsif ($name) {
			check_dir($config{srpms});
			build_from_repository($name,$new_version)
	    } else {
			usage
	    }	
	}
}

main;