updateallcpan

#! /usr/bin/perl

# Copyright (C) 2015-2016 Stephan Kulow <coolo@suse.com>

# This program is free software; you can redistribute it
# and/or modify it under the same terms as Perl itself.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

use strict;
use warnings;
use XML::Simple;
use Data::Dumper;
use Compress::Zlib;
use version;
use List::Util;
use File::Basename;
use Storable;
use Parse::CPAN::Packages;

require CPAN::Meta::Requirements;
use File::Temp qw/tempdir tempfile/;
use File::Copy qw/copy/;

my $scriptdir;

#my $mirror = 'ftp://cpan.mirror.iphh.net/pub/CPAN';
my $mirror = 'http://cpan.noris.de';

BEGIN {
    ($scriptdir) = $0 =~ m-(.*)/-;
    $scriptdir ||= '.';
    use Cwd 'abs_path';
    $scriptdir = abs_path($scriptdir);
}

my $modpath = glob("~/.cpan/sources/modules");
my $details = "02packages.details.txt.gz";
chdir($modpath) || die "call cpan once to create $modpath";
system("wget -qm -nd http://www.cpan.org/modules/$details");

my %upstream;

my $letter = $ARGV[0];
my %lpkgs;
my $cache = {};
eval { $cache = retrieve("$scriptdir/obs_cache"); };

my $xml;

my %autoupdate;

if ($letter) {
    open(my $statusfh, "-|", "osc api /status/project/devel:languages:perl");
    $xml = XMLin($statusfh)->{entry};
    close($statusfh);

    open($statusfh, "-|", "osc api /source/devel:languages:perl:CPAN-$letter?view=info");
    my $info = XMLin($statusfh)->{sourceinfo};
    close($statusfh);
    for my $pi (@$info) {
        if (!defined $cache->{$pi->{srcmd5}}) {
            # TODO: cache
            print "CURL $pi->{package}\n";
            open(my $statusfh, "-|", "osc api /source/devel:languages:perl:CPAN-$letter/$pi->{package}");
            my $pxml = XMLin($statusfh);
            close($statusfh);
            for my $entry (keys %{$pxml->{entry}}) {
                if ($entry =~ m/\.tar/ || $entry =~ m/\.tgz$/ || $entry =~ m/\.zip$/) {
                    my $name = $pxml->{name};
                    $lpkgs{$name} = $entry;
                }
            }
            $cache->{$pi->{srcmd5}} = $lpkgs{$pi->{package}} || '';
            store $cache, "$scriptdir/obs_cache";
        }
        else {
            $lpkgs{$pi->{package}} = $cache->{$pi->{srcmd5}};
        }
    }
}
else {
    open(my $statusfh, "-|", "osc api /status/project/devel:languages:perl");
    $xml = XMLin($statusfh)->{package};
    close($statusfh);

    open($statusfh, "-|", "osc api /source/devel:languages:perl:autoupdate");
    my $info = XMLin($statusfh)->{entry};
    close($statusfh);
    for my $p (keys %$info) {
        $autoupdate{$p} = 1;
    }
}

my %letter_todo;

my $p = Parse::CPAN::Packages->new("02packages.details.txt.gz");
my %seen_distris;
for my $m ($p->packages) {
    $m = $m->distribution;
    if (!$m->version) {
	#printf "Distribution %s has no version defined\n", $m->prefix;
	next;
    }
     next if $seen_distris{$m->prefix} && $seen_distris{$m->prefix}[0] eq $m->version;
     next unless $m->dist;
     my $version;
     eval { $version = version->parse($m->version); };
     $version ||= version->declare('0');
     $seen_distris{$m->prefix} = [ $m->version, $version ];
     my $url     = $m->prefix;
     my $uversion;
     $uversion = $upstream{$m->dist}[0] if defined $upstream{$m->dist};
     $uversion ||= version->declare('0');
     #printf "PKG $url $version %s - %s (%s vs %s)\n", $m->dist, $m->filename, $uversion->stringify, $version->stringify;
     next if $version < $uversion;
     $upstream{$m->dist} = [$version, $url];
     if ($letter) {
         my $tar = $m->filename;
         if ($tar && uc(substr($tar, 0, 1)) eq $letter) {
             if (basename($tar, qw/.tar.gz .tgz .zip/) =~ m!^(\S+)-([^-]*)$!) {
                 my $pkg = $1;
                 while ($pkg =~ m/^(.*)-(v?[0-9][^-]*)$/) {
                     $pkg = $1;
                 }
                 next if defined $xml->{"perl-$pkg"};
                 my $obs = $lpkgs{"perl-$pkg"} || '';
                 next if $obs eq 'done';
                 $letter_todo{$pkg} = [$tar, $obs, $url] if $obs ne $tar;
                 $lpkgs{"perl-$pkg"} = 'done';
             }
         }
     }
}

