#!/usr/local/perl8-64/bin/perl

$host = "calgary.ks.uiuc.edu";
$db = download;
$type = mysql;
$interface = DBI;
$debug = 0;

use DBI;

$dbh = DBI->connect("$interface:$type:database=$db;host=$host", download, 'TBSoft1@', {RaiseError => 1});

use CGI qw(:standard);
use CGI::SHTML;
$cgi = new CGI::SHTML;

$cookiename = 'TBSoftAccessID';

if ( param('UserName') ) {
  my $username = param('UserName');
  $username =~ s/ +$//;
  $username =~ s/^ +//;
  $username =~ s/  +/ /;
  param(-name=>'UserName',-value=>$username);
}

if ( param('SaveCookie') && param('UserID') && param('AccessCode') ) {
  my $cookieval = param('UserID') . ':' . param('AccessCode');
  my $cookie = cookie(-name=>$cookiename, -path=>url(-absolute=>1),
	-expires=>'+6M', -value=>$cookieval);
  print header(-cookie=>$cookie);
} else {
  print header;
}

if ( cookie($cookiename) && ! param('IgnoreCookie') ) {
  $cookiestr = cookie($cookiename);
  my $userid; my $accesscode;
  ($userid, $accesscode) = split(':',$cookiestr,2);
  if (! param('UserID')) { param(-name=>'UserID',-value=>$userid); }
  if (! param('AccessCode')) { param(-name=>'AccessCode',-value=>$accesscode); }
}

  print_params();

