#! /usr/bin/perl -Tw
#
# This script, "soa.cgi", was written by Joe Freeman for the IAEA-TM
#    "Submission of Abstracts" page, based upon the script "upload.pl"
#    by Muhammad Muquit.
# It is designed to be run from Web page
#    http://fusion.gat.com/conferences/iaea-tm-computing/exchange/.
# Variables beginning with a capital letter are global variables.

use strict ;
use CGI    ;

$| = 1 ;

my $query       = new CGI ;
my $Overwrite   = 0 ;
my $Debug       = 0 ;
my $Title       = "Submission of Abstracts > Upload a File" ;
my $Upload_path = "/web/conferences/iaea-tm-computing/exchange/incoming/" ;

print $query->header ;

&printHTMLHeader ;

if ( $query->param )
{
  &doWork() ;
}
else
{
  &printForm() ;
}

sub printForm
{
    print '<center><table bgcolor="#ffff99" width="100%" border="0" cellpadding="12" cellspacing="0">' ;
    print $query->start_multipart_form, "\n" ;

  # upload

    print '<tr><td align="right"><font face="Helvetica,Arial,sans-serif" size="+1"><b>Upload this file:</b></font></td><td>' ;
    print $query->filefield(-name => 'upload_file',
                            -size =>  48,
                       -maxlength =>  96) ;
    print "</td></tr>" ;

  # submit

    print '<tr><td colspan="2" align="center">' ;
    print $query->submit(-label =>  'upload',
                         -value => ' Upload Now ') ;
    print "</td></tr>\n" ;
    print $query->endform, "\n" ;
    print "</table></center>" ;
}

sub printHTMLHeader
{
    print $query->start_html(-title => "$Title",
                           -bgcolor => "#ffffff",
                              -text => "#000000") ;
}

sub doWork
{
    my $error_message = '' ;

    &printForm() ;
    if ( $error_message )
    {
      &printError($error_message) ;
      return ;
    }

  # now upload file

    &uploadFile() ;

    if ( $Debug == 1 )
    {
      my @all = $query->param ;
      my $name ;
      foreach $name (@all)
      {
        print "DEBUG: $name = ", $query->param($name), "<BR>" ;
      }
    }
}

sub printError
{
  my $error_message = shift ;
  print <<EOF ;
<center>
  <hr size="4" width="100%">
  <table bgcolor="#ffcccc" width="100%" border="0" cellpadding="12" cellspacing="0">
    <tr align="center">
      <td width="100%">
        <br>
        <font face="Helvetica,Arial,sans-serif" size="+1"><b>Error: $error_message</b></font>
      </td>
    </tr>
    <tr align="center">
      <td width="100%">
        <font face="Helvetica,Arial,sans-serif" size="+1">
          <b>
            <a href="/conferences/iaea-tm-computing/submission.html">Return</a> to the <font color="#ff0000">Submission of Abstracts</font> page, or try another file upload.
          </b>
        </font>
        <br>
        <br>
      </td>
    </tr>
  </table>
</center>
EOF
;
}

sub uploadFile
{
  my $time_took       ;
  my $start_time      ;
  my $bytes_read =  0 ;
  my $size       =  0 ;
  my $buffer     = '' ;
  my $filepath   = '' ;
  my $filename   = '' ;
  my $pathname   = '' ;

  $filepath = $query->param('upload_file') ;

  if ( $filepath =~ /([^\/\\]+)$/ )
  {
    $filename = "$1" ;
  }
  else
  {
    $filename = "$filepath" ;
  }

  $filename =~  s/\s+/_/g  ;
  $filename =~ tr/A-Z/a-z/ ;
  $pathname = "$Upload_path" . "$filename" ;

  print "DEBUG: filename = $filename<BR>\n" if $Debug ;
  print "DEBUG: pathname = $pathname<BR>\n" if $Debug ;

  if ( ! $filename )
  {
    &printError("You must provide the name of a file to upload.") ;
    return ;
  }

  if ( $Overwrite == 0 )
  {
    if ( -e $pathname )
    {
      &printError("A file named <font color=\"#3333ff\">$filename</font> already exists. It may not be overwritten.") ;
      return ;
    }
  }

  if ( ! open(WFD,">$pathname") )
  {
    &printError("Error opening file for writing.") ;
    return ;
  }

  $start_time = time() ;
  while ( $bytes_read = read($filepath,$buffer,4096) )
  {
    $size += $bytes_read ;
    binmode WFD ;
    print   WFD $buffer ;
  }

  print "DEBUG: size = $size<BR>\n" if $Debug ;

  close(WFD) ;

  if ( (stat $pathname)[7] <= 0 )
  {
    unlink($pathname) ;
    &printError("File <font color=\"#3333ff\">$filename</font> could not be uploaded. Are you sure it exists?") ;
    return ;
  }
  else
  {
    chmod 0333, $pathname ;
    $time_took = time() - $start_time ;
    print <<EOF ;
<center>
  <hr size="4" width="100%">
  <table bgcolor="#99ff99" width="100%" border="0" cellpadding="12" cellspacing="0">
    <tr align="center">
      <td width="100%">
        <br>
        <font face="Helvetica,Arial,sans-serif" size="+1">
          <b>
            File    <font size="+1" color="#ff0000">$filename</font>
            of size <font size="+1" color="#ff0000">$size</font>
            bytes was successfully uploaded.
          </b>
        </font>
      </td>
    </tr>
    <tr align="center">
      <td width="100%">
        <font face="Helvetica,Arial,sans-serif" size="+1">
          <b>
            <a href="/conferences/iaea-tm-computing/submission.html">Return</a> to the <font color="#ff0000">Submission of Abstracts</font> page, or try another file upload.
          </b>
        </font>
        <br>
        <br>
      </td>
    </tr>
  </table>
</center>
EOF
;
  }
}