Description

This is a sample of some of my Perl code. It is a simple script which accesses two databases and compiles the data into a RSS feed. Please note: The dual database was a result of legacy data with a new system. This was intended as an intrim fix while a better application was in development.

Code Sample:

#!/usr/local/bin/perl -w

use CGI qw(:standard);
use CGI::Carp qw(fatalsToBrowser);
use DBI;
use Encode;
use XML::RSS;

use strict;
use warnings;
no warnings 'uninitialized';

use lib qw(/usr/cisco/packages/dbdoracle/9.2.0);
$ENV{ORACLE_HOME}="/usr/cisco/packages/dbdoracle/9.2.0";
$ENV{'TNS_ADMIN'} = "/auto/engweb/oracle/sqlnet";

$| = 1;

my $cgi = new CGI;

## opens the configuration file which holds the database and password
open( PRIMARY, "< ./primary.conf" )
  or die "Unable to open the configuration file for this application : $!\n";

my %primary = ();

while () {
   chomp;      # remove newline
   s/#.*//;    # remove comments
   s/^\s+//;   # remove leading whitespace
   s/\s+$//;   # remove trailing whitespace
   next unless length;   # is there anything left?
   my ($var, $value) = split(/\s*[ ]+\s*/, $_, 2);
   $primary{$var} = $value;
}

## opens the configuration file which holds the database and password
open( SECONDARY, "< ./secondary.conf" )
  or die "Unable to open the configuration file for this application : $!\n";

my %secondary = ();

while () {
   chomp;      # remove newline
   s/#.*//;    # remove comments
   s/^\s+//;   # remove leading whitespace
   s/\s+$//;   # remove trailing whitespace
   next unless length;   # is there anything left?
   my ($var, $value) = split(/\s*[ ]+\s*/, $_, 2);
   $secondary{$var} = $value;
}

## Open the database connections
my $dbh1 = primary_connect();
my $dbh2 = secondary_connect();

## Global variables
my $event_id;
my $event_title;
my $event_location;
my $event_start_date;
my $event_ext_int;
my $event_status;
my $date_from;
my $date_to;

print $cgi->header( 'text/xml' );

## Initialize the RSS Object
my $rss = new XML::RSS (version => '2.0');

## Call the two functions to populate the data into RSS 2.0 schema
build_xml_header();
build_xml_body();

## Print the results
print $rss->as_string;

## Save a file, just in case
$rss->save("upcoming_events.xml");

## Close the database connections
primary_disconnect( $dbh1 );
secondary_disconnect( $dbh2 );

exit;  ## kthxbye


################################
#
# build_xml_header
#
#

sub build_xml_header {

  ## Query the second database for dates
  my $sth2 = $dbh2->prepare( qq{
select to_char( sysdate, 'mm-dd-yyyy' ), to_char( sysdate + 31, 'mm-dd-yyyy' )
from dual
  } );

  $sth2->execute() or die "Can't prep statement: $DBI::errstr\n";

  ( $date_from, $date_to ) = $sth2->fetchrow_array();

  ## Once all the details are finalized, they'll go here
  ## A sysdate needs to be added to the pubDate field
  $rss->channel(
    title          => 'Upcoming Internal/External Events',
    link           => '',
    language       => 'en',
    description    => 'Upcoming Approved, Verified and Cancelled events.',
    rating         => '',
    copyright      => 'Cisco Systems, Inc',
    pubDate        => 'Thu, 23 Aug 1999 07:00:00 GMT',
    lastBuildDate  => 'Thu, 23 Aug 1999 16:20:26 GMT',
    docs           => '',
    managingEditor => '',
    webMaster      => ''
  );

  ## When an image is ready, it'll go here
  $rss->image(
    title       => '',
    url         => '',
    link        => '',
    width       => 88,
    height      => 31,
    description => ''
  );

}

################################
#
# build_xml_body
#
#

