#!/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|) {
		$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 {
    my ($pkgrpm, $newversion) = @_;
    my $b = basename($pkgrpm);
    die "Cannot parse the name of rpm " if $b !~ m|^(.*)-([^-]+)-([^-]+)\.[^\.]+\.rpm|;

    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("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{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 " --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) = @_;
    -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 {
    my ($list) = @_;
    foreach my $dir (split(/,/, $list)) {
	-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 ($name, $version);
	if ($ARGV[0]) {
	    $name    = $ARGV[0];
	    $version = $ARGV[1];
	    if (-f $name) {
		build_from_spec($name, $version) if $name =~ /.spec$/;
		build_from_src($name, $version) if $name =~ /.(?:no)?src.rpm$/;
	    } else {
		check_dir($config{srpms});
		build_from_repository($name, $version)
	    }
	} else {
	    usage;
	}
    }
}

main;