Press "Enter" to skip to content

Posts published in “PERL code snippets”

Check web page contents

Another simple script I’ve written and use often (actually runs via cron every 5 minutes) to verify the contents of a particular page to determine of it has changed for any reason like a webserver cracked/hacked or if the dynamic content is not what is expected.

In this case it is specifically monitoring a page from a PeopleSoft application that I do not entirely trust, if the content doesn’t match my checksum that generally means the Tuxedo application server is hosed and needs to be restarted.

Easily adapted to fit your particular needs, is use it on all of my public websites that are on shared hosting accounts etc…

Comments for bigger sections are thrown in to give you an idea of what to tweak for your needs, remember to update $file2 with a new copy of the markup if you modify the landing page you are monitoring!

[code]
#!/pshome/usr/local/bin/perl

# This just checks what the current working directory is,
# if dev or test then set the debug flags to on…etc.
unshift(@INC, “/pshome/psmgr/bin”);
unshift(@INC, “/pshome/psmgr/bin.test”) if (“/pshome/psmgr/bin.test” eq “$ENV{‘PWD’}”);
unshift(@INC, “/pshome/psmgr/stat/bin”) if (“/pshome/psmgr/stat/bin” eq “$ENV{‘PWD’}”);
require sr;

$debug = 1;
$debug = 1 if (“/home/bin.test” eq “$ENV{‘PWD’}”);
$debug = 1 if (“/home/stat/bin” eq “$ENV{‘PWD’}”);
$execute = 1;

$file1 = “/home/files/sitename.tmp”;
$file2 = “/home/files/sitename_known_good.txt”;
$url = “https://yoursite.com/psc/hrmsext/EMPLOYEE/HRMS/c/ROLE_APPLICANT.ER_APPLICANT_HOME.GBL?&”;
$url = “https://yoursite.com/psc/test/EMPLOYEE/HRMS/c/ROLE_APPLICANT.ER_APPLICANT_HOME.GBL” if (“/pshome/psmgr/bin.test” eq “$ENV{‘PWD’}”);
$url = “https://yourseite.com/psc/test/EMPLOYEE/HRMS/c/ROLE_APPLICANT.ER_APPLICANT_HOME.GBL” if (“/pshome/psmgr/stat/bin” eq “$ENV{‘PWD’}”);
$restarting = “/pshome/psmgr/files/careers.restarting”;
$restartingold = “/pshome/psmgr/files/careers.restarting.old”;
$check = “0”;

# check to see if the restart is already in progress so we don’t interrupt it
# likely a cleaner way to do this, but it works for now!
if (-e $restarting) { # check if restart file exists
print “Restart file exists, servers may be restarting, check again in 5 minsn”;
print “Renaming file and Exitingn”;
$cmd = “mv $restarting $restartingold”;
print “$cmdn” if ($debug);
system ($cmd) if ($execute);
exit;
} #end if restart file exists

if (-e $restartingold) { # check if restarting.old file still exists
print “Restarting file existed for at least 5 mins, servers should be back up, rechecking”;
print “Remove restart filen”;
$check = “1”;
$cmd = “rm $restartingold”;
print “$cmdn” if ($debug);
system ($cmd) if ($execute);
} #end if restarting.1 file exists

$cmd = “wget -b –no-check-certificate –output-document=$file1 $url”;
print “$cmdn” if ($debug);
system ($cmd) if ($execute);

$cmd = “sleep 15”;
print “$cmd – sleeping 15 secs to allow complete xfer of filen” if ($debug);
system ($cmd) if ($execute);

$diff1=`cksum $file1`;
$diff2=`cksum $file2`;
$diff1value = substr($diff1, 0, 9);
$diff2value = substr($diff2, 0, 9);

print “diff1value = $diff1valuen” if ($debug);
print “diff2value = $diff2valuen” if ($debug);

if ($diff1value != $diff2value) {
&notifydown;
&repair;
&cleanup;
exit;
} else {
print “Files match, this site is up!n”;
&cleanup;
print “check = $checkn” if ($debug);
if ($check == “1”) { #check if recovering from restart
¬ifyup;
} # end check if recovered from restart
exit;
}

sub notifydown
{
print “This site appears to be down, sending page and emailn” if ($debug);
&sr::send_email($debug,”Site Down!”,”Site is down, restarting app servers now!”,”David Cochran”);
&sr::send_page($debug,”Careers site is down, restarting app servers now!”,”David Cochran”);
} # end sub notifydown

sub repair
{ # restart HRMSEXT App servers
$cmd = “mv $file1 $restarting”;
print “$cmdn” if ($debug);
system ($cmd) if ($execute);
$cmd = “/commands to restart the application server go here”;
print “$cmdn” if ($debug);
system ($cmd) if ($execute);
} #end sub repair

sub cleanup
{ # cleanup temp files
$cmd = “rm -f wget-log*”;
print “$cmdn” if ($debug);
system ($cmd) if ($execute);
$cmd = “rm -f $file1”;
print “$cmdn” if ($debug);
system ($cmd) if ($execute);
} #end sub cleanup

