package SO;
use strict;
use System;
#
# installs the .so in lib/auto/* by symlinking to the 
# right version of the .so.
# Will read all .so* in the /auto/ directory.
# Will use the version that are specific to the os/perl when available.
# otherwise, will try all version available.
# Expect the .so to look like this
# Will link to the highest .so that works , sorted by os.
#
# FCGI.so.sol6          # more generic version
# FCGI.so.sol8          # more generic version
# FCGI.so.sol10.perl58  # specific version
# FCGI.so.sol8.perl58   # specific version
#

use vars qw(%H $ERR);

# RETURN ($errors, $log, $report);

sub install {
  my($class, $perl, $arg) = @_;

  my $help = $arg->{help};
  my $HOME = "/opt/SUNWstade";
  my $PERL = $perl || "/opt/SUNWstade/bin/perl";

  my $BIN  = "$PERL -I/opt/SUNWstade/lib";

  # NAME, LOCATION, REVERSE-LOGIC, TRY_ONLY_THIS_ONE
  my $LIST =  [
          ['Zlib'     , 'Compress/Zlib/Zlib'          ],
          ['XML'      , 'XML/LibXML/LibXML'   ,    1  ],
          ['GD'       , 'GD/GD'                       ],
          ['SSLeay'   , 'Crypt/SSLeay/SSLeay' ,    1  ],
          ['MD5'      , 'Crypt/MD5/MD5',           1  ],
          ['GDBM_File', 'GDBM_File/GDBM_File'         ],
          ['Storable' , 'Storable/Storable'           ],
          ['FCGI'     , 'FCGI/FCGI',               1  ],
          ['Base64'   , 'MIME/Base64/Base64'          ],
          ['IO'       , 'IO/IO'                       ],
        ];


  &load();
  my (%GOOD, %RC, %VERSIONS, $errors, $save, @bad_modules);
  open(OLDERR, ">&STDERR");
  open(STDERR, '>/dev/null');
  my $hostinfo = System->hostinfo();

  foreach my $l (@$LIST ) {
     my $file = $l->[0];
     my $so = "$HOME/lib/auto/$l->[1].so";
     my $ix = rindex($so, "/");
     my $look_for_ok = $l->[2];


     my ($good);
     my $pv         = $];
     $pv            =~ /5\.(\d\d\d)/;
     my $perlv      = $1;
     $perlv         =~ s/^0+//;
     my $solv       =  System->os_version_dot();

     my $version0   = "sol$solv.perl5$perlv";
     my $so_version = "$so.$version0";
     my $os_version = "$so.sol$solv";
     if (-f $so_version) {  # a specific
           my $ver = $version0;
           $VERSIONS{$ver} = 1;
           my $LINES = $class->try($so, $ver, $BIN, $file);
           $save .= "FILE: $file: $ver \n";
           $save .= join("", @$LINES);

	   if ($look_for_ok) {
	        if($ERR){
	           $RC{$file}{$ver} = 1;
	        }else{
	        
                   $RC{$file}{$ver} = "@$LINES" =~ /_OK_/ ? 0:1;
                   $good = $ver if ("@$LINES" =~ /_OK_/);
		}
	     
             } else {
                $RC{$file}{$ver} = $#$LINES + 1;
                $good = $ver if ($#$LINES < 0);
             }
     }elsif(-f $os_version){


           my $ver = "sol$solv";
           $VERSIONS{$ver} = 1;
           my $LINES = $class->try($so, $ver, $BIN, $file);
           $save .= "FILE: $file: $ver \n";
           $save .= join("", @$LINES);
	   if ($look_for_ok) {
	        if($ERR){
	           $RC{$file}{$ver} = 1;
	        }else{
	        
                   $RC{$file}{$ver} = "@$LINES" =~ /_OK_/ ? 0:1;
                   $good = $ver if ("@$LINES" =~ /_OK_/);
		}
	     
             } else {
                $RC{$file}{$ver} = $#$LINES + 1;
                $good = $ver if ($#$LINES < 0);
             }
     } 

     if ($good && !$help) {
        unlink $so;
        symlink "$so.$good", $so;

     } else { 
        # LOOK AT ALL .SO, USE THE FIRST ONE FOUND.
        my $dir = substr($so,0,$ix);
        opendir(D, $dir);
        my @sos = readdir(D); closedir(D);
        my @sos2;
        foreach my $so0 (@sos) {
          next if ($so0 !~ /\.so\./);
          push(@sos2, $so0);
        }
        foreach my $so0 (sort my_sort  @sos2) {
          if ("$dir/$so0" =~ /$so\.(.+)/) {
             my $ver = $1;
             next if ($ver eq "x86" && $hostinfo =~ / sparc /);
             $VERSIONS{$ver} = 1;
             print "so=$so, ver=$ver, file=$file\n" if ($help eq "-H");
             my $LINES = $class->try($so, $ver, $BIN, $file);
             $save .= "\nFILE: $file: $ver \n";
             $save .= join("", @$LINES);
             if ($look_for_ok) {
	        if($ERR){
	           $RC{$file}{$ver} = 1;
	        }else{
	        
                   $RC{$file}{$ver} = "@$LINES" =~ /_OK_/ ? 0:1;
                   $good = $ver if ("@$LINES" =~ /_OK_/ && !$good);
		}
	     
             } else {
                $RC{$file}{$ver} = $#$LINES + 1;
                $good = $ver if ($#$LINES < 0 && !$good);
             }
             last if ($good && $help ne "-H");
           }
        }
        if (!$good) {
          $errors .= "Error: Cannot find a good library for Perl module '$file' \n";
          push(@bad_modules, $file);
        }
     }
  }
   
  open(O, ">/tmp/ras_bad_modules.info");
  print O join(" ", @bad_modules);
  close(O);
  open(STDERR, ">&OLDERR");

#VERSION    sol6      sol7      sol9sol9.perl5    perl58
#=================================================================
#    Base64         0                   0
#  Shark            0                   0
#      FCGI         1                   0                   0
#        GD         3         1         0
  
  my $line = "========== ";
  foreach my $ver (sort keys %VERSIONS) {
    $line.= "======== ";
  }
  $line.= " =======\n";

  my $report = $line . "SOLARIS  : ";
  foreach my $ver (sort keys %VERSIONS) {
    my @v = split(/\./, $ver);
    $v[1] = "$v[1]." if ($#v > 0);
    $report .= sprintf("%-9.9s", $v[0]);
  }
  $report .= "\nPERL     : ";
  foreach my $ver (sort keys %VERSIONS) {
    my @v = split(/\./, $ver);
    $report .= sprintf("%-9.9s", $v[1]);
  }
  $report .= " Results\n";
  $report .= $line;
  
  foreach my $file (sort keys %RC) {
    my $F = $RC{$file};
    $report .= sprintf("%-11.11s", $file);
    my $tot = "(NOTHING WORKS)";
    foreach my $ver (sort keys %VERSIONS) {
       $tot = "OK" if (exists $RC{$file}{$ver} && !$RC{$file}{$ver});
       $report .= sprintf("%-9.9s", $RC{$file}{$ver});
    }
    $report .= " $tot\n";
  }
  $report .= $line;
  $report .= "\n";

  unlink "/tmp/test_GDBM";
  unlink "/tmp/try_lib";
  unlink "/tmp/try_lib.log";
  &try_done();

  return ($errors, $save, $report, \@bad_modules);
}


sub my_sort {
  $a =~ /sol(\d+)/;
  my $l1 = $1 || $a;

  $b =~ /sol(\d+)/;
  my $l2 = $1 || $b;
  return $l1 <=> $l2;
}


sub try_done {
  my $F  = "/opt/SUNWstade/lib/IO.pm";
  my $F2 = "/opt/SUNWstade/lib/Data/Dumper.pm";
  if ( -f "$F.save") {
    rename "$F.save", $F;
    my $D = "/opt/SUNWstade/lib/IO";
    rename "$D.save", $D;
  }
  if ( -f "$F2.save") {
    rename "$F2.save", $F2;
  }
}


#########################################
# TRY THIS VERSION
#

sub try {
  my($class, $so, $ver, $BIN, $file) = @_;

  my $F = "/opt/SUNWstade/lib/IO.pm";
  my $F2 = "/opt/SUNWstade/lib/Data/Dumper.pm";

  if ($] >= "5.006" && -f $F) {
    rename $F, "$F.save";
    rename $F2, "$F2.save";
    my $D = "/opt/SUNWstade/lib/IO";
    rename $D, "$D.save";

  } elsif ($] < "5.006" && -f "$F.save") {
    rename "$F.save", $F;
    rename "$F2.save", $F2;
    my $D = "/opt/SUNWstade/lib/IO";
    rename "$D.save", $D;
  }

  unlink $so;
  symlink "$so.$ver", $so;
  open(O, ">/tmp/try_lib");
  print O "#!$BIN\n";
  print O $H{$file};
  close(O);
  chmod 0777, "/tmp/try_lib";
  my $LOG ="/tmp/try_lib.log";
  $ERR = system("/tmp/try_lib >$LOG 2>&1");
  open(O, $LOG);
  my @LINES = <O>; close(O);
  return \@LINES;
}

sub load {

$H{Shark} =<<'EOF';
  require Crypt::Shark;
  
  $cipher = new Crypt::Shark("1234567812345678");

  $email  = "qwertyui";
  my $enc = unpack("H*", $cipher->encrypt($email));
  $enc    = pack("H*", $enc);
  my $new = $cipher->decrypt($enc);

  if ($new eq $email) {
    print "_OK_\n";
  }

EOF

$H{MD5} =<<'EOF';
  use Crypt::MD5;
  $md5    = Crypt::MD5->new();
  $md5->add("Signature: storade\nSubject: Test email\nThis is a test email.\nThis is a test email.");

  $hash  = unpack("H*", $md5->digest());
  print "_OK_\n";
EOF

$H{SSLeay} =<<'EOF';
  use Crypt::SSLeay;
  use LWP::UserAgent;
  my $ua = new LWP::UserAgent;
  my $req = new HTTP::Request('GET', 'https://localhost:7443/GET=INFO1');
  $ua->timeout(10);
  my $res = $ua->request($req);
  print "_OK_\n";
  
EOF

$H{Dumper} =<<'EOF';
  require Data::Dumper;
  $a = Data::Dumper::Dumper( { x => '2'} );
EOF

$H{FCGI} =<<'EOF';
  require FCGI;
  print "_OK_\n";

EOF


$H{GD} =<<'EOF';
  require GD;
EOF

$H{GDBM_File} =<<'EOF';
  use GDBM_File;
  my $F = "/tmp/test_GDBM";
  unlink $F;
  tie %hash, 'GDBM_File', $F,  &GDBM_WRCREAT, 0640;
  $hash{this} = "that";
  if (!-f $F) {
     print "ERROR: This library does nothing!\n";
  }
EOF

$H{IO} =<<'EOF';
  require IO;
  require IO::Handle;
  $fh = new IO::Handle;
EOF

$H{Base64} =<<'EOF';
  require MIME::Base64;
  my $encoded = MIME::Base64::encode("TEST");
EOF

$H{Storable} =<<'EOF';
  require Storable;

  $str = Storable::freeze({x => "thistest"});
  my $str2 = Storable::thaw($str);

  if ($str2->{x} ne "thistest") {
    print "ERROR: freeze/thaw doe not work!\n";
  }

  my $F = "/opt/SUNWstade/DATA/TIMELAPSE.db";
  if (-f $F) {
      my %ST2;
      require RasDB;
      my $db =  tie %ST2,  'MLDBM::Sync', $F, GDBM_READER, 0664;
      foreach my $el (keys %ST2) { 
        my $value = $ST2{$el};
        last;
      }
  }
EOF

$H{XML} =<<'EOF';
  use XML::LibXML;
  my $parser = XML::LibXML->new();

  my $dom = $parser->parse_string('<?xml version="1.0" encoding="UTF-8"?>
<dromedaries>
    <species name="Camel">
      <humps>1 or 2</humps>
      <disposition>Cranky</disposition>
    </species>
</dromedaries>');

  my $elem   = $dom->getDocumentElement();
  if (!$elem){
     print "XML Library failed\n";
  }else{
     foreach my $tnode ( $elem->childNodes()) {
       next if ($tnode->getType() != XML_ELEMENT_NODE) ;
       my $out = $tnode->getType() . $tnode->textContent();
     }
     print "_OK_\n";
  }


EOF

$H{Zlib} =<<'EOF';
  if ($] >= 5.006) {
    require Compress::Zlib;
    $dest = Compress::Zlib::memGzip("REST");
  }
EOF

  
}

1;
