#!/usr/bin/perl -T -w

use strict;
use CGI qw(:standard);

my $maints = '/home/breser/public_html/ben.reser.org/mandrake/rpmmon/maints';
my $cookercd = '/home/breser/public_html/ben.reser.org/mandrake/rpmmon/cooker.cd';

# PATH so Taint won't whine.
$ENV{'PATH'} = '/usr/bin:/usr/local/bin';

sub get_maintainer {
  my ($package) = shift;
  my ($maintainer) = 'NOT_FOUND';

  open MAINT, "<$maints";
  while (<MAINT>) {
    my($fpackage,$fmaintainer) = split /\s+/, $_;
    if ($fpackage eq $package) {
      $maintainer = $fmaintainer;
      last;
    } 
  }
  close MAINT; 
  return $maintainer;
}

sub get_cd {
  my ($package) = shift;
  my ($cd) = 'NOT_FOUND';
  open CD, "<$cookercd";
  while (<CD>) {
    my($fcd,$fpackage) = split /\s+/, $_;
    if ($fpackage =~ /^$package-[^\-]*?-[^\-]*?mdk\.(i586|noarch|ppc|alpha|ia64)$/) {
      $cd = $fcd; 
      last;
    }
  }
  close CD;
  # Second pass looks for less specific matches only if the first pass failed.
  # Second pass should let us catch things like kernel without the version...
  # However we'er assuming the version doesn't start with a letter here to help
  # avoid matching entirely the wrong thing...
  unless ($cd eq 'NOT_FOUND' or $cd eq '') {
    return $cd;
  }
  open CD, "<$cookercd";
  while (<CD>) {
    my($fcd,$fpackage) = split /\s+/, $_;
    if ($fpackage =~ /^$package-[^A-Za-z-][^\-]*?-.*?mdk\.(i586|noarch|ppc|alpha|ia64)$/) {
      $cd = $fcd;
      last;
    }
  }
  close CD;
  return $cd;
}

my $cgi = new CGI;
print $cgi->header;
print $cgi->start_html(-title=>'Mandrake Maintainer Query');

if (defined($cgi->param('package'))) {
  my ($package) = $cgi->param('package') =~ /([\w\.\+\d-]+)/;
  my $maint_email = get_maintainer($package);
  print $cgi->br;
  unless ($maint_email eq '' || $maint_email eq 'NOT_FOUND') {
    print "The maintainers email address is probably: ",$cgi->a({-href=>"mailto:$maint_email"}, "$maint_email");
  } elsif (-z $maints) {
   print qq(Couldn't find a maintainer because the maints file is empty.  This probably means the <A HREF="http://qa.mandrakesoft.com/maints.cgi">maints.cgi</A> script at Mandrakesoft is broken.  Please report the breakage on the cooker list!) ;
 } else {
    print "Couldn't find a maintainer for package $package.  This probably means you entered a package that isn't current anymore or made a typo.";
  }
  print $cgi->p;
  if ($cgi->param('findcd')) {
    my $cdname = get_cd($package);
    unless ($cdname eq '' || $cdname eq 'NOT_FOUND') {
      print "$package should be on the CD named $cdname.";
    } else {
      print "Couldn't determine what CD $package was on.";
    }
    print $cgi->p;
  }
}

print $cgi->start_form;
print "Enter the package name to get the maintainer: ";
print $cgi->textfield('package'),$cgi->br,$cgi->checkbox(-name=>'findcd', -checked=>0,-value=>'1',-label=>'Find CD package is on'),$cgi->br,$cgi->submit,$cgi->p;
print $cgi->end_form;
print 'Source for this script is ',$cgi->a({-href=>'rpmmon.cgi.perl'},'available'),'.';
print $cgi->end_html;