sub notifyup
{
print “site is back up, sending page and email.n” if ($debug);
&sr::send_email($debug,”site is OK!”,”Careers site is OK.”,”David Cochran”);
&sr::send_page($debug,”Careers site is back up”,”David Cochran”);
} # end sub notifyup
[/code]

Checking SSL Certificate expiration dates

Managing a lot of SSL certificates? Hate being surprised when they expire on you and break your web site? How about a simple process to notify you in advance?

All of the above sound about right? It does to me, I literally manage close to 100 web sites that require SSL encryption for sensitive data transfers, it seems almost impossible to get and keep them all lined up for expiration dates. Even when they were something new would come along and mess up the rotation, in short order it looks like a shotgun blast to a calendar was the deciding factor.

Here is an easy perl script I wrote to check the dates of existing SSL certs, it gets the URL list to check from certs.urls, compares the certificate expiration date to the current date and send emails at the specified intervals. Pretty simple, but like most, it’s very effective when run daily via cron.

I’ve edited some of the partially confidential stuff out, but not enough to render the script unusable by any means, just set the email.sr to your local email faciltiy.

[code]
#! /usr/local/bin/perl
#
# check_ssl_expire.pl, v 0.01
#
# Inital version – Dave Cochran 9/13/07
###########################################################
use Switch;
use Time::Local;

unshift(@INC, “/pshome/psmgr/bin”);
unshift(@INC, “/pshome/psmgr/bin.test”) if (“/pshome/psmgr/bin.test” eq “$ENV{‘PWD’}”);
unshift(@INC, “/pshome/psmgr/stat/bin”) if (“/pshome/psmgr/stat/bin” eq “$ENV{‘PWD’}”);
require sr;

$debug = 0;
$debug = 1 if (“/pshome/psmgr/bin.test” eq “$ENV{‘PWD’}”);
$debug = 1 if (“/pshome/psmgr/stat/bin” eq “$ENV{‘PWD’}”);
$execute = 1;

$path = “/pshome/tmp”;
@urls = `cat /pshome/psmgr/files/cert.urls`;

foreach $url (@urls) { # start for each url
chomp $url;
print “nChecking $urln”;
$cmd = “echo “” | openssl s_client -connect $url:443 > $path/certificate”;
print “nn $cmdnn” if ($debug);
system ($cmd) if ($execute);

$cmd = “openssl x509 -in $path/certificate -noout -enddate > $path/outdate”;
print ” $cmdnn” if ($debug);
system ($cmd) > $result if ($execute);

open (OUTDATE, “/pshome/tmp/outdate”) || die “couldn’t open the file!”;
$enddate = ;
chomp $enddate;
close(OUTDATE);
print “SSL enddate is: n” if ($debug);
$expire = substr($enddate, 9, 20);
print “Expire date : n” if ($debug);
$month = substr($expire, 0, 3);
$day = substr($expire, 4, 2);
$year = substr($expire, 16, 4);

switch (“$month”)
{
case “Jan” { $month = 0 }
case “Feb” { $month = 1 }
case “Mar” { $month = 2 }
case “Apr” { $month = 3 }
case “May” { $month = 4 }
case “Jun” { $month = 5 }
case “Jul” { $month = 6 }
case “Aug” { $month = 7 }
case “Sep” { $month = 8 }
case “Oct” { $month = 9 }
case “Nov” { $month = 10 }
case “Dec” { $month = 11 }
else { print “$month is not a valid month. You have problems!n” }
} # end switch on month
$day =~ s/ /0/;
$expire_date = timegm(1,0,0,$day,$month,$year – 1900);
$today = `date +%Y%m%d`;
chomp $today;
$today = timegm(1,0,0,`date +%d`,`date +%m` -1,`date +%Y` – 1900);
$thirty_days = $today + (86400 * 30);
$fifteen_days = $today + (86400 * 15);
$seven_days = $today + (86400 * 7);
$one_day = ($today + 86400);

print “Today is and the cert expires on n” if ($debug);
print “1 day is n” if ($debug);
print “7 days is n” if ($debug);
print “15 days is n” if ($debug);
print “30 days is n” if ($debug);

$subject = “$url certificate expiration”;
if ($today > $expire_date) { # start if the certificate is expired
&sr::send_page($debug,”$url cert expired”,’Paul Hofmann’,’David Cochran’);
$message = “The $url certificate is expired”;
print “t$messagen”;
&sr::send_email($debug,$subject,$message,’David Cochran’);
} # end if the certificate is expired
elsif ($one_day == $expire_date) { # start else if the certificate will expire in 1 day
&sr::send_page($debug,”$url cert expires in 1 day”,’David Cochran’);
$message = “The $url certificate will expire in 1 day”;
print “t$messagen”;
&sr::send_email($debug,$subject,$message,’David Cochran’);
} # end if the certificate will expire in 1 day
elsif ($seven_days == $expire_date) { # start else if the certificate will expire in 7 days
$message = “The $url certificate will expire in 7 days”;
print “t$messagen”;
&sr::send_email($debug,$subject,$message,’David Cochran’);
} # end if the certificate will expire in 7 days
elsif ($fifteen_days == $expire_date) { # start else if the certificate will expire in 15 days
$message = “The $url certificate will expire in 15 days”;
print “t$messagen”;
&sr::send_email($debug,$subject,$message,’David Cochran’);
} # end if the certificate will expire in 15 days
elsif ($thirty_days == $expire_date) { # start else if the certificate will expire in 30 days
$message = “The $url certificate will expire in 30 days”;
print “t$messagen”;
&sr::send_email($debug,$subject,$message,’David Cochran’);
} # end if the certificate will expire in 30 days
} # end for each url