#
# No access so far, enter username/password or registration info.
#
if ( param('LoginForm') && ! param('UserName') ) {
  print_ssi_header('Registration/Login');
  print h2("Sorry, empty username is not allowed.");
  print_login_form();

} elsif ( param('ArchiveID') && ! param('UserName') && ! param('AccessCode') ) {
  print_ssi_header('Registration/Login');
  print_login_form();

} elsif ( param('UserName') && param('SendEmail') ) {
  print_ssi_header('Sending Email');
  my $username = $dbh->quote(param('UserName'));
  my $data = $dbh->prepare("select UserID,AccessCode,EmailAddress from User where UserName = $username");
  $data->execute;
  if ( my @acdata = $data->fetchrow_array() ) {
    param(-name=>'Password',-value=>'');
    my $userid = $acdata[0];
    my $accesscode = $acdata[1];
    my $realemail = $acdata[2];
    my $email = obfuscate_email($realemail);
    my $pwurl = url() . "?UserID=$userid&AccessCode=$accesscode&ChangeInfo=Email";
    if ( open(MAIL, "|/usr/lib/sendmail $realemail") ) {
      print MAIL "To: $realemail
From: TCBG Software Downloads <namd\@ks.uiuc.edu>
Subject: Forgotten Password

This email has been sent automatically by the webserver of the
Theoretical Biophysics Group at the University of Illinois in
response to a request by you or someone trying to use your username,
$username, to download TCBG software.  If you did not request this
email, we apologize.  If you did request this email because you have
forgotten your password, you may use the URL below to change it.

$pwurl

Sincerely,

Theoretical Biophysics Group Developers
namd\@ks.uiuc.edu, vmd\@ks.uiuc.edu
";
      print h1("Email has been sent to $email."),p;
    } else {
      print h1("Sorry, unable to email $email."),p;
    }
  } else {
    print h1("Sorry, the username $username was not found."),p;
  }

} elsif ( param('UserName') && ! param('Password') && ! param('cryptPassword') ) {
  print_ssi_header('Registration/Login');
  print h2("Sorry, empty passwords are not allowed.");
  print_login_form();

} elsif ( param('UserName') ) {
  my $username = $dbh->quote(param('UserName'));
  $cryptpassword = pwcrypt(param('Password'));
  my $password = $dbh->quote($cryptpassword);

  my $data = $dbh->prepare("select UserID,AccessCode from User where UserName = $username and Password = $password");
  $data->execute;

  my $data2 = $dbh->prepare("select UserID,FullName,EmailAddress from User where UserName = $username");
  $data2->execute;

  if ( my @acdata = $data->fetchrow_array() ) {
    print_ssi_header('Software Downloads');
    print h1('Access approved.  Welcome back!');
    param(-name=>'UserID',-value=>$acdata[0]);
    param(-name=>'AccessCode',-value=>$acdata[1]);
    my $curdate = today();
    my $userid = $acdata[0];
    $dbh->do("update User set LastLoginDate=\'$curdate\',LastAccessDate=\'$curdate\' where UserID=$userid");
    print_cookie_form();
    if ( param('ArchiveID') ) {
      print_download_info();
    } else {
      print_download_menu();
    }
  } elsif ( my @acdata2 = $data2->fetchrow_array() ) {
    print_ssi_header('Password Incorrect');
    print h1('Password incorrect or username already taken.');
    param(-name=>'Password',-value=>'');
    print_login_form();
    print h2('Have you forgotten your password?');
    my $fullname = $acdata2[1];
    my $email = obfuscate_email($acdata2[2]);
    my $username = param('UserName');
    print "This username is registered to $email. You may click below to send an email to $email with directions for changing the password for \'$username\'. ";
    print 'If you have forgotten your username or the email address is wrong, <a href="mailto:vmd@ks.uiuc.edu,namd@ks.uiuc.edu?subject=Forgotten%20TCBG%20Download%20Password">email us</a> or re-register with a different username.', p;
    print start_form;
    print hidden(-name=>'UserName');
    print submit(-name=>'SendEmail',-value=>"Send access info to $email");
    print end_form;
    print p;
  } elsif ( param('cryptPassword') ) {
    if ( my $err = check_registration_data() ) {
      print_ssi_header('New User Registration');
      print h2("Please fill out the form completely.");
      print h3("$err");
      print h2("New User Registration for $username:");
      print_registration_form();
    } else {
      my $curdate = today();
      param(-name=>'CreationDate',-value=>$curdate);
      param(-name=>'LastChangeDate',-value=>$curdate);
      param(-name=>'LastLoginDate',-value=>$curdate);
      param(-name=>'LastAccessDate',-value=>$curdate);
      param(-name=>'Password',-value=>$cryptpassword);
      srand( time() ^ ($$ + ($$ << 15)) );
      my $accode = int(rand 1e8).int(rand 1e8).int(rand 1e8).int(rand 1e8);
      param(-name=>'AccessCode',-value=>$accode);
      param(-name=>'NIHAwardNumber',-value=>'');
      param(-name=>'NIHAwardPI',-value=>'');
      save_user_new();
      print_ssi_header('Software Downloads');
      print h1("Welcome!  Account created for $username.");
      print h3('Please remember your password for future downloads.');
      print_cookie_form();
      if ( param('ArchiveID') ) {
        print_download_info();
      } else {
        print_download_menu();
      }
    } 
  } else {
    print_ssi_header('New User Registration');
    print h2("New User Registration for $username:");
    print_registration_form();
  }
} elsif ( param('UserID') && param('AccessCode') ) {
# We've got an access code.
  my $userid = param('UserID');
  my $accesscode = $dbh->quote(param('AccessCode'));
  my $data = $dbh->prepare("select UserID from User where UserID = $userid and AccessCode = $accesscode");
  $data->execute;
  if ( my @acdata = $data->fetchrow_array() ) {
    my $curdate = today();
    my $userid = $acdata[0];
    $dbh->do("update User set LastAccessDate=\'$curdate\' where UserID=$userid");
    print_ssi_header('Software Downloads');
    if ( param('ArchiveID') ) {
      print_download_info();
    } else {
      print_download_menu();
    }
  } else {
    print_ssi_header('Access Denied');
    print h1('Access denied, please try again.');
    param(-name=>'Password',-value=>'');
    print_login_form();
  }
} else {
  print_ssi_header('Software Downloads');
  param('UserID','');
  param('AccessCode','');
  print_download_menu();
}

#
# Finish the page and get out
#
print_ssi_footer();
$dbh->disconnect;
exit;

