#!/usr/bin/perl -T
# para repositorios con paquetes que tienen librerias 
# si hay subpaquetes no binarios  no poner en el mismo directorio, fuera de jerarquia procesador

############ AJUSTAR AL DIRECTORIO DEL SERVIDOR
my $base="/home/dsa/ututo/";  # --------------------------->  terminar en /
my $database="/var/ututopkg/libpro.txt";

############ NADA MAS QUE TOCAR
#estupido
my $barra=0;
my $based=$base;
$based=~s/(\/)$//;
$barra=$1;


########### Ajustar al lugar dado por  la script dep.pl
my $archivoabierto=1;
if (not -s $database){$archivoabierto=0;}else{
  open(SONAMEDB,"<$database") or $archivoabierto=0;
}



use Data::Dumper;
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use strict;
use warnings;

my $cgi = new CGI;
print $cgi->header(-type=>"text/html");
print $cgi->start_html(-title=>'Consula al repositorio Ututo',
                                   -author=>'dsa@unsa.edu.ar',
                                  # -base=>'true',
                                  # -target=>'_blank',
                                   -meta=>{'keywords'=>'ututo web services repositorio packages',
                                           'copyright'=>'copyright 2005 Ututo'},
                                  # -style=>{'src'=>'/styles/style1.css'},
                                   -BGCOLOR=>'white');

print $cgi->startform();

my $soname=$cgi->param("soname");
my $maxpro=$cgi->param("maxpro");


my %resultado;

#my ($soname,$maxpro)=@ARGV;
     # indice para la busqueda
     # solo busca procesadores de ese tipo o inferiores

if (not $soname){ $soname="libasound.so.2";} #ejemplo
if (not $maxpro) {$maxpro="pentium2"; }      #ejemplo

my $prioriza;   # puede ser p:procesador, v:version, n:dar todo,


my $urlbase="http://www.ututo.org/"; #terminar en /
my $extension; #el orden que quieras

if (not $prioriza) {$prioriza='n'}
if (not $maxpro) {$maxpro='*'}
if ($maxpro eq '*' or $maxpro eq '+') {$prioriza='n'}
if (not $extension) {$extension=qw/tbz2 deb rpm/}



my @proce=qw/i486 i686 pentium3 pentium4 duron-athlon athlon-xp athlon-mp k8 xeon64/;
my %sigue=("i386"=>0,
        'i486'=>'i386',                       #0
        'i586'=>'i486',  #pentium             #0
        'i686'=>'i586',   #pentiumpro         #1 
        'pentium2'=>'i686',                   #1
        'celeron'=>'i686',                    #1 
        'pentium3'=>'pentium2',               #2 
        'pentium4'=>'pentium3',               #3
        'xeon'=>'pentium4',                   #8 emt64
        'xeon64'=>'xeon',                     #8 xeon MP 64 emt64    
        "duron-athlon"=>'i686',  #es el duron #4                     
        'k8'=>'duron-athlon',  #semprom              #7
        'athlon'=>'i686',                     #4
        "athlon-xp"=>'i686',                  #5   
        "athlon-mp"=>"athlon-xp",             #6
        'turion'=>"athlon-xp",                #5
        'opteron'=>'k8'                       #7
       );
#sigue deben ser los codigos que detecta el programa

#usar modulos de redes para comprobar
my %hay;


foreach (@proce) {
    $hay{$_}=1;
}



my @listproc=redu($maxpro);



sub maxversion{
my ($uno,$dos)=@_;
    my @compa=split(/\./,$uno);
    my @compb=split(/\./,$dos);

    my $ca=scalar @compa;
    my $cb=scalar @compb;
    my $max=$ca;
    if ($cb>$ca){$max=$cb}
    #print "MAXV  $max   @compa  @compb  $uno $dos\n<p>";
    foreach (0..$max-1){
        #print "$compa[$_] - $compb[$_] \n";
	if ($compa[$_] gt $compb[$_])  {return -1;}
        elsif($compa[$_] lt $compb[$_]) {return 1;}
    } 
   return 0;
};