[/code]

URLs are stored in cert.urls with no http:// prefix

[code]
blog.captivereefing.com
www.captivereefing.com
[/code]

You get the idea…

Happy hacking!

Perl MySQL Connect

Like all programing languages, there are many ways to connect to databases, this in particular shows a the simplest method, though burying the host, username and password in an include would be better for security reasons, this is effective enough for most purposes.

The only requirements for perl may be the DBD::mysql module if not already installed, this should get all the needed prerequisites that may not be present. Either download them directly from CPAN or use the interactive installer shell

[code]
$perl -MCPAN -e shell
$install DBD::mysql
[/code]

To use this example copy this code into your script, edits $username, $password, and $db_name values to suit your environment.

[code]
#Invoke the Perl Database Libraries
use DBI;

# MySQL server hostname
my $host = “mysql.serverhost.com”;

#your account username and MySQL password
my $username = “your_user”;
my $password = “your_MySQL_password”;

#Edit this to point to the database you wish to connect to
my $db_name = “your_database”;

#
#The following lines do not need to be edited
#
#put the database and server in to the connect statement
$dsn = “DBI:mysql:database=$db_name;host=$host”;

#Generate the full connect statement
$dbh = DBI->connect($dsn, $username, $password);

#run the connect statement
$self->dbh = $dbh;
[/code]

Protect your web pages – automagically with perl

After a recent incident of some piss poor script kiddie defacing one of of my websites I wote a quick and dirty little perl script to both monitor and repair things should it happen again. (thus giving me much more narrow window of server logs to check to find the exploit or whatever allowed it to happen in the first place).