sub check_registration_data {
  my $rfields = ['UserName','cryptPassword','FullName','EmailAddress','Affiliation','NumberOfUsers','UseFor','IsNIHFunded','Password'];
  my $efields = "";
  foreach $f ( @$rfields ) {
    if ( param($f) eq '' ) {
      $efields = $efields . ' ' . $f;
    }
  }
  if ( $efields ) { return 'Missing Data:' . $efields; }
  if ( param('cryptPassword') ne pwcrypt(param('Password')) ) {
    return 'Entered passwords do not match.';
  }
  return '';
}

sub print_login_form {
  print p, 'You will need a username and password to download software.';
  print p, strong('If this is your first download, please choose a username and password to register.'), br, 'Current NAMD or VMD users, please enter your existing username and password.', p;
  print start_form;
  print hidden(-name=>'PackageName');
  print hidden(-name=>'ArchiveID');
  print hidden(-name=>'IgnoreCookie',-value=>1);
  print hidden(-name=>'LoginForm',-value=>1);
  print p, strong('Username: '), textfield(-name=>'UserName',-size=>30);
  print p, strong('Password: '), password_field(-name=>'Password',-size=>10);
  print p, submit(-value=>'Continue with registration or download');
  print end_form;
  print p, strong('Your download will continue after you have registered or logged in.');
  print p;
}

sub print_cookie_form {
  print start_form;
  print hidden(-name=>'UserID'), hidden(-name=>'AccessCode'), hidden(-name=>'PackageName'), hidden(-name=>'ArchiveID');
  print p, strong('You may avoid logins for 6 months by saving a cookie on your browser:');
  print ' ', submit(-name=>'SaveCookie',-value=>'Save Cookie');
  print end_form;
}

sub process_nih_form {
  my $userid = param('UserID');
  my $accesscode = $dbh->quote(param('AccessCode'));
  if ( param('NIHAwardPI') ) {
    my $curdate = today();
    my $p = $dbh->quote(param('NIHAwardPI'));
    $dbh->do("update User set NIHAwardPI=$p,LastChangeDate=\'$curdate\' where UserID = $userid and AccessCode = $accesscode");
  }
  if ( param('NIHAwardNumber') ) {
    my $curdate = today();
    my $p = $dbh->quote(param('NIHAwardNumber'));
    $dbh->do("update User set NIHAwardNumber=$p,LastChangeDate=\'$curdate\' where UserID = $userid and AccessCode = $accesscode");
  }
}

sub print_nih_form {
  my $userid = param('UserID');
  my $accesscode = $dbh->quote(param('AccessCode'));
  my $data = $dbh->prepare("select IsNIHFunded,NIHAwardPI,NIHAwardNumber from User where UserID = $userid and AccessCode = $accesscode");
  $data->execute;
  my @acdata = $data->fetchrow_array();
  #if ( $acdata[0] && ! ( $acdata[1] && $acdata[2] ) ) {
  if ( $acdata[0] && ! $acdata[1] ) {
  param(-name=>'NIHAwardPI',-value=>$acdata[1]);
  if ( $acdata[2] ) { param(-name=>'NIHAwardNumber',-value=>$acdata[2]); }
  print start_form;
  print hidden(-name=>'UserID'), hidden(-name=>'AccessCode'), hidden(-name=>'PackageName'), hidden(-name=>'ArchiveID');
  print strong('TCBG software development is supported by the National Institutes of Health (NIH).  Please help us to meet the agency requirement to identify NIH-funded users and provide the name of the Principal Investigator on your grant:'), br;
  print '<table border=0 cellspacing=10 cellpadding=0> <tr> <td>First and Last Name of PI: <td>';
  print textfield(-name=>'NIHAwardPI',-size=>30);
  # print '<td> <tr> <td>NIH award number: <td>';
  # print textfield(-name=>'NIHAwardNumber',-size=>20);
  print hidden(-name=>'NIHAwardNumber');
  print '<td>', submit(-value=>'Save');
  print '</table>';
  print end_form;
  }
}