sub build_xml_body {

  ## Query the database for all the event information within the last 31 days
  ## Only return events which are Approved, Verified or Cancelled
  my $sth2 = $dbh2->prepare( qq{
select uei.event_id,
       uei.event_title,
       to_char( uei.event_startdate, 'mm-dd-yyyy' ),
       uei.event_location, uei.event_extint_flag,
       uei.event_status,
       to_char( sysdate, 'mm-dd-yyyy' ),
       to_char( sysdate + 31, 'mm-dd-yyyy' )
from u_event_info uei
where uei.event_startdate > sysdate
  and uei.event_startdate < sysdate + 31
  and (
      uei.event_status = 'Approved' or
      uei.event_status = 'Verified' or
      uei.event_status = 'Cancelled'
  )
order by uei.event_startdate
  } );

  $sth2->execute() or die "Can't prep statement: $DBI::errstr\n";

  ## Truncated this line so it would fit into the dimensions of the code sample :D
  while( ( $event_id, $event_title, $event_start_date, $event_location,
           $event_ext_int, $event_status ) = $sth2->fetchrow_array() ) {

    ## Condense the event locations into a more concise format
    if( $event_location eq "Building 3, New Frontier Conference Room" ) {
      $event_location = "SJC3-2 New Frontier";
    }
    elsif( $event_location eq "Building C, 1st Floor Darling Conference Room" ) {
      $event_location = "SJCC-1 Darling";
    }
    elsif( $event_location eq "Mobile Production Services" ) {
      $event_location = "Mobile Service";
    }

    ## Clean-up the data and special characters from iso-8859-1 to UTF-8
    my $title_old = decode( "iso-8859-1", $event_title );
    my $title_new = encode( "UTF-8", $title_old );

    ## Clean-up the rest of the special characters
    $title_new =~ s/[^A-Za-z0-9_.,&:\s\"\-\/\\\@]//g;
    $title_new =~ s/\&/\&\;/g;
    $title_new =~ s/\/\>\;/g;
    $title_new =~ s/\"/\"\;/g;
    $title_new =~ s/\'/\"\;/g;

    ## Append the data
    $rss->add_item(
      title => "$title_new ($event_start_date) ($event_id)",
      permaLink  => "http://wwwin-enged.cisco.com",
      description => "$event_location",
      category => "$event_status - \u$event_ext_int\E",
    );

  }
}

################################
#
# primary_connect
#
#

sub primary_connect {

  my $dsn;
  my $userName;
  my $password;

  if( $primary{ useProductionDatabase } eq "true" ) {
    $dsn      = $primary{ productionDSN };
    $userName = $primary{ productionUserName };
    $password = $primary{ productionPassword };
  }

  if( $primary{ useStagingDatabase } eq "true" ) {
    $dsn      = $primary{ stagingDSN };
    $userName = $primary{ stagingUserName };
    $password = $primary{ stagingPassword };
  }

  if( $primary{ useDevelopmentDatabase } eq "true" ) {
    $dsn      = $primary{ developmentDSN };
    $userName = $primary{ developmentUserName };
    $password = $primary{ developmentPassword };
  }

  my $dbh1 = DBI->connect( "$dsn", "$userName", "$password" );
 
  if( !$dbh1 ) {
    exit;
  }
  return $dbh1;
}

################################
#
# primary_disconnect
#
#

sub primary_disconnect {
  my ( $dbh1 ) = @_;
  $dbh1->disconnect or warn "Error disconnecting from database: $DBI::errstr";
}

################################
#
# secondary_connect
#
#

sub secondary_connect {

  my $dsn;
  my $userName;
  my $password;

  if( $secondary{ useProductionDatabase } eq "true" ) {
    $dsn      = $secondary{ productionDSN };
    $userName = $secondary{ productionUserName };
    $password = $secondary{ productionPassword };
  }

  if( $secondary{ useStagingDatabase } eq "true" ) {
    $dsn      = $secondary{ stagingDSN };
    $userName = $secondary{ stagingUserName };
    $password = $secondary{ stagingPassword };
  }

  if( $secondary{ useDevelopmentDatabase } eq "true" ) {
    $dsn      = $secondary{ developmentDSN };
    $userName = $secondary{ developmentUserName };
    $password = $secondary{ developmentPassword };
  }

  my $dbh2 = DBI->connect( "$dsn", "$userName", "$password" );
 
  if( !$dbh2 ) {
    exit;
  }
  return $dbh2;
}

################################
#
# secondary_disconnect
#
#

sub secondary_disconnect {
  my( $dbh2 ) = @_;
  $dbh2->disconnect or warn "Error disconnecting from database: $DBI::errstr";
}