PERL upload and download image to database (code nostalgia)

I can across an one of my old storage hard disks which I use as backup. I plugged it in and went exploring and found a few programs PERL scripts from 1996 :). I do vaguely remember the HTML mixed code.

These 2 scripts was responsible for the download and upload of images to a image database in an Oracle database. It actually ended up serving up to 60K page-hits a day where each page contained about 5-10 pictures for a few years and performed acceptably at the time.

Pure nostalgia :)

Here is the upload script:

#!c:\oracle\oraport/Apache/perl/5.00503/bin/MSWin32-x86/perl.exe
#
# FILE NAME:
# mediaUpload.cgi
#
# DESCRIPTION:
#   Script responsible for the binary upload of BLOBs over the http web protocol.
#   The file will be inserted into a database as well as uploaded to a specified
#   $SAVE_DIRECTORY on the webserver.

########################### User defined variables #############################

#$ENV{ORACLE_HOME} = '/u02/oracle/ora817';
#$ENV{NLS_LANG} = 'danish_denmark.we8iso8859p1';
#$ENV{ORA_NLS33} = '/u02/oracle/ora817/ocommon/nls/admin/data';

my $user    = "USERNAME";
my $passwd  = "PASSWORD";
my $driver  = "Oracle";
my $db_name = "DATABASENAME";

my $SAVE_DIRECTORY = "/images";
my $NT_SERVER = 0;


################################################################################


use CGI qw(:standard);
my $query = new CGI;
use CGI qw(:cgi-lib);
use DBI qw(:sql_types);



# Parse arguments
local *in;
&ReadParse(*in);

# Flush StdOut
$| = 1;



# Used for debugging the scripts. If a debugging variable is sent as a
# parameter in the query_string then set debugging mode on.
if ($ENV{'QUERY_STRING'} =~ /debug/g) {
 my $debugMode= $in{'debug'};
}
else {
 my $debugMode = 0;
}





#print &PrintHeader;

my $dataSource = "dbi:$driver:${db_name}";
my $dbh = DBI->connect($dataSource, $user, $passwd) || die "Error connecting to database: $DBI::errstr\n";

&insert_data;

exit;