Here’s how it works in a nutshell, the site’s content is completely dynamic, however the php script to generate it is static..

  • $file1 is the working page
  • $file2 is the name of the known good page
  • generate a checksum of the two files, the output will be a string of numbers followed by a character count and the filename checked.
  • compare the first 10 digits of the checksum of the returned string (adjust to suit your needs)
  • if they are different run ‘page’ (sends an email to my cell/pager) and ‘repair’ (renames the bad file appending the date/time then copies the known good file to replace the defaced one)
  • otherwise exit
  • Pretty simple, and I’m certain my code could be optimized to run a lot cleaner (if you want to submit a cleaner version by all means post it in the comments!) In the interim this works.

    compare.pl
    [code]
    #!/usr/bin/perl
    ###Dave Cochran https://www.greyfuzz.com
    $file1 = “index.php”;
    $file2 = “index.good”;
    $diff1=`cksum $file1`;
    $diff2=`cksum $file2`;
    $diff1value = substr($diff1, 0, 9);
    $diff2value = substr($diff2, 0, 9);
    if ($diff1value != $diff2value)
    {
    &page;
    &repair;
    exit;
    }
    #print “no difference in file checksums.”;
    #uncomment the line above for testing
    exit;

    sub page
    {
    # sendmail routine source from http://kangry.com/topics/viewcomment.php?index=427
    use Time::localtime;
    open (OUT,”|/usr/sbin/sendmail -t”);
    print OUT “From: you@yourdomain.comn”;
    #remember to escape the @
    print(OUT “Date: “.ctime().”n”);
    print(OUT “To: email@youremailorpager.comn”);
    #remember to escape the @
    print(OUT “Subject: Index.php changed!n”);
    print(OUT “n”);
    print(OUT “index.php has been changed!n”);
    close(OUT);
    } # end sub page

    sub repair
    {
    use Time::localtime;
    use File::Copy;
    rename($file1, $file1.ctime()) || die “Cannot rename file.txt: $!”;
    copy($file2, $file1) or die “File cannot be copied.”;
    } # end sub repair
    [/code]

    This will require two perl modules Time::localtime and File::Copy which are generally installed with the perl bundle by default, if not get them from CPAN or contact your host.

    Simply run the script I called compare.pl via cron or whatever means you wish as often as you want to check the page. Personally every 5 mins works out pretty good for me.

    Feel free to use the code above as you will, modify it to suit your needs, be it to protect your web pages, files, or whatever. If you find it useful, please send $$$, or just a thanks.

    Perl file manipulation

    File Manipulation

    • Perl provides a large number of functions to perform various operations on files
    • These are very similar to the corresponding UNIX system call or command
    • See the UNIX man pages for details

    File Test Operators

    • Operates on a filename or filehandle argument (except for -t which only operates on a filehandle argument)
    • Tests associated file to determine if something is true or not about the file
    • If the argument is omitted, $_ is tested (except for -t which tests STDIN)
    • Most of these operators return 1 for True and the empty string for False, or undef if the file does not exist (except for -s which returns the file size and -M, -A and -C which return the
      file age)
    • Precedence is higher than logical and relational operators, but lower than arithmetic operators
    • For superuser, -r, -R, -w and -W always return True and -x and -X return True if ANY execute bit is set

    Example;

    [code]
    if (-e “/etc/passwd”) # Does it exist?
    {
    print (“Let’s start hacking!n”);
    }
    [/code]

    File Test Operator List

    • -r File is readable by effective uid
    • -w File is writable by effective uid
    • -x File is executable by effective uid
    • -o File is owned by effective uid
    • -R File is readable by real uid
    • -W File is writable by real uid
    • -X File is executable by real uid
    • -O File is owned by real uid
    • -e File exists
    • -z File exists and has zero size
    • -s File exists and has nonzero size (returns size in bytes)
    • -f File is a plain file
    • -d File is a directory
    • -l File is a symbolic link
    • -p File is a named pipe (FIFO)
    • -S File is a socket
    • -b File is a block special file
    • -c File is a character special file
    • -u File has its setuid bit set
    • -g File has its setgid bit set
    • -k File has its sticky bit set
    • -t Filehandle is a tty
    • -T File is a text file
    • -B File is a binary file
    • -M Modification age in days
    • -A Access age in days
    • -C Inode-modification age in days

    Stat Function

  • Returns a 13-element array of info on a file
  • stat (FILEHANDLE)
    • stat FILEHANDLE
    • stat (FILENAME)

    Useful for file info which the file test operators do not provide (such as number of links) or for finding the true mode when superuser

    – Typical use:

    ($dev, $ino, $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize, $blocks) = stat ($filename);

    $file = “toy1.c”;
    ($uid, $gid) = stat ($file) [4,5];

    Lstat Function

    • Same as the stat() function, but gives info on a symbolic link itself
    • lstat (FILEHANDLE)
    • lstat FILEHANDLE
    • lstat (FILENAME)
    • ul>

      The _ Filehandle

    • Whenever a file test operator, stat function or lstat function is used, Perl invokes the proper system call (stat(2) on UNIX) to get the required info
    • Doing a file test, stat or lstat on the special _ filehandle, causes Perl to use the existing memory cache (stat buffer) of file info from the previous file test, stat or lstat
    • -Example

      [code]
      if (-r $file && -w _)
      {
      print (“$file is both readable and writablen”);
      }
      [/code]

      The above does only one invocation of stat(2) which is more efficient than the following which causes two invocations of stat(2):

      [code]
      if (-r $file && -w $file)
      {
      print (“$file is both readable and writablen”);
      }
      [/code]

      File Name Expansion (Globbing)

    • If the string inside angle brackets is NOT a filehandle, it is interpreted as a C-Shell Filename Expansion (Globbing) pattern (versus the input operator)
    • All C-Shell globbing metacharacters are valid: *, ?, [], -, {}, ~
    • In an array context, the glob returns a list of all filenames that match (or an empty list if none match). In a scalar context, the next filename that matches is returned (or undef if there are no more matches). This is all similar to how the input operator with a filehandle works.
    • One level of scalar variable interpolation is done
    • But since indicates an indirect filehandle, use for globbing
    • -Example

      [code]
      # All files that end in c
      # Files ch1, ch2 and ch3

      $x = “*.c”;
      # All files that end in c
      [/code]

      Unlink Function

    • Removes one or more files (actually deletes links)
    • unlink (LIST)
    • unlink LIST
    • Returns the number of files successfully deleted
    • On failure $! is set to the value of errno
    • Uses unlink(2)
    • Typical use:

      [code]
      $count = unlink (“toy1.c”, “toy2.c”, “toy3.c”);

      $count = unlink ();
      [/code]

      -Example

      [code]
      #!/usr/bin/perl
      # Simple rm program

      foreach $file (@ARGV)
      {
      unlink ($file) || print (“Could not unlink $file: $!n”);
      }
      [/code]

      Rename Function

    • Renames a file
    • rename (OLDNAME, NEWNAME)
    • Returns 1 for success, 0 for failure
    • On failure $! is set to the value of errno
    • Similar to mv(1), but does NOT rename across filesystems and does not work if OLDNAME is a regular file and NEWNAME is an existing directory
    • – Typical use:
      [code]
      $status = rename (“toy1.c”, “toy2.c”);
      $status = rename (“toy1.c”, “toys/toy1.c”);
      [/code]

      Link Function

    • Creates a new hard link for a file
    • link (OLDNAME, NEWNAME)
    • Returns 1 for success, 0 for failure
    • On failure $! is set to the value of errno
    • Uses link(2)
    • – Typical use:

      [code]
      $status = link (“toy1.c”, “toy2.c”);
      [/code]

      Symlink Function

    • Creates a new symbolic (soft) link for a file
    • symlink (OLDNAME, NEWNAME)
    • Returns 1 for success, 0 for failure
    • On failure $! is set to the value of errno
    • Uses symlink(2)
    • – Typical use:
      [code]
      $status = symlink (“toy1.c”, “toy2.c”);
      [/code]

      Readlink Function

    • Reads the contents of a symbolic link file
    • readlink (FILENAME)
    • readlink FILENAME
    • Returns link contents on success, undef on failure
    • On failure $! is set to the value of errno
    • Uses readlink(2)
    • Uses $_ if FILENAME is omitted
    • – Typical use:
      [code]
      $link = readlink (“toy2.c”);
      [/code]

      Chmod Function

    • Changes the mode (permissions) of a list of files
    • chmod (LIST)
    • chmod LIST
    • Returns the number of files successfully changed
    • On failure $! is set to the value of errno
    • Uses chmod(2)
    • The first element of the list must be the numerical mode
    • – Typical use:
      [code]
      $count = chmod (0755, “toy1.c”);
      [/code]

      Chown Function

    • Changes the owner and group of a list of files
    • chown (LIST)
    • chown LIST
    • Returns the number of files successfully changed
    • On failure $! is set to the value of errno
    • Uses chown(2)
    • The first two elements of the list must be the numerical uid and gid
    • – Typical use:
      [code]
      $count = chown ($uid, $gid, );
      [/code]

      Utime Function

    • Changes the access (atime) and modification (mtime) times of a list of files
    • utime (LIST)
    • utime LIST
    • Returns the number of files successfully changed
    • On failure $! is set to the value of errno
    • Similar to touch(1)
    • The first two elements of the list must be the numerical access and modification times
    • The inode modification time (ctime) is set to the current time
    • – Typical use:
      [code]
      $count = utime ($atime, $mtime, “toy1.c”);
      [/code]

      Borrowed and reformatted from http://umbc7.umbc.edu/~tarr/perl/perl4/ch12-filemanip.html so I wouldn’t loose it.

    Perl – reading from files

    To Begin: Create a File

    Our first step is to create a file so we have something to read. Suppose we want to store a few pro wrestler’s names and some other data about them, like their crowd reaction and favorite moves. For this, we could put each wrestler on a line, and separate the wrestler’s information using a separator character (delimeter). One that is often used for separation is the pipe symbol ( | ). We will use it here to separate our data. Here is what we want to store:

    Wrestler Name, Crowd Reaction, Favorite Move
    The Rock,Cheer,Rock Bottom
    Triple H,Boo,Pedigree
    Stone Cold,Cheer,Stone Cold Stunner

    Now, we can take this data and put it in a file in a similar way. We won’t use the headings, just the wrestlers and their information:

    The Rock|Cheer|Rock Bottom
    Triple H|Boo|Pedigree
    Stone Cold|Cheer|Stone Cold Stunner

    Each wrestler has a new line for his information, and the information on each line is separated with the pipe symbol. Remember to be sure the new line is started after the last entry (hit “enter” right after the last character but don’t put anything on the new line). This is so Perl sees a “n” character at the end of each line. When we chop the lines after reading them in, this will keep the last character from being chopped instead. Just be sure there is no new data (even a space) on the new line though, or it will read it as a new line of information.

    Once it is ready, we can save it as some type of text file. We can use lots of extensions, such as .txt, .dat, or other things. However, if someone stumbles onto the file in their browser, they can easily read the contents. One thing that helps a little is to give it the same extension as your executable cgi scripts. This way, the server tries to execute the file if it is called from a browser, and should return a permission error or an internal server error. If your server executes files with the .cgi extension (ask your host, some use .pl or others instead), then save the file with that extension, like:

    wrestledata.cgi

    Once it is saved, be sure the file has the permissions set so it is readable (755 should be OK here, if you plan to write to it you may want to use 777). Once that is done, we need to make a script which will use it. For ease of writing and of having the right location for the file, we will assume the data file and script will be in the same directory. If you choose to use separate directories, be sure to make those changes.

    Opening the File

    Within our script, we will want to read the data into our script. In order to do so, we must first open the file. We do this with a command like this:

    [code]
    open(HANDLE, “FileName/Location”);
    [/code]

    The HANDLE above is something you will use to reference the file when you read from it and when you close it. The FileName/Location is the actual location of the file. Since we will have them in the same directory, we can just use the filename. If you have it in another directory, use the server path to the file. Here is how we can open our file:

    [code]
    open(DAT, “wrestledata.cgi”);
    [/code]

    Of course, you may want to assign the filename to a variable, so you could change it later more easily if you need to:

    [code]
    $data_file=”wrestledata.cgi”;
    open(DAT, $data_file);
    [/code]

    One last bit on the opening of the file. You may want to have an option to show an error if the file cannot be opened. So, we can add the “die” option to print the error to standard output. What we will do is use the open command, give the “or” option (two pipe symbols) and use the “die” routine as the option:

    [code]
    $data_file=”wrestledata.cgi”;
    open(DAT, $data_file) || die(“Could not open file!”);
    [/code]

    Reading the File

    Now we are able to read from the open file. The easiest way to do this is to just assign the contents of the file to an array:

    [code]
    $data_file=”wrestledata.cgi”;
    open(DAT, $data_file) || die(“Could not open file!”);
    @raw_data=;
    [/code]

    This will take everything from the file and toss it into the @raw_data array. Notice the use of the DAT handle for reading, with the around it. We can then use the array to grab the information later, so that we can go ahead and close the file.

    Close the File!

    We have to be sure to remember to close the file when we are done with it, so we close it with the close command:

    [code]
    close(DAT);
    [/code]

    Again, the DAT handle is used to reference the file and close it. So now we have:

    [code]
    $data_file=”wrestledata.cgi”;
    open(DAT, $data_file) || die(“Could not open file!”);
    @raw_data=;
    close(DAT);
    [/code]

    This is enough to read in the data, but if we want to make use of it we will want to pull it out of the array and do something with it.

    Now we will get the data out of the array with a loop and the split method.

    Making Use of the Data

    To make use of the data, we need a purpose. So, let’s say we want to print out a simple sentence for each wrestler in the list. We want to say the name, how the crowd might react, and the favorite move. Something like:

    When (wrestler name) is in the ring, the crowd might (reaction) when the (move) is used.

    To do this for each wrestler, we can use a loop to cycle through the content of the @raw_data array, grab the variables we want, and use them. This is commonly done with a foreach loop:

    [code]
    foreach $LINE_VAR (@ARRAY)
    {
    commands…
    }
    [/code]

    So, the $LINE_VAR is a variable to represent each line in the array. The @ARRAY will be the name of the array to loop through. For our example, we could use:

    [code]
    foreach $wrestler (@raw_data)
    {
    commands…
    }
    [/code]

    Now we need to do something inside the loop to split each line into variables we can use. Before we invoke the split though, we will want to chop the n character off the end of each line:

    [code]
    foreach $wrestler (@raw_data)
    {
    chop($wrestler);
    }
    [/code]

    Now we are ready to use the split method to create the variables we need each time through the loop. Since we used the pipe symbol as the separator, that is the character we will use to split the data. Notice that the pipe symbol needs to be escaped with a character since it is a special character in Perl:

    [code]
    foreach $wrestler (@raw_data)
    {
    chop($wrestler);
    ($w_name,$crowd_re,$fav_move)=split(/|/,$wrestler);
    }
    [/code]

    Now we can print the sentence using the variables we created, and it will print the sentence for every wrestler.

    [code]
    foreach $wrestler (@raw_data)
    {
    chop($wrestler);
    ($w_name,$crowd_re,$fav_move)=split(/|/,$wrestler);
    print “When $w_name is in the ring, the crowd might $crowd_re when the $fav_move is used.n”;
    }
    [/code]

    That little bit will get us:

    When The Rock is in the ring, the crowd might Cheer when the Rock Bottom is used.
    When Triple H is in the ring, the crowd might Boo when the Pedigree is used.
    When Stone Cold is in the ring, the crowd might Cheer when the Stone Cold Stunner is used.

    And there you have it. Of course, you probably want HTML output instead of output for the console. Also, you might want to see the entire script in one piece. So, here is a full script which should give you the same type of output, except it will be an HTML page:

    [code]
    #!/usr/bin/perl

    $data_file=”wrestledata.cgi”;

    open(DAT, $data_file) || die(“Could not open file!”);
    @raw_data=;
    close(DAT);

    print “Content-type: text/htmlnn”;
    print ““;

    foreach $wrestler (@raw_data)
    {
    chop($wrestler);
    ($w_name,$crowd_re,$fav_move)=split(/|/,$wrestler);
    print “When $w_name is in the ring, the crowd might $crowd_re when the $fav_move is used.”;
    print “
    n”;
    }

    “;
    [/code]

    Perl Substring (substr)

    Substring (substr)

    The substring function is a way to get a portion of a string value, rather than using the entire value. The value can then be used in a loop or a conditional statement, or just for its own purposes. For this one, you will probably want the general form of the function first. The function is usually set to a variable so that the variable contains the value of the substring:

    $portion = substr($string_variable, start number, length);

    Your $string_variable will be the variable from which you wish to create the substring. The start number is the character within the string from which you want to start your substring. Remember, though- the first number in a string here is zero rather than 1, so be careful when you make the count. The length above is the amount of characters you wish to take out of the string.

    So, if we had a variable named $toy with a value of “baseball”, but we wanted to get the last four characters rather than the full string, we would write something like this:

    [code]
    $toy=”baseball”;
    $value = substr($, 4, 9);
    print “All small boys love to play $toy.”;
    print “What would they play without a $value?”;
    [/code]

    Yes, the substring turns out to be “ball”. It starts at the fith character (which is 4 since the string starts with zero), and uses the next 4 characters. This function can be quite handy when you are trying to get part of a string later.

    Perl Length

    Length

    The length function simply gives you back the number of characters in a string variable. This is handy when you don’t know the value of the variable but would like to know the number of characters it has. It is useful with arrays, conditional statements, loops, and such things.

    So, if you had a variable named $gold and its value was the string “precious”, you could get the length of the string “precious” with the length function:

    [code]
    $gold=”precious”;
    $length_gold = length ($gold);
    [/code]

    Since the string “precious” has 8 characters, $length_gold variable will be 8.

    Differences between perl’s Chop & Chomp

    Chop & Chomp

    The chop function is used to “chop off” the last character of a string variable. It will remove that last character no matter what it is, so it should be used with caution. For example:

    me
    myself
    you

    If you had read the “me” line in and assigned it to a variable, say $who_am _I, the value you have for it should be:

    men

    Remembering /n is the same as a carriage return.

    The chop command would look like this (assuming we assigned “men” to a variable named $who_am_I):

    [code]
    chop ($who_am_I);
    [/code]

    Using the chop function in this case will remove the n character. However, suppose we use it on the last of the three:

    me
    myself
    you

    The “you” is the last piece of text in the file, and could be missing the newline n character if it was, for instance, typed into the file manually and the “Enter” key was not pressed afterward. If the chop command is used in such a case, it will remove the “u”, which was not intended! So code such as:

    [code]
    chop ($who_are_you);
    print “You are $who_are_you!”;
    [/code]

    This would result in the viewer seeing “You are yo!” rather than the expected result.

    Now we look at the chomp function.

    The chomp function will remove the last character of a string, but only if that character is an input record separator (the current value of $/ in Perl), which defaults to the newline (n) character. This is often used to remove the n character when reading from a file. The chomp function is much safer than the chop function for this, as it will not remove the last character if it is not n.

    Now if we run the chomp command on that last line instead, it won’t remove the “u”.

    [code]
    chomp ($who_are_you);
    print “You are $who_are_you!”;
    [/code]

    Now the viewer will see “You are you!” even if there was no n character at the end of the “you” line.

    Simple enough, each having their own purpose in a given circumstance. Chomp being more common as it’s less likely to chop off bits you wanted.

    Changing & Adding Elements in a perl array

    Changing & Adding Elements
    To change an array element, you can just access it with its list number and assign it a new value:

    [code]
    @browser = (“NS”, “IE”, “Opera”);
    $browser[2]=”Mosaic”;
    [/code]

    This changes the value of the element with the list number two (remember, arrays start counting at zero- so the element with the list number two is actually the third element). So, we changed “Opera” to “Mosaic”, thus the array now contains “NS”, “IE”, and “Mosaic”.

    Now, suppose we want to add a new element to the array. We can add a new element in the last position by just assigning the next position a value. If it doesn’t exist, it is added on to the end:

    [code]
    @browser = (“NS”, “IE”, “Opera”);
    $browser[3]=”Mosaic”;
    [/code]

    Now, we’ve added an element, “NS”, “IE”, “Opera”, and “Mosaic”.

    Splice Function

    Using the splice function, you can delete or replace elements within the array. For instance, if you simply want to delete an element, you could write:

    [code]
    @browser = (“NS”, “IE”, “Opera”);
    splice(@browser, 1, 1);
    [/code]

    You’ll see three arguments inside the () of the splice function above. The first one is just the name of the array you want to splice. The second is the list number of the element where you wish to start the splice (starts counting at zero). The third is the number of elements you wish to splice. In this case, we just want to splice one element so we have 1. The code above deletes the element at list number 1, which is “IE” (NS is zero, IE is 1, Opera is 2). So now the array has only “NS” and “Opera”, just two elements.

    If you want to delete more than one element, change that third number to the number of elements you wish to delete. Let’s say we want to get rid of both “NS” and “IE”. We could write:

    [code]
    @browser = (“NS”, “IE”, “Opera”);
    splice(@browser, 0, 2);
    [/code]

    Now, it starts splicing at list number zero, and continues until it splices two elements in a row. Now all that will be left in the array is “Opera”.

    You can also use splice to replace elements. You just need to list your replacement elements after your other three arguments within the splice function. So, if we wanted to replace “IE” and “Opera” with “NeoPlanet” and “Mosaic”, we would write it this way:

    [code]
    @browser = (“NS”, “IE”, “Opera”);
    splice(@browser, 1, 2, “NeoPlanet”, “Mosaic”);
    [/code]

    Now the array contains the elements “NS”, “NeoPlanet”, and “Mosaic”. As you can see, the splice function can come in handy if you need to make large deletions or replacements.

    Unshift/Shift
    If you want to simply add or delete an element from the left side of an array (element zero), you can use the unshift and shift functions. To add an element to the left side, you would use the unshift function and write something like this:

    [code]
    @browser = (“NS”, “IE”, “Opera”);
    unshift(@browser, “Mosaic”);
    [/code]

    As you can see, the first argument tells you which array to operate on, and the second lets you specify an element to be added to the array. So, “Mosaic” takes over position zero and the array now has the four elements “Mosaic”, “NS”, “IE”, and “Opera”.

    To delete an element from the left side, you would use the shift function. All you have to do here is give the array name as an argument, and the element on the left side is deleted:

    [code]
    @browser = (“NS”, “IE”, “Opera”);
    shift(@browser);
    [/code]

    Now, the array has only two elements: “IE” and “Opera”.

    You can keep the value you deleted from the array by assigning the shift function to a variable:

    [code]
    @browser = (“NS”, “IE”, “Opera”);
    $old_first_element= shift(@browser);
    [/code]

    Now the array has only “IE” and “Opera”, but you have the variable $old_first_element with the value of “NS” so you can make use of it after taking it from the array.

    Push/Pop

    These two functions are just like unshift and shift, except they add or delete from the right side of an array (the last position). So, if you want to add an element to the end of an array, you would use the push function:

    [code]
    @browser = (“NS”, “IE”, “Opera”);
    push(@browser, “Mosaic”);
    [/code]

    Now, you have an array with “NS”, “IE”, “Opera”, and Mosaic”.

    To delete from the right side, you would use the pop function:

    [code]
    @browser = (“NS”, “IE”, “Opera”);
    pop(@browser);
    [code]

    Now you have an array with just “NS” and “IE”.

    You can keep the value you deleted from the array by assigning the pop function to a variable:

    [code]
    @browser = (“NS”, “IE”, “Opera”);
    $last_element= pop(@browser);
    [/code]

    Now the array has only “NS” and “IE”, but you have the variable $last_element with the value of “Opera” so you can make use of it after taking it from the array.

    Chop

    If you want to take the last character of each element in an array and “chop it off”, or delete it, you can use the chop function. This comes in handy later when we are reading from a file, where we would need to chop the new line (n) character from each line in a file. For now, let’s just see how to use it. You would just write something like this:

    [code]
    @browser = (“NS4”, “IE5”, “Opera3”);
    chop(@browser);
    [/code]

    This code would take the numbers off the end of each element, so we would be left with “NS”, “IE” and “Opera”.

    Sort

    If you want to sort the elements of an array, this can come in handy. You can sort in ascending or descending order with numbers or strings. Numbers will go by the size of the number, strings will go in alphabetical order.

    [code]
    @browser = (“NS”, “IE”, “Opera”);
    sort (ascend @browser);

    sub ascend
    {
    $a $b;
    }
    [/code]

    The sub from above is a subroutine, much like what is called a “function” in other languages. We will explain that in more detail later. As you can see, the code above would sort in ascending order, so it would sort our array in alphabetical order. So, we have: “IE”, “NS”, and “Opera” as the new order. If you want it in reverse alphabetical order, you would use $b $a in place of the $a $b above. You could change the name of the subroutine to whatever you wish, just be sure you call the subroutine with the same name. This will make a bit more sense after we get to the section on subroutines and reading from files.

    Reverse

    You can reverse the order of the array elements with the reverse function. You would just write:

    [code]
    @browser = (“NS”, “IE”, “Opera”);
    reverse(@browser);
    [/code]

    Now, the order changes to “Opera”, “IE”, and “NS”.

    Join

    You can create a flat file database from your array with the join function. Again, this is more useful if you are reading and writing form files. For now, what you will want to know is that it allows you to use a delimiter (a character of your choice) to separate array elements. The function creates a variable for each element, joined by your delimiter. So, if you want to place a : between each element, you would write:

    [code]
    @browser = (“NS”, “IE”, “Opera”);
    join(“:”, @browser);
    [/code]

    This would create something like this:

    NS:IE:Opera

    Split
    The split function is very handy when dealing with strings. It allows you to create an array of elements by splitting a string every time a certain delimiter (a character of your choice) shows up within the string. Suppose we had the string:

    NS:IE:Opera

    Using the split function, we could create an array with the elements “NS”, “IE”, and “Opera” by splitting the string on the colon delimiter (:). We could write:

    [code]
    $browser_list=”NS:IE:Opera”;
    @browser= split(/:/, $browser_list);
    [/code]

    Notice in the split function that you place your delimiter between two forward slashes. You then place the string you want to split as the second argument, in this case the string was the value of the $browser_list variable. Setting it equal to @browser creates the @browser array from the split.