it's a code thing: March 2003

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:

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

#!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".
 
         Den totale datam&aelig;ngde var p&aring; <B>$TOTAL_BYTES</B> bytes.
 
    </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;

it's a code thing

Thursday, March 20, 2003

PERL upload and download image to database (code nostalgia)