if ($letter) {
    for my $pkg (sort keys %letter_todo) {

	my ($tar, $obs, $url) = @{$letter_todo{$pkg}};
	my ($fh, $filename) = tempfile();
	print $fh "<package name='perl-$pkg'><title/><description/><build><disable/></build></package>\n";
	close($fh);
	system("osc meta pkg devel:languages:perl:CPAN-$letter perl-$pkg -F $filename");
	if ($obs) {
	    print "osc api -X DELETE /source/devel:languages:perl:CPAN-$letter/perl-$pkg/$obs\n";
	    system("osc api -X DELETE /source/devel:languages:perl:CPAN-$letter/perl-$pkg/$obs");
	}
	my $tempdir = tempdir(CLEANUP => 1);
	chdir($tempdir);
	system("osc co devel:languages:perl:CPAN-$letter/perl-$pkg") == 0
	  or goto CHDIR;
	print "TAR $tar '$obs' '$pkg'\n";
	chdir("devel:languages:perl:CPAN-$letter/perl-$pkg") || die "can't chdir";
	#print "wget -nc -q $mirror/authors/id/$url\n";
	system("wget -nc -q $mirror/authors/id/$url");
	my $worked;
	unlink("perl-$pkg.spec");
	if (system("$scriptdir/cpanspec -v -f --skip-changes $tar > cpanspec.error 2>&1") == 0 && -f "perl-$pkg.spec") {
	    unlink("cpanspec.error");
	    $worked = 1;
	}
	system("osc addremove") == 0
	  or goto CHDIR;
	my $noarch;
	if (-f "perl-$pkg.spec") {
	    open(SPEC, "perl-$pkg.spec");
	    while (<SPEC>) {
		$noarch = 1 if m/^BuildArch.*noarch/;
	    }
	    close(SPEC);
	}
	($fh, $filename) = tempfile();
	if ($worked) {
	    if ($noarch) {
		print $fh "<package name='perl-$pkg'><title/><description/><build><disable arch='i586'/></build></package>\n";
		print "build disable i586\n";
	    }
	    else {
		print $fh "<package name='perl-$pkg'><title/><description/></package>\n";
		print "build enable all\n";
	    }
	    close($fh);
	    #print "osc meta pkg devel:languages:perl:CPAN-$letter perl-$pkg -F $filename\n";
	    system("osc meta pkg devel:languages:perl:CPAN-$letter perl-$pkg -F $filename");
	}
	system("osc ci -mupdate");
      CHDIR: # finally emulation
	chdir("/tmp");
    }

    for my $pkg (sort keys %lpkgs) {
        next if $lpkgs{$pkg} eq 'done';
        print "osc rdelete -mgone devel:languages:perl:CPAN-$letter $pkg\n";
        system "osc rdelete -mgone devel:languages:perl:CPAN-$letter $pkg";
    }
    exit(0);
}

my $tocreate = 3000;