sub redu{
    my($maxpro)=@_;
    my @lista;
    if ($maxpro eq '*' or $maxpro eq '+'){
        @lista=@proce;
    }else{
    @lista=($maxpro) if ($hay{$maxpro});
    while($maxpro=$sigue{$maxpro}){
        #print "MP:$maxpro\n";
        if ($hay{$maxpro}){
	    @lista=(@lista,$maxpro);
    }}
    }
    return @lista;
}

# tambien establece @versiones
my %versiones=();
my %paquetes=();
sub npaquete{
    my ($nombre,$ref)=@_;
    # esto es complejo, no se sigue una politica facil de separar

    my @nombres=split(/-/,$nombre);
    my $version=$nombres[-1];
    my $paquete=$nombres[0];
    my $cant=scalar    @nombres;
    my $esv;
    foreach (@nombres[1..$cant-2]){
      $esv=0;
      if (/^[0-9]/) {$esv=1;}
      if (/\./) {$esv=1}
      #print "KK $_ $esv\n";
      if ($esv) {$version=$_.'-'.$version} else {$paquete.='-'.$_}    
       }
    
    if (not $version){$version="sinversion"}
    no strict 'refs' ;
    my %verpaq=(%{$versiones{$paquete}},$version,1);
    use strict 'refs' ;
   
  

    $versiones{$paquete}=\%verpaq;
  

    $paquetes{$paquete}=1;
    #print "$paquete, $version,", Dumper \%versiones, Dumper \%paquetes;

    #my @nombres=split(/-/,$nombre);
    #my $version=$nombres[-1];
    #my $paquete=$nombre;
    #$paquete=~s/-$version$//;

    if ($maxpro eq '+'){
        $resultado{"i686=".$paquete."=".$version."=tbz2"}=
                       [@$ref,$paquete,$version,"tbz2",
                       ,"i686",$urlbase."i686".'/'.$nombre.'.tbz2',$base."i686".'/'.$nombre.'.tbz2'];
        return;
     }
    #@resul=();
    foreach my $pro (@listproc){
        #print "pro $pro<p>\n";
	my @lista=glob($base.$pro."/".$nombre.".*");
          #print "PRO $nombre -  $pro > @lista<p>\n";
	  foreach my $arch (@lista){
   	       my @puntos=split(/\./,$arch);
               $extension=$puntos[-1];
               #@resul=(@resul,
               $resultado{$pro."=".$paquete."=".$version."=".$extension}=
                       [@$ref,$paquete,$version,$extension,
                       ,$pro,$urlbase.$pro.'/'.$nombre.'.'.$extension,$arch];
	      }
        
      }

#    return \@resul;
}




if ($archivoabierto){
my @res=();
while(<SONAMEDB>){
    chomp;
    my @pres=split(/:/,$_);
    #print "P $pres[0] $pres[3] $soname <p>\n";
    if ($pres[0] eq $soname and $pres[3] eq 'soname'){
            my @jj=@pres[0..2];
            #my $ref=
            #print "X $pres[0]<p>\n";
            npaquete($pres[1],\@jj);
	    #@res=(@res,@$ref);
	}
}
close(SONAMEDB);}


if ($prioriza eq 'p'){}


my %ov=();

#print Dumper \%versiones;

foreach my $pp (keys %paquetes){
      my @ordvers= sort {maxversion($a,$b)} (keys %{$versiones{$pp}});
      $ov{$pp}=\@ordvers; 
}
#print Dumper \%ov;


my @fff=keys %resultado;
my @ppr= keys %paquetes;


print "<h1>Buscador de paquetes</h1>";

print "Por ahora de sonames requerido, futuro servicio web de dependecias del repositorio ututo.<p>";
# terminar para que tambien busque en un repostiorio local.