sub print_registration_form {
  # update to give them a chance to change
  if ( param('Password') ) {
    param(-name=>'cryptPassword',-values=>[$cryptpassword]);
  }
  # squash password from new forms
  param(-name=>'Password',-values=>['']);
  print start_form;
  if ( param('IgnoreCookie') ) { print hidden(-name=>'IgnoreCookie'); }
  print hidden(-name=>'UserName'), hidden(-name=>'PackageName'), hidden(-name=>'ArchiveID');
  print hidden(-name=>'cryptPassword',-default=>[$cryptpassword]);
  print strong('First and Last Name:'), br;
  print textfield(-name=>'FullName',-size=>40), p;
  print strong('Email Address:'), br;
  print textfield(-name=>'EmailAddress',-size=>40), p;
  print strong('Affiliation:'), br;
  my %affils;
  $affils{'academic'} = ' Academic';
  $affils{'government'} = ' Government';
  $affils{'industrial'} = ' Industrial';
  $other = textfield(-name=>'OtherAffil',-size=>10);
  $affils{'other'} = " Other (specify) $other";
  autoEscape(undef);
  print radio_group(-name=>'Affiliation',-values=>['academic','government','industrial','other'],-labels=>\%affils,-default=>'-',-rows=>1); 
  autoEscape('true');
  print strong('The number of people using TCBG software at my site is:'), br;
  my %people;
  $people{'1'} = ' 1';
  $people{'2'} = ' 2-4';
  $people{'5'} = ' 5-10';
  $people{'11'} = ' 11-20';
  $people{'21'} = ' 21 or more';
  print radio_group(-name=>'NumberOfUsers',-values=>['1','2','5','11','21'],-labels=>\%people,-default=>'-',-rows=>1), p;
  print strong('I use TCBG software primarily for:'), br;
  my %usefor;
  $usefor{'research'} = ' Research';
  $usefor{'teaching'} = ' Teaching';
  $usefor{'commerce'} = ' Commerce';
  $usefor{'personal'} = ' Personal';
  print radio_group(-name=>'UseFor',-values=>['research','teaching','commerce','personal'],-labels=>\%usefor,-default=>'-',-rows=>1), p;
  print strong('The work I do with TCBG software is funded (at least partially) by NIH:'), br;
  my %yesno;
  $yesno{'1'} = ' Yes';
  $yesno{'0'} = ' No';
  print radio_group(-name=>'IsNIHFunded',-values=>['1','0'],-labels=>\%yesno,-default=>'-',-rows=>1), p;
  print strong('Re-enter password for confirmation: ');
  print password_field(-name=>'Password',-size=>10), p;
  print submit(-value=>'Register');
  print end_form;
}

sub today {
  my $data3 = $dbh->prepare("select CURDATE()");
  $data3->execute;
  my @arr3 = $data3->fetchrow_array();
  return $arr3[0];
}

sub pwcrypt {
  return crypt(shift,'ks');
}

sub print_params {
  if ( $debug ) {
    foreach $f (param()) {
      print $f, '=', '"', param($f), '"', br;
    }
  }
}

sub obfuscate_email {
  my $email = shift;
  $email =~ s/.?.?.?\@/...@/;
  return $email;
}

sub isbool {
  my $field = shift;
  return ( $field =~ /Is/ );
}

sub boolhash {
  my %menuhash;
  $menuhash{'0'} = 'No';
  $menuhash{'1'} = 'Yes';
  return %menuhash;
}

sub isref {
  my $field = shift;
  return ( $field =~ /ID/ );
}

sub refhash {
  my $reffield = shift;
  my $reftable = $reffield; $reftable =~ s/ID//;
  my $reflabel = $reffield; $reflabel =~ s/ID/Name/;
  my $items = $dbh->prepare("select $reffield, $reflabel from $reftable");
  $items->execute;
  my %menuhash;
  while ( my(@row) = $items->fetchrow_array ) {
    $menuhash{$row[0]} = $row[1];
  }
  return %menuhash;
}

sub lastseq {
  my $seq = $dbh->prepare("select LAST_INSERT_ID()");
  $seq->execute;
  return $seq->fetchrow_array();
}