sub insert_data() {

 # Upload binary data
 foreach $key (sort {$a <=> $b} $query->param()) {
  next if ($key =~ /^\s*$/);
  next if ($query->param($key) =~ /^\s*$/);
  next if ($key !~ /^media:/);
  ($garbage, $filenumber) = split(/:/,$key);

  $filenumber =~ s/file//;
  $desc = "desc" . $filenumber;
  $mime = "mime" . $filenumber;
        $cat = "cat" . $filenumber;

  $Number = $1;

  if ($query->param($key) =~ /([^\/\\]+)$/) {
   $Filename = $1;
   $Filename =~ s/^\.+//;
   $File_Handle = $query->param($key);
   $no_bytes = (stat ($File_Handle))[7];
  }

     undef $BytesRead;
  undef $Buffer;

  read ($File_Handle, $Buffer, $no_bytes);

  # Get the next id from the database
  my $sqlId = "
      SELECT icseq_media_elements.NEXTVAL
            FROM dual";
        my $id = $dbh->selectrow_array( $sqlId );

        $string = $File_Handle;
        $string =~ s/(.*)\.(.*)//g;
        $ext = $2;


  # Save image to database
  $sqlInsert = "
   INSERT INTO ic_media_elements
    (media_id,
     media,
     mime_type,
     org_file_name,
     file_size,
     description,
     category_id,
     user_created,
     date_created,
     user_changed,
     date_changed)
   VALUES
    (:media_id,
     :media,
     :mime_type,
     :org_file_name,
     :file_size,
     :description,
     :category_id,
     :user_created,
      SYSDATE,
     :user_changed,
      SYSDATE)";

  $sth = $dbh->prepare($sqlInsert);
  $sth->bind_param(":media_id", $id);
  $sth->bind_param(":media", $Buffer, SQL_BINARY);
  $sth->bind_param(":mime_type", $in{$mime});
  $sth->bind_param(":org_file_name", $Filename);
  $sth->bind_param(":file_size", $no_bytes);
  $sth->bind_param(":description", $in{$desc});
  $sth->bind_param(":category_id", $in{$cat});
  $sth->bind_param(":user_created", "administrator");
  $sth->bind_param(":user_changed", "administrator");
  $sth->execute();


        # Save image to file
        if (!open(OUTFILE, ">$SAVE_DIRECTORY\/$id\.$ext")) {
            print "Content-type: text/plain\n\n";
            print "-------------------------\n";
            print "Error:\n";
            print "-------------------------\n";
            print "File: $SAVE_DIRECTORY\/$Filename\n";
            print "-------------------------\n";
         print "There was an error opening the Output File\n";
         print "for Writing.\n\n";
         print "Make sure that the directory:\n";
         print "$SAVE_DIRECTORY\n";
         print "has been chmodded with the permissions '777'.\n\n";
         print "Also, make sure that if your attempting\n";
         print "to overwrite an existing file, that the\n";
         print "existing file is chmodded '666' or better.\n\n";
         print "The Error message below should help you diagnose\n";
         print "the problem.\n\n";
         print "Error: $!\n";
            exit;
        }
  if ($NT_SERVER) {
   binmode(OUTFILE);
  }
  {next;}
        print OUTFILE $Buffer;
     close(OUTFILE);


  push(@Files_Written, "$SAVE_DIRECTORY\/$Filename");

  $TOTAL_BYTES += $no_bytes;
  $Confirmation{$File_Handle} = $no_bytes;

     close($File_Handle);
  $FILES_UPLOADED = scalar(keys(%Confirmation));
 }
 print header;
 print <<__END_OF_HTML_CODE__;
  <html>
  <head>
  <title>Resultat af data upload</title>
        <link rel="stylesheet" href="/cm.css/CMfont.css" type="text/css">
  </head>

  <body bgcolor="#FFFFFF" text="#000000">

  <table width="560" border="1" cellspacing="0"  align="center">
   <tr bgcolor="#FFFF00">
    <td colspan="3" class="divText">
         Du har uploadet de f&oslash;lgende <b>$FILES_UPLOADED</b> fil(er) til $driver databasen "$db_name".<BR>
         Den totale datam&aelig;ngde var p&aring; <B>$TOTAL_BYTES</B> bytes.<BR>
    </td>
   </tr>
   <tr bgcolor="#CCCCCC">
    <td width="400" class="divTextH2">Fil</td>
    <td width="160" class="divTextH2">St&oslash;rrelse </td>
   </tr>
__END_OF_HTML_CODE__

 foreach $key (keys (%Confirmation)) {
  print <<__END_OF_HTML_CODE__;
   <tr bgcolor="#FFFFFF">
    <td width="400" class="divText">$key</td>
    <td align=right width="160" >$Confirmation{$key} bytes</td>
    <tr>
__END_OF_HTML_CODE__
 }

 print <<__END_OF_HTML_CODE__;
  </TABLE>
  </body>
  </html>
__END_OF_HTML_CODE__

 exit;
} 

and the download script

#!c:\oracle\oraport/Apache/perl/5.00503/bin/MSWin32-x86/perl.exe
#
# FILE NAME:
# media.cgi
#
#
# DESCRIPTION:
# Retrieves an media elements (jpeg, gif, mov ..) from the database and shows
# it in the same way as if it had been on the filesystem.
#
# ABSTRACT:
# Based on a 'page_id' and the 'insert_area_name' sent as parameters issue an
# SQL to the database retrieve media and the mime_type columns from the specific
# row found.
#
#
# HISTORY:
# Date  Developer   Version Description Of Changes Made
# ----  ---------   ------- ---------------------------
#   14/7-2001   Kenneth Thorman  1.0   Original

########################### User defined variables #############################

$ENV{ORACLE_HOME} = '/u02/oracle/ora817';
$ENV{NLS_LANG} = 'danish_denmark.we8iso8859p1';
$ENV{ORA_NLS33} = '/u02/oracle/ora817/ocommon/nls/admin/data';

my $user    = "USERNAME";
my $passwd  = "PASSWORD";
my $driver  = "Oracle";
my $db_name = "DATABASENAME";



################################################################################

use CGI qw(:standard, :cgi-lib);
use DBI qw(:sql_types);

$query = new CGI;

local *in;
&ReadParse(*in);

$dataSource = "dbi:$driver:${db_name}";
$dbh = DBI->connect($dataSource, $user, $passwd);

# Make sure buffer is big enough for CLOB, BLOB (200KB)
$dbh->{LongReadLen}= 200 * 1024;

# SQL statement to select an media based on page_id, and insert_area_name
$sql = "
 SELECT media, mime_type
 FROM ic_media_elements
 WHERE media_id = :media_id";
$sth = $dbh->prepare($sql);

# Bind the input values to named place holders to allow for caching
$sth->bind_param(":media_id", $in{'media_id'});
$sth->execute();

# Binding output columns to minimize variables used. 
$sth->bind_col( 1, \$media );
$sth->bind_col( 2, \$mime_type );
$sth->fetch();

print $query->header($mime_type), $media;

$sth->finish;
$dbh->disconnect;