#!/usr/bin/perl -w ############################################################################## ## smiley's Random Text Displayer ## ## I found these scripts by doing a google search on "random text perl" ## and modified them to fit my needs. I have preserved the original ## copyright information, because it seemed the right thing to do at the ## time. I have made significant changes to the script because the ## original was written to display one whole line of text at random ## from a file containing many lines of text, and I wanted to return ## a random record from a database, and format that record to appear in ## name-value pairs in the final HTML. ## ## To distinguish between the comments in the original source, and the ## comments I've changed/added, my comments have a double hash ## ## at the beginning of the line. ## ## This script is free: If you find it and like it and decide to ## use it as is, or to make modifications and then use it, I promise not ## to come after you and sue you at some later date. I can't offer you ## the same protections from the other authors; you'll have to look into ## that yourself if it's a concern to you. ## ## If you do have a question or problem, you can find me at ## http://www.malachiarts.org/~smiley or just mail me at ## ## nd47rmb02@sneakemail.com ## ## cheers, ## ## Steve Glista ## ## 9/1/2003 ## ## ############################################################################## # nms Random Text Displayer Version 1.00 (cvs v1.9) # # Copyright 2001 London Perl Mongers All rights reserved # # Created 11/11/01 Last Modified 03/27/02 # # Matt's Script Archive: http://www.scriptarchive.com/ # ############################################################################## # nms Random Text Displayer has been created as a drop in replacement for # # the Random Text Displayer found at Matt's Script Archive. Both the # # original and nms versions of this script can be found at the above URL. # # Support for nms Random Text Displayer is available through: # # nms-cgi-support@lists.sourceforge.net # ############################################################################## # # $Id: rand_text.pl,v 1.9 2002/03/27 20:36:40 davorg Exp $ # use strict; use CGI qw(:standard); use vars qw($DEBUGGING $done_headers); # Configuration # # $DEBUGGING must be set in a BEGIN block in order to have it be set before # the program is fully compiled. # This should almost certainly be set to 0 when the program is 'live' # BEGIN { $DEBUGGING = 0; } ## tell the file where to find the random data my $random_file = 'food.csv'; ## and how different fields are demarked. in this case it's a newline my $delimiter = "%%\n"; # End configuration # We need finer control over what gets to the browser and the CGI::Carp # set_message() is not available everywhere :( # This is basically the same as what CGI::Carp does inside but simplified # for our purposes here. # ## note from smiley- this looks like error-handling code which i could ## probably get rid of now that things work right. but i'll leave it in ## in case i need to change things at some later date BEGIN { sub fatalsToBrowser { my ( $message ) = @_; if ( $main::DEBUGGING ) { $message =~ s//>/g; } else { $message = ''; } my ( $pack, $file, $line, $sub ) = caller(1); my ($id ) = $file =~ m%([^/]+)$%; return undef if $file =~ /^\(eval/; print "Content-Type: text/html\n\n" unless $done_headers; print < Error

Application Error

An error has occurred in the program

$message

EOERR die @_; }; $SIG{__DIE__} = \&fatalsToBrowser; } ## declare locals so compiler doesn't get pissed off my $food = ''; my $header = ''; my $value = ''; my $answer = ''; open(FOOD, $random_file) or die "Can't open $random_file: $!\n"; ## store all lines ## my @food = ; ## close file cause we don't need it anymore ## close(FOOD); ## pull first line containing category headers off of the array: $header = shift @food; ## set list separator to something that will display nice ## $, = ":"; ## and list each header as an array element my @header = split /\t/, $header; ## choose one entry randomly from remaining array ## and split on the tab to proper vals:## my @value = split /\t/, $food[rand (@food)]; ## this next bit was a break point, to make sure that things ## were working up till now- allowed you to run the script ## from the command line: ## make sure arrays have correct values ## print @header; ## print @value; ## and then since it works, you can combine name/value pairs foreach my $i (0..@header-1) { $answer .= "$header[$i]:$value[$i]
\n"; }; ##and print it to the browser print header(-type => 'text/html'); print $answer;