sub save_user_new {
  my $table = 'User';
  my $tableid = 'UserID';
  my $data = $dbh->prepare("select * from $table where $tableid = -1");
  $data->execute;
  my @fields = @{$data->{NAME}};
  my @types = @{$data->{TYPE}};
  my $edits = "NULL";
  for ( my $i = 1; $i <= $#fields; $i++ ) {
    my $quoted = $dbh->quote(param($fields[$i]),$types[$i]);
    $edits = $edits . ", $quoted";
  }
  if ( $debug ) { print $edits, "\n"; }
  $dbh->do("insert into $table values ( $edits )");
  my $id = lastseq();
  param(-name=>$tableid,-value=>$id);
}

sub print_table {
  print p, h2("Table: $table");
  my $data = $dbh->prepare("select * from $table");
  $data->execute;
  my @fields = @{$data->{NAME}};
  my @types = @{$data->{TYPE}};
  print '<table><tr>';
  print '<th> Edit';
  my @refhashes;
  for ( my $i = 1; $i <= $#fields; $i++ ) {
    my $f = $fields[$i];
    if ( isref($f) ) {
      my %myref = refhash($f);
      $refhashes[$i] = \%myref;
    } elsif ( isbool($f) ) {
      my %myref = boolhash($f);
      $refhashes[$i] = \%myref;
    }
    print '<th>', $f;
  }
  print '</tr>';
  while ( my(@row) = $data->fetchrow_array ) {
    print '<tr>';
    print '<td>', submit(-name=>'edit',-value=>$row[0]);
    for ( my $i = 1; $i <= $#fields; $i++ ) {
      print '<td>';
      if ( $refhashes[$i] ) {
        my $refh = $refhashes[$i];
        print $refh->{$row[$i]};
      } else { print $row[$i]; }
    }
    print '</tr>';
  }
  print '</table>';
}

sub print_ssi_header {
  my $title = shift;
# print CGI->start_html('TCBG Software Downloads');
  print $cgi->start_html('dev', -title=>$title);
}

sub print_ssi_footer {
  print $cgi->end_html('dev');
}

sub print_package_menu {
  print start_form, hidden(-name=>'UserID'), hidden(-name=>'AccessCode');
  print '<table border=0><tr valign="baseline"><td>';
  if ( ! param('PackageName') ) {
  my $packages = $dbh->prepare("select distinct Package.PackageID,Package.PackageName,Package.PackageURL,Package.PackageComment,Package.PackageSort from Package,Archive,Version where Package.PackageID = Archive.PackageID and Archive.VersionID = Version.VersionID and Version.IsHidden = 0 order by Package.PackageSort,Package.PackageName");
  $packages->execute();
  print strong('Go to:'), ' ';
  while ( my @package = $packages->fetchrow_array ) {
     print '<td>';
     print submit(-name=>'PackageName',-value=>$package[1]), ' ';
  }
  print '<td>';
  print submit(-name=>'PackageName',-value=>'MDTools'), ' ';
  print '<td>';
  }
  if ( param('UserID') && param('AccessCode') && ! param('ChangeInfo') ) {
    print submit(-name=>'PackageName',-value=>'Change Email/Password'), ' ';
  }
  print end_form;
  print '</tr></table>';
}

sub get_from_db {
  my $userid = param('UserID');
  my $accesscode = $dbh->quote(param('AccessCode'));
  my $data = $dbh->prepare("select " . shift() . " from User where UserID = $userid and AccessCode = $accesscode");
  $data->execute;
  if ( my @acdata = $data->fetchrow_array() ) {
    return $acdata[0];
  } else {
    return '';
  }
}

# only use this for password resetting!
sub get_by_username {
  my $username = $dbh->quote(param('UserName'));
  my $data = $dbh->prepare("select " . shift() . " from User where UserName = $username");
  $data->execute;
  if ( my @acdata = $data->fetchrow_array() ) {
    return $acdata[0];
  } else {
    return '';
  }
}

