#! /usr/bin/perl

use strict;
use vars qw(%PKG);

if (@ARGV != 3) {
  my $cmd = $0;
  $cmd =~ s,^.*/(.*)$,$1,;
  die "usage: $cmd srcdir newdir olddir\n";
}

my $srcdir = shift;
my $newdir = shift;
my $olddir = shift;

stage1($srcdir);
stage2($srcdir, $newdir, $olddir);

sub stage1 {
    my $dir = shift;
    
    opendir DH, $dir or die "$dir: $!\n";
    my $file;
    while (defined($file = readdir DH)) {
	next if $file !~ /\.deb$/;
	$file =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack('C',hex($1))/ge;
	my ($pkg, $vstr, $arch) = split /_/, $file;
	my $v = parse_version($vstr);
	if (defined($PKG{$pkg})) {
	    if (compare_version($PKG{$pkg}, $v) < 0) {
		$PKG{$pkg} = $v;
	    }
	} else {
	    $PKG{$pkg} = $v;
	}
    }
    closedir DH;
}

sub stage2 {
    my ($srcdir, $newdir, $olddir) = @_;
    
    opendir DH, $srcdir or die "$srcdir: $!\n";
    my $file;
    while (defined($file = readdir DH)) {
	next if $file !~ /\.deb$/;
	my ($pkg, $vstr, $arch) = split /_/, $file;
	my $v = parse_version($vstr);
	if (is_same_version($PKG{$pkg}, $v)) {
	    rename "$srcdir/$file", "$newdir/$file";
	} else {
	    rename "$srcdir/$file", "$olddir/$file";
	}
    }
    closedir DH;
}

sub is_same_version {
    my ($v1, $v2) = @_;
    
    return (compare_version($v1, $v2) == 0);
}

sub parse_version {
    my $str = shift;
    my ($epoch, $ver, $rev);
    if ($str =~ /^([^:]*):(.*)$/) {
	my ($s1, $s2) = ($1, $2);
	die "epoch in version is not number\n" if ($s1 !~ /^\d+$/);
	die "nothing after colon in version number\n" if ($s2 eq '');
	$epoch = $s1;
	$str = $s2;
    } else {
	$epoch = 0;
    }
    $ver = $str;
    if ($ver =~ /^(.*)-([^-]*)$/) {
	$ver = $1;
	$rev = $2;
    } else {
	$rev = '';
    }
    return {epoch=>$epoch, version=>$ver, revision=>$rev};
}

sub compare_version_sub {
    my ($v1, $v2) = @_;

    while (1) {
	my $vc1 = '';
	if ($v1 =~ /^([^0-9]+)(.*)$/) {
	    $vc1 = $1;
	    $v1 = $2;
	}
	my $vc2 = '';
	if ($v2 =~ /^([^0-9]+)(.*)$/) {
	    $vc2 = $1;
	    $v2 = $2;
	}
	if ($vc1 ne $vc2) {
	    return ($vc1 lt $vc2) ? - 1 : 1;
	}
	$v1 =~ /^(\d+)(.*)$/;
	my $vn1 = $1;
	$v1 = $2;
	
	$v2 =~ /^(\d+)(.*)$/;
	my $vn2 = $1;
	$v2 = $2;
	
	return $vn1 - $vn2 if $vn1 != $vn2;
	return 0 if ($v1 eq '' && $v2 eq '');
	return -1 if $v1 eq '';
	return 1 if $v2 eq '';
    }
}

sub compare_version {
    my ($v1, $v2) = @_;
    return 1 if $v1->{epoch} > $v2->{epoch};
    return -1 if $v1->{epoch} < $v2->{epoch};
    my $r = compare_version_sub($v1->{version}, $v2->{version});
    return $r if $r;
    return compare_version_sub($v1->{revision}, $v2->{revision});
}

# end of script