my @pkgs = List::Util::shuffle(keys %$xml);
@pkgs = sort keys %$xml;
my %tobuild;
while ((@pkgs && $tocreate) || %tobuild) {
    if (%tobuild) {
        my $url    = "/build/devel:languages:perl:autoupdate/_result?";
        my @tocheck = sort keys %tobuild;
        $url .= "package=" . shift @tocheck;
        $url .= "&package=$_" for (@tocheck);
        print "checking '$url'\n";
        open(my $fh, "-|", "osc api '$url'");
        my $res = XMLin($fh, forcearray => [qw/status/]);
        #print Dumper($res);
        close($fh);

        if ($res && $res->{result}->{status} && ($res->{result}->{dirty} || '') ne 'true') {
            #print Dumper($res);
            for my $status (@{$res->{result}->{status}}) {
                my $code = $status->{code} || 'unscheduled';
                if ($code && $code eq 'finished') {
                    $code = $status->{details} || 'unknown';
                }
                my $built = $status->{package};
                print "CODE $built $code\n";
                if ($code eq 'succeeded') {
                    system("osc sr -m 'automatic update' devel:languages:perl:autoupdate $built devel:languages:perl --clean < /dev/null");
                    delete $tobuild{$built};
                }
                if ($code eq 'failed' || $code eq 'unresolvable' || $code eq 'broken') {
                    delete $tobuild{$built};
                }
            }
        }
    }
    if ($tocreate && @pkgs) {
        my $pkg = shift @pkgs;
        next unless $pkg =~ m,^perl-,;
        my $ups = $pkg;
        $ups =~ s,^perl-,,;
        if (!defined($upstream{$ups}[0])) {
		print "echo osc rdelete -mgone devel:languages:perl/$pkg\n";
        }
        next unless defined($upstream{$ups}[0]);
        my $obs_version;
        eval { $obs_version = version->parse($xml->{$pkg}->{version}); };
        next unless $obs_version;
        my $older = $obs_version < $upstream{$ups}[0];
        if (!$older) {
            system("osc rdelete -mfresh -f devel:languages:perl:autoupdate $pkg") if $autoupdate{$pkg};
            #print "PKG $pkg " . $obs_version . " $ups " . $upstream{$ups}[0] . " NEWER\n";
            next;
        }
        print "PKG $pkg " . $obs_version . " $ups " . $upstream{$ups}[0] . " " . ($older ? 'OLDER' : 'NEWER') . "\n";
	my $ntar = basename($upstream{$ups}[1]);
	open(my $statusfh, "-|", "osc api /source/devel:languages:perl/$pkg");
	my $pxml = XMLin($statusfh);
	close($statusfh);
	if ($pxml->{entry}->{$ntar}) {
	    #print "ALREADY THERE: $pkg\n";
	    system("osc rdelete -mfresh -f devel:languages:perl:autoupdate $pkg") if $autoupdate{$pkg};
	    next;
	}
	my $tempdir = tempdir;    # ( CLEANUP => 1 );
        chdir($tempdir);

        if (!$autoupdate{$pkg} && system("osc branch devel:languages:perl $pkg devel:languages:perl:autoupdate") != 0) {
	  print "branch of $pkg failed\n";
          next;
        }
        my $retries = 0;
        # we need to keep trying because the service needs to finish first
        while (system("osc co devel:languages:perl:autoupdate $pkg")) {
          print "checkout failed: $retries\n";
          last if ($retries++ == 3);
          sleep(3);
        }
        next if ($retries > 2);
        $tocreate--;
        print "branched\n";
        chdir("devel:languages:perl:autoupdate/$pkg") || die "can't chdir";
        for my $tar (glob("*.tar*")) {
            unlink($tar);
        }
        system("wget -q $mirror/authors/id/$upstream{$ups}[1]");
        copy("$scriptdir/cpanspec.yml", "cpanspec.yml") unless -f "cpanspec.yml";
        system("$scriptdir/cpanspec -f --old-file .osc/*.tar* *.tar*") == 0
          or next;
        system("osc addremove") == 0
          or next;
        print "update\n";
        system("osc ci -mupdate") == 0
          or next;
        $tobuild{$pkg} = 1;
        print "SHELL $tempdir\n";
        chdir("/tmp");
    }
    else {
        sleep(5);
    }
    #exit(1);
    #exit(1) if ($requests++ > 5);
}