sub print_changeinfo_form {
  print h2('Change Email/Password');
  print start_form, hidden(-name=>'UserID'), hidden(-name=>'AccessCode');
  print strong('Email Address: ');
  print textfield(-name=>'NewEmailAddress',-size=>40,-value=>get_from_db('EmailAddress'));
  print ' &nbsp;&nbsp; ', submit(-name=>'ChangeInfo',-value=>'Submit Email');
  print end_form, p;
  print start_form, hidden(-name=>'UserID'), hidden(-name=>'AccessCode');
  print strong('Password: ');
  print password_field(-name=>'NewPassword',-size=>10);
  print strong(' &nbsp;&nbsp; Confirm: ');
  print password_field(-name=>'NewPasswordConfirm',-size=>10);
  print ' &nbsp;&nbsp; ', submit(-name=>'ChangeInfo',-value=>'Submit Password');
  print end_form;
  print p;
}

sub process_changeinfo_form {
  if ( param('NewEmailAddress') ) {
    my $userid = param('UserID');
    my $accesscode = $dbh->quote(param('AccessCode'));
    my $curdate = today();
    my $newemail = $dbh->quote(param('NewEmailAddress'));
    $dbh->do("update User set EmailAddress=$newemail,LastChangeDate=\'$curdate\' where UserID = $userid and AccessCode = $accesscode");
    my $email = get_from_db('EmailAddress');
    print h2("New email address \"$email\" accepted."),p;
  } elsif ( param('NewPassword') ) {
    if ( param('NewPassword') ne param('NewPasswordConfirm') ) {
      print h2('Sorry, passwords do not match.  Please try again.');
      param(-name=>'ChangeInfo',-value=>'Try Again');
    } else {
      my $userid = param('UserID');
      my $accesscode = $dbh->quote(param('AccessCode'));
      my $curdate = today();
      my $newemail = $dbh->quote(pwcrypt(param('NewPassword')));
      $dbh->do("update User set Password=$newemail,LastChangeDate=\'$curdate\' where UserID = $userid and AccessCode = $accesscode");
      print h2('New password accepted.'),p;
    }
    param(-name=>'NewPassword',-value=>'');
    param(-name=>'NewPasswordConfirm',-value=>'');
  }
}

