[HRPM] newby_Perl_copious_memory_consumer_program
Michael Theiss
webmaster at udtseals.com
Fri Aug 25 19:35:00 CDT 2000
#/usr/bin/perl -w
use strict;
##################################################################################
#**********************************************************************************
#*** The original author of the proram is 'magic1on'
#** Contributing mentors: Jeff, </chris>
#**
#** *******This program is pre beta***********
#**
#**********************************************************************************
###This script is being written to fulfill the following need:
###1. To import 7 or more :text/html files and parse the imput with some local
### :text/html content and then put the resulting document into a scaler
### which will then be assigned to @master which will then be joined to one
### of 8 possible scalers listed in the sub routine below. The subroutine below
### serves as a global routine for the main.cgi script at the following url:
### http://www.udtseals.com/cgi-bin/0/warrior_links0/main.cgi
###
###
### sub LoadTemplate {
### my($file) = @_;
### open(TEMPLATE, "$file")||&DieNice("Opening: $file -- $!");
### my @template = <TEMPLATE>;
### close(TEMPLATE);
### open(MASTER, "$t_dir/master.htm")||&DieNice("Openeing: $t_dir/master.htm");
### my @master = <MASTER>;
### close(MASTER);
### my $html = join("", at master);
### $html =~ s/!INSERT!/@template/gi;
### $html =~ s/\$version/$version/gi;
### $html =~ s/\$add_url/add\.cgi/gi;
### $html =~ s/\$search_url/search\.cgi/gi;
### $html =~ s/\$new_url/whatsnew\.cgi/gi;
### $html =~ s/\$old_url/whatsold\.cgi/gi;
### $html =~ s/\$random_url/random\.cgi/gi;
### $html =~ s/<!--CATEGORY OPTIONS-->/$category_options/gi;
### return $html;
### }
###
###2. In order to test the result of the 7 :text/html files and the local :text/html
### being parsed and put into a scaler, I am attempting to print the resulting $scaler
### to standard output first, by calling it from the following url:
### http://www.udtseals.com/cgi-bin/0/warrior_links0/templates/master1.pl
###
###3. Then I will assign the resulting $scaler to the @master
### and test the full output of the subroutine by calling main.cgi from a client/web
### browser from the following url:
### http://www.udtseals.com/cgi-bin/0/warrior_links0/main.cgi
###
###4. The orriginal request that I posted to the HRPM contained a script called master0.pl.
### master0.pl was the first pre beta attempt to parse the 7: text/html files and
### print to standard output. master0.pl is below and the output can be viewed live
### by calling it from the following url:
### http://www.udtseals.com/cgi-bin/0/warrior_links0/templates/master0.pl
###
### Below is the original script master0.pl
###
### print "Content-type: text/html\n\n";
### print "<head>\n";
### print "<!--START META DATA -->\n";
### {
### &PostIt;
### }
### print "<!--END META DATA -->\n";
### print "<link rel='stylesheet' type='text/css' href='/style.css'
### title='style' />\n";
### {
### &PostIt0;
### }
### print "</head>\n";
### print "<body>\n";
### print "<!--START HEADER -->\n";
### {
### &PostIt1;
### }
### print "<!--FINISH HEADER -->\n";
### print "<!--START OUTER TABLE -->\n";
### {
### &PostIt2;
### }
### rint "<!--FINISH LEFT TABLE -->\n";
### print "<!--START MIDDLE TABLE -->\n";
### {
### &PostIt3;
### }
### print "<!--START BODY CONTENT -->\n";
### print "<!--START INNER MIDDLE TABLE -->\n";
### print "<table width='100%' bgcolor='#6b736b' border='0'>\n";
### print "<tr><td align='center'>\n";
### print "<form method='POST' action='category.cgi?display=form'>\n";
### print "<p align='center'> <select size='1' name='category'>\n";
### print "<option value='NULL..Category' selected>Quick Jump To</option>\n";
### print "<option value='/'>Main</option>\n";
### print "<!--CATEGORY OPTIONS-->\n";
### print "</select><input type='submit' value='GO' name='B1'></p>\n";
### print "</form>\n";
### print "<h5 align='center'>[<a href='$add_url'>Add</a>] [<a
### href='/cgi-bin/0/warrior_links0/main.cgi'>Search</a>] </h5>\n";
### print "<p>!INSERT!</p>\n";
### print "</td></tr>\n";
### print "</table></td></tr>\n";
### print "</table></td>\n";
### print "<!--FINISH INNER MIDDLE TABLE -->\n";
### print "<!--FINISH BODY CONTENT -->\n";
### print "<!--START RIGHT TABLE -->\n";
### {
### &PostIt4;
### }
### print "<!--FINISH OUTER TABLE -->\n";
### print "<!--START FOOTER -->\n";
### {
### &PostIt5;
### }
### #print "<!--#echo
### var='LAST_MODIFIED'--> <!--#e
### cho var='DATE_LOCAL'-->\n";
### print "<!--FINISH CONTAINER TABLE -->\n";
### print "</body>\n";
### print "</html>\n";
### sub PostIt
### {
### $postit="/home/alphaudt/www/cgi-bin/0/includes/meta_data.shtml";
### open (POST,$postit) || die "can't open $postout";
### $postit="";
### while (<POST>){$postit .=$_;}
### close(POST);
### print "$postit";
### }
### sub PostIt0
### {
### $postit="/home/alphaudt/www/cgi-bin/0/includes/onmouseover.shtml";
### open (POST,$postit) || die "can't open $postout";
### $postit="";
### while (<POST>){$postit .=$_;}
### close(POST);
### print "$postit";
### }
### sub PostIt1
### {
### $postit="/home/alphaudt/www/cgi-bin/0/includes/header.shtml";
### open (POST,$postit) || die "can't open $postout";
### $postit="";
### while (<POST>){$postit .=$_;}
### close(POST);
### print "$postit";
### }
### sub PostIt2
### {
### $postit="/home/alphaudt/www/cgi-bin/0/includes/left_nav_table.shtml";
### open (POST,$postit) || die "can't open $postout";
### $postit="";
### while (<POST>){$postit .=$_;}
### close(POST);
### print "$postit";
### }
### sub PostIt3
### {
### $postit="/home/alphaudt/www/cgi-bin/0/includes/start_middle_table.shtml";
### open (POST,$postit) || die "can't open $postout";
### $postit="";
### while (<POST>){$postit .=$_;}
### close(POST);
### print "$postit";
### }
### sub PostIt4
### {
### $postit="/home/alphaudt/www/cgi-bin/0/includes/right_table.shtml";
### open (POST,$postit) || die "can't open $postout";
### $postit="";
### while (<POST>){$postit .=$_;}
### close(POST);
### print "$postit";
### }
### sub PostIt5
### {
### $postit="/home/alphaudt/www/cgi-bin/0/includes/footer.shtml";
### open (POST,$postit) || die "can't open $postout";
### $postit="";
### while (<POST>){$postit .=$_;}
### close(POST);
### print "$postit";
### }
### 1;
###
###
### The above script master0.pl ran without errors, however the script was
### way too redundant and contained no method for putting the resulting
### document into a $scaler which ultimately needs to be assigned to the
### @master in the subroutine shown above. Due to my inexperience, I needed
### to ask for help in accomplishing the talk. That's when I submitted the
### above script to the HRPM list and the rest is history. Jeff and Chris,
### thanks a million for your help and your professional approach to the
### request. I will see to it that full credit is given to all who contribute.
###
###
###5. After submitting the above master0.pl script to the HRPM list, I was given
### the following advice listed below:
###**********************************************************************************
#********Jeff Wrote***********
# Well, I have a couple of (maybe helpful) comments:
# 0. Always 'use strict'. Always. Always always always.'-w' is a good idea
# too.
# 1. Anytime you find yourself writing the same code multiple times, it's
# a good bet that you can genericize it down to one. Why not make all of
# your PostIt() subs a single sub, and pass it arguments instead?
# Something like:
# From the calling code:
#
#my $filename =
#"/home/alphaudt/www/cgi-bin/0/includes/onmouseover.shtml";
#&post_it($filename);
#
# The sub:
#
#sub post_it{
# my $filename = shift;
# open(FILE, $filename) or die "can't open $filename: $!\n";
# local $/ = undef;
# my $whole_file = <POST>;
# close(FILE) or die "Error closing $filename: $!\n";
# print $whole_file;
#}
#
# Better yet, stuff the names of your files into an array and use that
#to call the sub:
#
#my @files = qw( /home/alphaudt/www/cgi-bin/0/includes/onmouseover.shtml
#/home/alphaudt/www/cgi-bin/0/includes/meta_data.shtml
#you_get_the_idea );
#
# Then just:
#
#&post_it( $files[0] );
#&post_it( $files[1] );
#
# This lets you change everything in one neat place, if you need to.
#
#
#
# Neat recursive explanation
#2. A neat trick to slurp in the contents of a file is to make a local
#copy of the $/ variable (the input record separator, normally a
#newline). Instead of:
#
#while (<POST>){$postit .=$_;}
#
#you do:
#
# local $/ = undef;
# my $whole_file = <POST>; #slurp it all into one scalar
#
#
#3. Use here documents for printing multiple lines. Instead of:
#
#print "Content-type: text/html\n\n";
#print "<head>\n";
#print "<!--START META DATA -->\n";
#
# do this:
#
#print <<END;
#Content-type: text/html
#
#<head>
#<!--START META DATA -->
#END
#
#
#
#4. The thing about saving it to a scalar is that your output is going to
#STDOUT, not your script. You can get around this by wrapping the whole
#thing in an eval{} block, like so:
#
#my $output = eval{
#
#print <<END;
#Content-type: text/html
#
#<head>
#<!--START META DATA -->
#END
#...
#&post_it( $files[0] );
#...
#&post_it( $files[1] );
#...
# };
#
#
# I'm not sure what good this does you, since you end up with the entire
#output in a scalar, but nowhere for it to go. Also keep in mind that
#this approach can consume copious amounts of memory, since you're
#stuffing everything into a variable.
#
# Reference the Camel book for more. Hope this helps.
#
# Jeff
#*********************************************************************************
#****Chris Wrote*******
#I'm going to make a couple of nits about your helpful comments. ;-) [ For
#the uninitiated, Jeff and I maintain some friendly harassment about our
#different styles of getting things accomplished in perl. TIMTOWTDI. ]
#
# 0. Always 'use strict'. Always. Always always always.'-w' is a good
# idea too.
#
#Always use '-w'. 'use strict' is usually a good idea. :-) If I'm
#writing something I'm going to throw away after one use, use strict isn't
#worth the trouble. For anything mod_perl, serious applications
#programming, anything with more than 3 functions, then always 'use
#strict'. Sometimes 'strict' is just too much of a pain. When i was doing
#lots of CGI programming and working with alternative name spaces for
#variables the program just wouldn't work under a total use strict.
#
#1. Anytime you find yourself writing the same code multiple times,
# it's a good bet that you can genericize it down to one. Why not make
# all of your PostIt() subs a single sub, and pass it arguments instead?
# Something like:
#
# From the calling code:
#
# my $filename =
# "/home/alphaudt/www/cgi-bin/0/includes/onmouseover.shtml";
# &post_it($filename);
#
#The ampersand (&) is only necessary for perl4 compatibility or creating
#references and it's basically ugly for just a plain call.
#
# The sub:
#
# sub post_it{
# my $filename = shift;
# open(FILE, $filename) or die "can't open $filename: $!\n";
# local $/ = undef;
# my $whole_file = <POST>;
# close(FILE) or die "Error closing $filename: $!\n";
# print $whole_file;
# }
#
#If you take the newline off the die it will give you the line number which
#is usually pretty helpful.
#
# Better yet, stuff the names of your files into an array and use that
# to call the sub:
#
# my @files = qw( /home/alphaudt/www/cgi-bin/0/includes/onmouseover.shtml
# /home/alphaudt/www/cgi-bin/0/includes/meta_data.shtml
# you_get_the_idea );
#
# Then just:
#
# &post_it( $files[0] );
# &post_it( $files[1] );
#
#foreach $file (@files) { post_it($file); } # :-)
#
# 3. Use here documents for printing multiple lines. Instead of:
#
# print "Content-type: text/html\n\n";
# print "<head>\n";
# print "<!--START META DATA -->\n";
#
# do this:
#
# print <<END;
# Content-type: text/html
#
#<head>
# <!--START META DATA -->
# END
#
#You can also just let your data be a big quoted string:
#
#print 'Content-type: text/html
#
#<head>
#<!--START META DATA -->
#';
#
#I used single quotes in this case and I recommend doing so by default. If
#you need interpolation you can switch to double quotes and escape all the
#bad characters.
#
#--
#</chris>
#
#There are two ways of constructing a software design. One way is to make
#it so simple that there are obviously no deficiencies. And the other way
#is to make it so complicated that there are no obvious deficiencies.
# - - C.A.R. Hoare
#*************************************************************************
#********Jeff Wrote***********
# When i was doing
# lots of CGI programming and working with alternative name spaces for
# variables the program just wouldn't work under a total use strict.
#
#I might agree more with this, but Perl 5.6 introduced 'our', which lets
#you declare a variable as global and still maintain the lexical scoping
#requirements of the strict pragma. I use to complain loudly about having
#to write things like $Foo::var in order to 'use strict', but now it's
#just an issue of how lazy you want to be.
#
#
# The ampersand (&) is only necessary for perl4 compatibility or creating
# references and it's basically ugly for just a plain call.
#
#Okay, in this case I agree.
#
# If you take the newline off the die it will give you the line number which
# is usually pretty helpful.
#
#Also cool.
#
#
# Better yet, stuff the names of your files into an array and use that
# to call the sub:
#
# my @files = qw( /home/alphaudt/www/cgi-bin/0/includes/onmouseover.shtml
# /home/alphaudt/www/cgi-bin/0/includes/meta_data.shtml
# you_get_the_idea );
#
# Then just:
#
# &post_it( $files[0] );
# &post_it( $files[1] );
#
# foreach $file (@files) { post_it($file); } # :-)
# Bzzzzt! He wanted to incorporate other data between the output of each
#sub. Here, you are running the outputs together, which doesn't do what
#he was looking for.
#
#
# print 'Content-type: text/html
#
# <head>
# <!--START META DATA -->
# ';
#
# I used single quotes in this case and I recommend doing so by default. If
# you need interpolation you can switch to double quotes and escape all the
# bad characters.
#
#This is also cool, but I was trying to give him the option of
#interpolating the output of the subs as scalars so the whole page could
#be printed at once. Using single quotes increases the number of print
#statements by the number of subs, which I consider ugly.
#
#Having said all that, I would probably take another approach to
#generating the content in any case, pulling in the HTML from somewhere
#else and using pure Perl to automagically glue it all together.
#TIMTOWTDI.
#
# Jeff
#************************************************************************************
###
###
###
###
###
###
###
###*******Below is the revised version of the master0.pl that I am working
###*******on now. The script executes with no errors, however, the output is
###*******not correct because the subroutine is failing and the scalers are
###*******not returning the values in the resulting document.
###*******the below script can be called from the url below, but it does
###*******not produce the desired output yet:
###*******http://www.udtseals.com/cgi-bin/0/warrior_links0/templates/master1.pl
###*******
###*******
###****************ANY ADVICE ON OBVIOUS FLAWS IN THE CODE BELOW WOULD BE
###****************HELPFULL. I will be away from computers for until after
###****************Labor day. I am going on my yearly retreat. Gonna get
###****************freaky with nature up in michigan..Going camping....
###****************Thanks ahead of time for all your help and expertise.
###****************I will continue work on this program on Sep. 05, 2000
#######################################################################################
#######################################################################################
'
@files = qw
(/cgi-bin/0/includes/meta_data.shtml,/cgi-bin/0/includes/onmouseover.shtml,/cgi-bin/0/includes/header.shtml,/cgi-bin/0/includes/left
_nav_table.shtml,/cgi-bin/0/includes/start_middle_table.shtml,/cgi-bin/0/includes/right_table.shtml,/cgi-bin/0/includes/footer.shtml
);
my $output = eval{
print Content-type: text/html
<head>
<!--START META DATA -->
END
&post_it( $files[0] );
<!--END META DATA -->
<link rel='stylesheet' type='text/css' href='/style.css' title='style' />
&post_it( $files[1] );
</head>
<body>
<!--START HEADER -->
&post_it ( $files[2] );
<!--FINISH HEADER -->
<!--START OUTER TABLE -->
&post_it ( $files[3] );
<!--FINISH LEFT TABLE -->
<!--START MIDDLE TABLE -->
&post_it ( $files[4] );
<!--START BODY CONTENT -->
<!--START INNER MIDDLE TABLE -->
<table width='100%' bgcolor='#6b736b' border='0'>
<tr><td align='center'>
<form method='POST' action='category.cgi?display=form'>
<p align='center'> <select size='1' name='category'>
<option value='NULL..Category' selected>Quick Jump To</option>
<option value='/'>Main</option>
<!--CATEGORY OPTIONS -->
</select><input type='submit' value='GO' name='B1'></p>
</form>
<h5 align-'center'>[<a href='/cgi-bin/0/warrior_links0/add.cgi'>Add</a>] [<a
href="/cgi-bin/0/warrior_links0/main.cgi">Search</a>] </h5>
<p>!INSERT!</p>
</td></tr>
</table></td></tr>
</table></td>
<!--FINISH INNER MIDDLE TABLE -->
<!--FINISH BODY CONTENT -->
<!--START RIGHT TABLE -->
&post_it ( $files[5] );
<!--FINISH OUTER TABLE -->
<!--START FOOTER -->
&post_it ( $files[6] );
<!--FINISH CONTAINER TABLE -->
</body>
</html>
while (<POST>){$postit .=$_;}
print "$file";
sub post_it{
my $files = shift;
open(FILE, $files) or die "can't open $files: $!\n";
local $/ = undef;
my $file = <POST>;
close(FILE) or die "Error closing $files: $!\n";
print $file;
}
}
';"
More information about the Norfolk-pm
mailing list