![FmPro Migrator - Oracle Files - Title Graphic](../../../images/fmpro_migrator_oracle_files_title.jpg)
FmPro
Migrator Features and Benefits
FmPro
Migrator Demo Available for download...
Bookmark
This Page
Flowchart
HTML
Delete Record Display Example
![.](../../../images/hline_columnB.gif)
#!/usr/bin/perl
# Script: example_delete_record_display1
# Features: This Perl program accepts the
# primary key value passed in the URL
# then retrieves and displays this one
# record from the database.
# If the cnum parameter is passed
# to this script in the URL, then
# this script simply passes the
# GIF or JPEG image data to the browser.
#
# Requirements:
# Perl CGI module
# Perl DBI module
# Perl DBD::Oracle module
# Oracle client software must be installed on the
# webserver running this program.
# The Oracle database service name needs
# to be entered into the tnsnames.ora file
# on the webserver.
#
# Database Connection:
# Oracle Connection: prod1
#
# External Files:
# HTML Query Form: example_delete1.html
# Display Record Script:example_delete_record_display1
# Delete Record: example_delete_one_record1
#
#
#
# Usage: Delete List Links To: http://www.dotcomsolutionsinc.net/cgi-bin/example_delete_record_display1
#
# Copyright 2003 by .com Solutions Inc.
#
# ---------------------- Revision History ---------------
# Date By Changes
# 6-27-2003 dsimpson Initial Release
#
# This output file was created by FmPro Migrator version 1.46 on Mon
Jul 14 12:16:11 2003. By .com Solutions Inc. www.dotcomsolutionsinc.net
#
use strict;
use DBI qw(:sql_types);
use CGI qw(:standard escape);
$CGI::POST_MAX=10000; # max post size - to avoid
denial of service attacks
$CGI::DISABLE_UPLOADS = 1; # 1 = no uploads of files allowed via CGI.pm
- for security
my $db_connect_string = 'prod1';
my $database_tablename = 'asset_management2';
my $schema_name = 'user1';
my $schema_password = 'user1pwd';
my $debug = 0; # DBI tracing enable/disable
my $long_readlength = 10000; # maximum number of bytes for character
and binary large object types data inserted into database - increase
this value as needed
my $global_database_error = 0;
my $primary_key_column = 'item';
my $dbi_bind_param_text = ''; # list of DBI bind parameter statements
my $bind_param_count = 1; # Bind parameter counter starts at 1
my $ref_rowdata = (); # Reference to dbi fetchrow_arrayref of query
results - (this improves performance)
my $generic_error_text = 'Error encountered:';
my $no_records_found_error_text = 'Record not found.';
my $use_external_html = 0; # 1 = read HTML from external files, 0 =
use default HTML
my $external_html_header_filename = 'example_header1.html';
my $external_html_footer_filename = 'example_footer1.html';
# ---------- Display Image -----------
# This sub gets the MIME type of the image, the image size and passes
# this info to the browser with the correct headers for display of one
image.
sub display_image ($)
{
my $rowdata_count = $_[0]; # get rowdata array element number passed
into this sub
my $image_type='';
my $image_size = length($ref_rowdata->[$rowdata_count]);
if ($image_size > 0)
{
if (substr($ref_rowdata->[$rowdata_count],0,3) =~ 'GIF' )
{
# if 1st 3 characters of container field data contain GIF - it is a
GIF image
$image_type = 'image/gif';
}
elsif (substr($ref_rowdata->[$rowdata_count],0,10) =~ 'JFIF' )
{
# if 1st 10 characters of container field data contain JFIF - it is
a JPEG image
$image_type = 'image/jpeg';
}
# output content type and length headers
print header (-type=>$image_type, -Content_Length=> $image_size);
# send the image data to the browser
print $ref_rowdata->[$rowdata_count];
}
}
# ---------- Alternate HTML Header/Footer -----------
# This HTML page Header/Footer info is used by default
my $html_header =<<"EOF"; # default HTML header
<html>
<head>
<title>example display record to be deleted</title>
<meta http-equiv="Content-Type" content="text/html;
charset=iso-8859-1">
</head>
<body bgcolor="#FFFFFF" text="#000000" >
EOF
my $html_footer =<<"EOF"; # default HTML footer
</body>
</html>
EOF
if ($use_external_html == 1)
{
{
# set input line separator to undef to read whole file at once
local $/ = undef;
# read HTML header from external file
open (FILE1,"$external_html_header_filename") || warn ("Could
not open input file $external_html_header_filename for reading. Using
default header HTML instead of external file.");
$html_header = <FILE1>;
# close the input file
close (FILE1);
# read HTML footer from external file
open (FILE1,"$external_html_footer_filename") || warn ("Could
not open input file $external_html_footer_filename for reading. Using
default footer HTML instead of external file.");
$html_footer = <FILE1>;
# close the input file
close (FILE1);
}
}
# ---------- Displayed Field Names -----------
my $item_display_as = 'Item to Enter';
my $category_display_as = 'Category of Item';
my $picture_display_as = 'Picture';
my $model_display_as = 'Model';
my $serial_number_display_as = 'Serial Number';
my $information_display_as = 'Information';
my $date_purchased_display_as = 'Date Purchased';
my $depreciation_display_as = 'depreciation';
my $assigned_display_display_as = 'assigned_display';
my $depreciation_life_display_as = 'depreciation_life';
my $remaining_life_display_as = 'remaining_life';
my $cost_display_as = 'cost';
my $book_value_display_as = 'book_value';
# ---------- Get Search and Image Column Display
Criteria -----------
# get primary key search parameter passed in via URL
my $cgi_item = param($primary_key_column);
# if the cnum parameter is passed to this script
- then this script performs
# the single row database query and retrieves the image data for one
image column
# for display to the browser.
# If the cnum parameter is not passed to this script - then all of the
remaining
# data columns are retreived and displayed within an HTML table by the
web browser.
my $column_num = param("cnum"); # get column number for image
data - if used
# ---------- Retrieve 1 Record From Database -----------
if (!defined $column_num)
{
print header();
print $html_header;
}
if ($debug == 1)
{
# turn on DBI tracing
unlink 'dbitrace.log' if -e 'dbitrace.log';
DBI->trace(2, 'dbitrace.log');
}
my $db_dbh = DBI->connect ("dbi:Oracle:$db_connect_string",
"$schema_name", "$schema_password", {RaiseError
=> 0, PrintError => 1, AutoCommit => 1 })
or die "Can't connect to the Oracle $db_connect_string database:
$DBI::errstr\n";
$db_dbh->{LongReadLen} = $long_readlength;
$db_dbh->{LongTruncOk} = 0;
my $db_sth = $db_dbh->prepare("ALTER SESSION
SET NLS_DATE_FORMAT = 'YYYY-MM-DD HH24:MI:SS'");
$db_dbh->{RaiseError} = 1; # don't continue processing if error is
encountered here
$db_sth->execute();
$db_sth = $db_dbh->prepare("select item,
category, picture, model, serial_number, information, date_purchased,
depreciation, assigned_display, depreciation_life, remaining_life, cost,
book_value from $database_tablename where $primary_key_column = ? ")
or warn " Database error:",$db_dbh->errstr(), "\n";;
$global_database_error = 1 if ($db_sth->err());
# ---------- Bind Parameter - Query Input Parameter
-----------
$db_sth->bind_param(1,$cgi_item,SQL_VARCHAR); # item - VARCHAR2(4000)
column
$db_sth->execute() or warn $db_sth->errstr();
# check for error
$global_database_error = 1 if ($db_sth->err());
# ---------- Display Image Columns Only -----------
if (defined $column_num)
{
# display only one image from the database row retrieved
$ref_rowdata = $db_sth->fetchrow_arrayref();
&display_image($column_num);
}
# ---------- Display All Columns for One Record -----------
else
{
if ($global_database_error == 0)
{
print "<form name=\"display record to delete\" method=\"POST\"
enctype=\"multipart/form-data\" action=\"http://www.dotcomsolutionsinc.net/cgi-bin/example_delete_one_record1\"
>";
print '<table border="1">'; # start table HTML command
$ref_rowdata = $db_sth->fetchrow_arrayref();
# HTML escape all output data for correct display
in browser
$ref_rowdata->[0] = CGI::escapeHTML($ref_rowdata->[0]);
$ref_rowdata->[1] = CGI::escapeHTML($ref_rowdata->[1]);
$ref_rowdata->[3] = CGI::escapeHTML($ref_rowdata->[3]);
$ref_rowdata->[4] = CGI::escapeHTML($ref_rowdata->[4]);
$ref_rowdata->[5] = CGI::escapeHTML($ref_rowdata->[5]);
$ref_rowdata->[6] = CGI::escapeHTML($ref_rowdata->[6]);
$ref_rowdata->[7] = CGI::escapeHTML($ref_rowdata->[7]);
$ref_rowdata->[8] = CGI::escapeHTML($ref_rowdata->[8]);
$ref_rowdata->[9] = CGI::escapeHTML($ref_rowdata->[9]);
$ref_rowdata->[10] = CGI::escapeHTML($ref_rowdata->[10]);
$ref_rowdata->[11] = CGI::escapeHTML($ref_rowdata->[11]);
$ref_rowdata->[12] = CGI::escapeHTML($ref_rowdata->[12]);
my $script_url = self_url() . '&cnum=';
my $column_number2 = 2;
my $image_column2_tag = "<IMG SRC = \"$script_url$column_number2\"><br>"
if length($ref_rowdata->[2]) > 0;
print "<tr><th>$item_display_as</th><td>\ $ref_rowdata->[0]</td></tr>\n";
print "<tr><th>$category_display_as</th><td>\ $ref_rowdata->[1]</td></tr>\n";
print "<tr><th>$picture_display_as</th><td>\ $image_column2_tag\ </td></tr>\n";
print "<tr><th>$model_display_as</th><td>\ $ref_rowdata->[3]</td></tr>\n";
print "<tr><th>$serial_number_display_as</th><td>\ $ref_rowdata->[4]</td></tr>\n";
print "<tr><th>$information_display_as</th><td>\ $ref_rowdata->[5]</td></tr>\n";
print "<tr><th>$date_purchased_display_as</th><td>\ $ref_rowdata->[6]</td></tr>\n";
print "<tr><th>$depreciation_display_as</th><td>\ $ref_rowdata->[7]</td></tr>\n";
print "<tr><th>$assigned_display_display_as</th><td>\ $ref_rowdata->[8]</td></tr>\n";
print "<tr><th>$depreciation_life_display_as</th><td>\ $ref_rowdata->[9]</td></tr>\n";
print "<tr><th>$remaining_life_display_as</th><td>\ $ref_rowdata->[10]</td></tr>\n";
print "<tr><th>$cost_display_as</th><td>\ $ref_rowdata->[11]</td></tr>\n";
print "<tr><th>$book_value_display_as</th><td>\ $ref_rowdata->[12]</td></tr>\n";
# send hidden form field with primary key value
print "<input type=\"hidden\" name=\"item\"
value=\"$cgi_item\">";
print '</table>'; # end table HTML command
print '<input type="submit" name="Delete Record"
value="Delete Record">';
print "</form>";
print "</body>";
print "</html>";
}
else
{
if ($global_database_error == 0)
{
print "$no_records_found_error_text<BR>";
print $html_footer;
}
else
{
print "<BR>$generic_error_text<BR>$DBI::errstr";
print $html_footer;
}
}
}
$db_sth->finish();
# disconnect from database
$db_dbh->disconnect or warn "Can't disconnect from the database
$db_connect_string database: $DBI::errstr\n";
![.](../../../images/hline_columnB.gif)
![hline](../../../images/hline.gif)