sub print_download_menu {
  if ( param('UserID') && param('AccessCode') ) {
    process_nih_form();
    print_nih_form();
  }
  process_changeinfo_form();
  if ( ( param('PackageName') eq 'Change Email/Password' ) ) {
    param(-name=>'PackageName',-value=>'');
    param(-name=>'ChangeInfo',-value=>'Change Email/Password');
  }
  if ( param('ChangeInfo') ) {
    print_changeinfo_form();
    print_package_menu();
    return;
  }
  print_package_menu();
  if ( ( param('PackageName') eq 'NAMD' ) ) {
    print h2('Which version of NAMD should I download?');
    print p('The versions of NAMD below are distinguished first by OS, followed by the type of network interface, and whether or not CUDA is supported. If you are installing NAMD on a standalone workstation, we recommend downloading Linux-x86_64-multicore for Linux. If your workstation has a CUDA-capable GPU, you should try downloading Linux-x86_64-multicore-CUDA. If you wish to run multi-copy algorithms, such as replica-exchange MD, you should try the "netlrts" builds, such as Linux-x86_64-netlrts-smp or Linux-x86_64-netlrts-smp-CUDA. Windows users are encouraged to install WSL (<a href="https://learn.microsoft.com/en-us/windows/wsl/install">Windows for Linux Subsystem</a>) in order to run our most recent Linux builds. <br><h2><b>Point release 3.0.1 fixes potentially impactful bugs in 3.0. All users are strongly encouraged to upgrade immediately.</b></h2>');
  }
  if ( ( param('PackageName') eq 'MDTools' ) ) {
    print h1('About MDTools:');
    print p('MDTools is a collection of programs, scripts, and utilities we provide for researchers to make various modeling and simulation tasks easier.  Each tool, script, or library is distributed separately and no registration is required.');
    print h3('Please visit the <a href="/Development/MDTools/">MDTools site</a> for more information.');
  }
  if ( ! param('PackageName') ) { return; }
  #print start_form, hidden(-name=>'UserID'), hidden(-name=>'AccessCode'), hidden(-name=>'PackageName');
  my $userid = param('UserID');
  my $accesscode = param('AccessCode');
  my $packagename = $dbh->quote(param('PackageName'));

  my $packages = $dbh->prepare("select distinct Package.PackageID,Package.PackageName,Package.PackageURL,Package.PackageComment,Package.PackageStyle,Package.PackageSort from Package,Archive,Version where Package.PackageName = $packagename and Package.PackageID = Archive.PackageID and Archive.VersionID = Version.VersionID and Version.IsHidden = 0 order by Package.PackageSort,Package.PackageName");
  $packages->execute();
  while ( my @package = $packages->fetchrow_array ) {
    my $packageid = $package[0];
    my $longstyle = 1;
    if ( $package[4] eq 'table' ) { $longstyle = 0; }
    print h2("Download $package[1]:");
    print p;
    if ( $package[3] ) { print $package[3],"\n"; }
    if ( $package[2] ) { print "Visit the <a href=\"$package[2]\">$package[1] website</a> for complete information and documentation."; }
    print p;
    if ( ! param('UserID') || ! param('AccessCode') ) {
      print p('Selecting an archive below will lead to a user registration and login page.  Your download will continue after you have registered or logged in.');
    }
    my @platformids;
   if ( ! $longstyle ) {
    my $platforms = $dbh->prepare("select distinct Platform.PlatformID,Platform.PlatformName,Platform.PlatformSort from Archive,Version,Platform where Archive.PackageID = $packageid and Archive.VersionID = Version.VersionID and Version.IsHidden = 0 and Archive.PlatformID = Platform.PlatformID order by Platform.PlatformSort,Platform.PlatformName");
    $platforms->execute();
    print '<table border=0 cellpadding=4><tr><th>';
    #print '<th>';
    my $i = 0;
    while ( my @platform = $platforms->fetchrow_array ) {
      $platformids[$i] = $platform[0]; $i++;
      #$platform[1] =~ s/[a-zA-Z]*[_ ]//;
      print '<th>', $platform[1];
    }
   }
    my $archives = $dbh->prepare("select Archive.ArchiveID,Archive.ArchiveName,Archive.VersionID,Version.VersionName,Version.IsStable,Version.VersionComment,Version.ReleaseDate,Archive.PlatformID,Platform.PlatformName,Platform.PlatformComment,Platform.PlatformSort from Archive,Version,Platform where Archive.PackageID = $packageid and Archive.VersionID = Version.VersionID and Version.IsHidden = 0 and Platform.PlatformID = Archive.PlatformID order by Version.ReleaseDate desc,Archive.VersionID desc,Platform.PlatformSort,Platform.PlatformName");
    $archives->execute();
    my $archiveid; my $versionid; my $versionname; my $isstable; my $versioncomment;
    my $releasedate; my $platformid, my $platformname; my $platformcomment; my $archivename; my $platformsort;
    $archives->bind_columns(\$archiveid,\$archivename,\$versionid,\$versionname,\$isstable,\$versioncomment,\$releasedate,\$platformid,\$platformname,\$platformcomment,\$platformsort);
    my $oldversionid = -1;
    my $i = @platformids;
    while ( $archives->fetch ) {
      if ( $versionid != $oldversionid ) {
        if ( $longstyle && $oldversionid != -1 ) {
          print '</ul>';
        }
        $oldversionid = $versionid; 
        #$versionname =~ s/[a-zA-Z]*[_ ]//;
       if ( ! $longstyle ) {
        while ( $i <= $#platformids ) {
          print '<th>'; $i++;
        }
        print '</tr><tr valign="middle"><td>';
        #print "$releasedate<td>";
        print strong("Version $versionname");
       } else {
        print h3("Version $versionname ($releasedate) Platforms:");
        print "<blockquote>$versioncomment</blockquote>";
        print '<ul>';
       }
        $i = 0;
      }
      my $dlurl = url(-relative=>1) . "?UserID=$userid&AccessCode=$accesscode&ArchiveID=$archiveid";
     if ( ! $longstyle ) {
      while ( $platformids[$i] != $platformid && $i < $#platformids ) {
        print '<th>'; $i++;
      }
      print '<th>';
      #print '<th bgcolor="#FFC38C">';
      print "<a href=\"$dlurl\"><img src=\"download.jpg\" alt=\"Download $archivename\"></a>";
      #print "<a href=\"$dlurl\">Get</a>";
      $i++;
     } else {
       print '<li>';
       print "<a href=\"$dlurl\">$platformname</a>";
       if ( $platformcomment ) { print " ($platformcomment)"; }
     }
      
    }
    while ( $i <= $#platformids ) {
      print '<th>'; $i++;
    }
   if ( ! $longstyle ) {
    print '</tr>';
    print '</table>'; 
   } else {
    print '</ul>';
   }
  }

  print p;
  if ( $debug ) {
  print start_form, hidden(-name=>'UserID'), hidden(-name=>'AccessCode'), hidden(-name=>'PackageName');
  print submit(-value=>'Reload');
  print end_form;
  }
}