print "<ul><li>+ es independiente del procesador <p><li>* lista todos los procesadores<p></ul>";
# usa 686 para independencia, pero no haria falta, que solo consulte la base

print "En el futuro listar includes,  ejecutables y otro tipo de archivos<p>";
print "Por razones historicas duron-athlon es el procesador duron<p>";

my @hu=sort map {if($_ ne '0'){$_}} keys %sigue;


print "Soname que busco: ",$cgi->textfield(-name=>'soname',-default=>'libasound.so.2'),"<p>";
print "Procesador: ",$cgi->popup_menu(-name=>'maxpro',-values=>[@hu[1..scalar @hu-1],'*','+'], -default=>'pentium2'),"<p>";
print $cgi->submit;
print "<p><hr>";


if ($maxpro eq '*'){
   #print Dumper \%resultado;
    foreach my $r (@fff){
      my $re=$resultado{$r};     
      print "Procesador: $re->[6]<p>\nPaquete (bajar): <a href=\"$re->[7]\">$re->[3]</a><p>\n
             Version: $re->[4]<p>\nTipo: $re->[5]<p>\nArchivoContiene: $re->[2]\n<p>" ;
      print "<hr>";  
      }
}elsif ($maxpro eq '+'){
   #print Dumper \%resultado;
   # my @kkk= keys %resultado;
   #print "@kkk \n";
    foreach my $pp (keys %paquetes){
     my $pido='i686='.$pp."=".$ov{$pp}->[0]."=tbz2"; 
     # my $re=$resultado{$pido};     
#     my $yaesta
    print "Paquete que lo contiene: $pp<p>\nArchivo:$pp-$ov{$pp}->[0].tbz2<p>\n<hr>";# if ($re->[6] eq "i686");
}
}else{
my $si=1;
my $num=0;
foreach my $lp (@listproc){
 if ($si){
  $si=0;
  foreach my $pp (@ppr){
    my $pido=$lp.'='.$pp."=".$ov{$pp}->[0]."=tbz2";
    my $re=$resultado{$pido};
    if ($re and -s $re->[8]){
      $num++;
      print "\nTipoProcesador=$num=$re->[6]\n<p>\nNombrePaquete=$num=$re->[3]\n<p>\n<a href=\"$re->[7]\">Bajar $num</a>\n<p>\nVersionPaquete=$num=$re->[4]\n<p>\nTipoPaquete=$num=$re->[5]\n<p>\nEnlaceURL=$num=$re->[7]\n<p>\nArchivoContiene=$num=$re->[2]\n<p>";
     

     }else{
       $si=1;
       print "\nError:$pido: no hay resultado $re, o no existe archivo $re->[8]<p>\n"}
  }
 }
}

}
# @$resultado{$pido} - 

# esto es complicado, por ahora toma la ultima version en el mejor procesador en tbz2, primer paqute que aparece
#foreach (@fff){
#    my($pr,$pa,$ve,$ex)=split (/=/,$_);#
#
#}
#'1.0.9_rc2-r1', '1.0.9_rc3', '1.0.9'
#print maxversion("1.0.9","1.0.9_rc3"), "\n";;
#print redu($maxpro), "\n";

#
print "<h2>Mensajes de advertencia o error</h2>\n";
print "No pude abrir archivo: $database <p>\n" if not $archivoabierto;
if ($barra ne '/') {print "Falta barra final (/) en $base<p>\n"}
if (not -d $based) {print "No hay directorio base: $based<p>\n"}
foreach (@proce){
    my $sale='';
      if (not -d $base.$_) {print "No hay directorio de paquetes para el procesador $_: $base$_<p>\n"
                         }else{
                           $sale="Directorio del procesador $_ OK: $base$_<p>\n"
                         }
  my @mispaq=glob($base.$_.'/ututo*.tbz2');
  if (not scalar @mispaq ) {print "$sale*     No encontre ningun paquete ututo*.tbz2 en $base$_<p>\n";}
}
print $cgi->endform;
print $cgi->end_html;