sub print_download_info {
  my $archiveid = param('ArchiveID');
  if ( param('AgreeToLicense') ) {

  my $archives = $dbh->prepare("select Archive.ArchiveName,Archive.ArchiveURL,Version.ReleaseNotesText,Package.PackageName,Package.PackageURL from Archive,Version,Package where Archive.ArchiveID = $archiveid and Archive.VersionID = Version.VersionID and Archive.PackageID = Package.PackageID" );
  $archives->execute();
  my @archive = $archives->fetchrow_array;
  #print '<html><head><title>TCBG Software Downloads</title>';
  print "<meta http-equiv=\"refresh\" content=\"0;url=$archive[1]\">";
  # This sleep somehow makes the above refresh more reliable on Netscape!!!
  sleep 1;
  #print '</head>';
  #print_params();
  print_download_menu();
  #print h1($archive[0]);
  print h3("Your browser should begin downloading shortly.\
	If it does not, select <a href=\"$archive[1]\">this link</a>.");
  print p, "Thank you for downloading $archive[0].", p;
  if ( $archive[4] ) { print "Visit the <a href=\"$archive[4]\">$archive[3] website</a> for complete information and documentation.", p; }
  if ( $archive[2] ) { print p,$archive[2],p; }
  my $curdate = today();
  my $userid = param('UserID');
  my $remotehost = remote_host();
  $dbh->do("insert into Download \
	(DownloadID,DownloadDate,UserID,DownloadHost,ArchiveID) values \
	(NULL,'$curdate',$userid,'$remotehost',$archiveid)");

  } else {

  my $archives = $dbh->prepare("select Archive.ArchiveName,License.LicenseText from Archive,Version,License where Archive.ArchiveID = $archiveid and Archive.VersionID = Version.VersionID and Version.LicenseID = License.LicenseID" );
  $archives->execute();
  my @archive = $archives->fetchrow_array;
  print h1($archive[0]);
 
  print p, strong("To download this software you must agree to abide by the terms of the following license:");
  print p;
  if ( param('PrintableLicense') ) {
    print '<pre>',$archive[1],'</pre>';
  } else {
    print start_form(-action=>url(-relative=>1));
    print '<textarea name="LicenseText" rows=15 cols=80 readonly>',$archive[1],'</textarea>';
    # param(-name=>'LicenseText',-default=>$archive[1],-override=>1);
    # print textarea(-name=>'LicenseText',-rows=>15,-columns=>80);
    print end_form;
  }
  print p;

  my $userid = param('UserID');
  my $user = $dbh->prepare("select FullName from User where UserID = $userid");
  $user->execute;
  my @userdata = $user->fetchrow_array();
  my $fullname = $userdata[0];

  print start_form(-action=>url(-relative=>1));
  print hidden(-name=>'UserID'), hidden(-name=>'AccessCode'), hidden(-name=>'ArchiveID');
  print p;
  print p, submit(-name=>'AgreeToLicense',-value=>"I am $fullname and I agree to the terms of this License");
  if ( ! param('PrintableLicense') ) {
    print ' ',submit(-name=>'PrintableLicense',-value=>'Printable version');
  }
  print end_form;

  }
}