Code samples for Perl and Shell are provided for general examples and use.
All code is Copyright 2009, Custom Visuals, LLC
All code is Copyright 2009, Custom Visuals, LLC
cpSend.pl - Send file to Custom Visuals' FTP server.
#!/usr/bin/perl
#-------------------------------------------------------------------------------
# Copyright (c) 2006, Custom Visuals, LLC. All rights reserved.
#-------------------------------------------------------------------------------
# Author: Mike Schienle
# $RCSfile$
# $Revision$
# Orig: 2006/05/27 14:24:21
# $Date$
#-------------------------------------------------------------------------------
# Purpose: Send file to Custom Visuals' FTP server.
# History:
# Updated for -FIRSTNAME- -LASTNAME- (-USERNAME-) at -DATETIME-
#-------------------------------------------------------------------------------
# $Log$
#-------------------------------------------------------------------------------
use strict;
use warnings;
use Net::FTP;
use Carp qw/carp croak verbose/;
use Getopt::Std;
my ($usage, %opts, $dir, $help, $verbose);
$usage = qq^
$0 [-d] [-h] [-v]
d: directory
h: print this message
v: verbose
^;
getopts("d:hv", \%opts);
$dir = $opts{d} || "/tmp/-USERNAME-";
$help = $opts{h} || 0;
$verbose = $opts{v} || 0;
croak $usage if $help;
my ($ftp, $server, $login, $pass, @files, $file, $datadir);
# specify vars
$server = 'ftp.customvisuals.com';
$login = '-USERNAME-';
$pass = '-PASSWORD-';
# make sure we can get to the directory
chdir $dir
or croak "Unable to chdir $dir: $!";
print "Selecting files from $dir\n" if $verbose;
# get the list of files in the directory matching our template
@files = glob("cpCollect_????????????_????????_??????.xml*");
croak "No files to process in $dir" unless (@files);
# remote data directory
$datadir = 'data';
# connect to the server
$ftp = Net::FTP->new($server, Passive => 1, Debug => $verbose)
or croak "Could not connect to $server: $@";
print "Connected to $server\n" if $verbose;
$ftp->login($login, $pass)
or croak "Cannot login to $server ($!): ", $ftp->message;
print "Logged in to $server\n" if $verbose;
# change mode to binary since we're passing compressed data
$ftp->binary()
or carp "Unable to change to binary ($!): ", $ftp->message;
# change to the data directory
$ftp->cwd($datadir);
unless ($ftp->message =~ /successful/i) {
print "Warning - " . $ftp->message if $verbose;
print "Creating $datadir directory ...\n" if $verbose;
# make the data directory
$ftp->mkdir($datadir)
or croak "Unable to create $datadir ($!): ", $ftp->message;
# change to the data directory
$ftp->cwd($datadir)
or croak "Unable to change dir to $datadir ($!): ", $ftp->message;
}
print "Changed to $datadir\n" if $verbose;
for $file (@files) {
$ftp->put($file)
or croak "Unable to put $file ($!): ", $ftp->message;
print "Uploaded $file\n" if $verbose;
unlink $file
or carp "Unable to unlink $file: $!";
}
$ftp->quit;
PerlCompanies.pl - Set up the Perl Companies local companies list.
#!/usr/bin/perl
#-------------------------------------------------------------------------------
# Copyright (c) 2006, Custom Visuals, LLC. All rights reserved.
#-------------------------------------------------------------------------------
# Author: Mike Schienle
# $RCSfile$
# $Revision$
# Orig: 2006/06/08 23:36:06
# $Date$
#-------------------------------------------------------------------------------
# Purpose: Set up the Perl Companies local companies list.
# History:
#-------------------------------------------------------------------------------
# $Log$
#-------------------------------------------------------------------------------
use strict;
use warnings;
use CV::DB qw/DB_PW/;
use CV::Util::DB qw/DBConnect DBCroak DBCarp/;
use CV::GetPW qw/getPassword/;
use CV::CheckLoad qw/checkLoad/;
use CGI qw/*table *div/;
use CGI::Carp qw/fatalsToBrowser/;
use CGI::Pretty;
use HTML::Entities;
use HTML::FromText;
use Data::Dumper;
checkLoad();
# DBI handles
my ($dbh, $sth, $sql, $rv, $dbData);
my ($host, $user, $pass, %dbInfo);
$host = '';
$user = '';
$pass = getPassword(DB_PW(), $host, $user);
# get DBI vars and related info
%dbInfo = (
"Type" => 'mysql',
"Name" => 'PerlCompanies',
"Host" => $host,
"User" => $user,
"Pass" => $pass
);
# set up DB connection
$dbh = DBConnect(\%dbInfo) or DBCroak($dbh, "Died in Connect");
# get a CGI object
my ($q, @html);
$q = new CGI;
# text field parameters
my ($textFieldMin, $textFieldMed, $textFieldMax);
$textFieldMin = 20;
$textFieldMed = $textFieldMin * 2;
$textFieldMax = $textFieldMin * 4;
push @html, GUIStart();
my (@paramName, $param, $action);
@paramName = $q->param();
if (@paramName) {
for $param (@paramName) {
next unless ($param =~ /^action/);
if ($param =~ /DBUpsert/) {
push @html, DBUpsert();
push @html, GUISelect();
}
elsif ($param =~ /Update/) {
push @html, GUIUpsert((split /-/, $param)[1]);
}
elsif ($param =~ /Insert/) {
push @html, GUIUpsert();
}
else {
push @html, GUISelect();
}
last;
}
}
else {
push @html, GUISelect();
}
push @html, GUIEnd();
print @html;
sub GUIStart {
# field sizes
my @html;
push @html,
# display the header section
$q->header(),
$q->start_html(
{
-title => 'Perl Companies',
-author => 'Mike Schienle, mgs@customvisuals.com',
-style => {
'src'=>"http://$ENV{HTTP_HOST}/styles/PerlCompanies.css"
}
}
),
$q->start_div(
{
-align => 'center',
-class => 'PerlCompanies'
}
),
$q->p(
{
-class => 'Standout'
},
'Perl Companies'
),
$q->start_form(
-name => 'PerlCompaniesForm'
);
return @html;
}
sub GUISelect {
my (@html, $row, $type, @types, @perlTypes, $company);
$sql = qq^
SELECT *
FROM Company
ORDER BY Name
^;
$sth = $dbh->prepare_cached($sql)
or DBCroak($dbh, "Unable to prepare $sql");
$sth->execute()
or DBCroak($dbh, "Unable to execute $sql");
push @html,
$q->start_table(
{
-class => 'PerlCompanies'
}
),
$q->Tr(
{
-class => 'PerlCompanies'
},
$q->th(
{
-class => 'PerlCompanies'
},
[qw/Name Address City State Zip Types Action/]
)
);
$row = 0;
@types = qw/CGI DBI Email LWP mod_perl SOAP TK XML/;
while ($dbData = $sth->fetchrow_hashref()) {
@perlTypes = ();
for $type (@types) {
push @perlTypes, $type if $dbData->{$type};
}
$company = $dbData->{Name} || ' ';
if (defined $dbData->{URL}) {
$company = $q->a(
{
-href => $dbData->{URL}
},
$company
);
}
push @html,
$q->Tr(
{
-class => 'alternate' . (1 - ($row % 2))
},
$q->td(
{
-align => 'left'
},
$company
),
$q->td(
{
-align => 'left'
},
$dbData->{Address} || ' '
),
$q->td(
{
-align => 'left'
},
$dbData->{City} || ' '
),
$q->td(
{
-align => 'left'
},
$dbData->{State} || ' '
),
$q->td(
{
-align => 'left'
},
$dbData->{Zip} || ' '
),
$q->td(
{
-align => 'left'
},
join ', ', @perlTypes
),
$q->td(
{
-rowspan => 1 + (($dbData->{Comments}) ? 1 : 0),
-align => 'center'
},
$q->submit(
-name => 'actionUpdate-' . $dbData->{ID},
-value => 'Update'
)
)
);
if ($dbData->{Comments}) {
push @html,
$q->Tr(
{
-class => 'alternate' . (1 - ($row % 2))
},
$q->td(
{
-align => 'left',
-colspan => 6
},
$dbData->{Comments}
)
);
}
$row++;
}
push @html,
$q->end_table(),
$q->submit(
-name => 'actionInsert',
-value => 'Insert New Record'
);
return @html;
}
sub GUIUpsert {
my $id = shift || 0;
my (@html, @fields, $field);
@fields = qw/Name Address City State Zip URL CGI DBI Email LWP mod_perl
SOAP TK XML Comments/;
my %data = (
Name => '',
Address => '',
City => '',
State => '',
Zip => '',
URL => '',
CGI => 0,
DBI => 0,
Email => 0,
LWP => 0,
mod_perl => 0,
SOAP => 0,
TK => 0,
XML => 0,
Comments => ''
);
if ($id) {
$sql = qq^
select *
from Company
where ID = ?
^;
$sth = $dbh->prepare_cached($sql)
or DBCroak($dbh, "Unable to prepare $sql");
$sth->execute($id)
or DBCroak($dbh, "Unable to execute $sql");
$dbData = $sth->fetchrow_hashref();
for $field (@fields) {
$data{$field} = $dbData->{$field} if $dbData->{$field};
}
$sth->finish();
}
push @html,
$q->hidden(
-name => 'id',
-default => $id
),
$q->start_table(
{
-class => 'PerlCompanies'
}
);
for $field (@fields[0 .. 4]) {
push @html,
$q->Tr(
{
-class => 'PerlCompanies'
},
$q->th(
{
-class => 'PerlCompanies'
},
$field,
),
$q->td(
{
-class => 'PerlCompanies'
},
$q->textfield(
-name => $field,
-size => $textFieldMed,
-value => $data{$field},
-force => 1
)
)
);
}
push @html,
$q->Tr(
{
-class => 'PerlCompanies'
},
$q->th(
{
-class => 'PerlCompanies'
},
$fields[5],
),
$q->td(
{
-class => 'PerlCompanies'
},
$q->textfield(
-name => $fields[5],
-size => $textFieldMax,
-value => $data{$fields[5]},
-force => 1
)
)
);
for $field (@fields[6 .. 13]) {
push @html,
$q->Tr(
{
-class => 'PerlCompanies'
},
$q->th(
{
-class => 'PerlCompanies'
},
$field,
),
$q->td(
{
-class => 'PerlCompanies'
},
$q->checkbox(
-name => $field,
-checked => $data{$field},
-value => 'ON',
-label => $field
)
)
);
}
push @html,
$q->Tr(
{
-class => 'PerlCompanies'
},
$q->th(
{
-class => 'PerlCompanies'
},
$fields[-1],
),
$q->td(
{
-class => 'PerlCompanies'
},
$q->textarea(
-name => $fields[-1],
-rows => 4,
-columns => $textFieldMax,
-default => $data{$fields[-1]},
-force => 1
)
)
);
push @html,
$q->end_Tr(),
$q->end_table(),
$q->submit(
-name => 'actionDBUpsert',
-value => ($id == 0) ? 'Insert' : 'Update'
),
' ' x 4,
$q->reset();
return @html;
}
sub GUIEnd {
my @html;
# final elements of GUI to close off page
push @html,
$q->p(
{
-class => 'fade'
},
scalar localtime()
),
$q->end_form(),
$q->a(
{
-href => 'http://www.perl.com/'
},
$q->img(
{
-src => '/images/powered_by_perl.gif',
-width => 122,
-height => 55,
-border => 0
}
)
),
$q->br(),
$q->end_div(),
$q->end_html();
return @html;
}
sub DBUpsert {
my @html;
my %data = (
ID => $q->param('id'),
Name => $q->param('Name'),
Address => $q->param('Address'),
City => $q->param('City'),
State => $q->param('State'),
Zip => $q->param('Zip'),
URL => $q->param('URL'),
CGI => ($q->param('CGI')) ? 1 : 0,
DBI => ($q->param('DBI')) ? 1 : 0,
Email => ($q->param('Email')) ? 1 : 0,
LWP => ($q->param('LWP')) ? 1 : 0,
mod_perl => ($q->param('mod_perl')) ? 1 : 0,
SOAP => ($q->param('SOAP')) ? 1 : 0,
TK => ($q->param('TK')) ? 1 : 0,
XML => ($q->param('XML')) ? 1 : 0,
Comments => $q->param('Comments')
);
# check if we're inserting or updating
if ($data{ID} == 0) {
$sql = qq^
INSERT INTO Company
(Name, Address, City, State, Zip, URL, CGI, DBI, Email, LWP,
mod_perl, SOAP, TK, XML, Comments)
VALUES
(?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)
^;
$sth = $dbh->prepare_cached($sql)
or DBCroak($dbh, "Unable to prepare $sql");
$sth->execute($data{Name}, $data{Address}, $data{City},
$data{State}, $data{Zip}, $data{URL}, $data{CGI}, $data{DBI},
$data{Email}, $data{LWP}, $data{mod_perl}, $data{SOAP},
$data{TK}, $data{XML}, $data{Comments})
or DBCroak($dbh, "Unable to execute $sql");
push @html,
$q->h4("Inserted new record for $data{Name}");
}
else {
$sql = qq^
UPDATE Company SET
Name = ?,
Address = ?,
City = ?,
State = ?,
Zip = ?,
URL = ?,
CGI = ?,
DBI = ?,
Email = ?,
LWP = ?,
mod_perl = ?,
SOAP = ?,
TK = ?,
XML = ?,
Comments = ?
WHERE ID = ?
^;
$sth = $dbh->prepare_cached($sql)
or DBCroak($dbh, "Unable to prepare $sql");
$sth->execute($data{Name}, $data{Address}, $data{City},
$data{State}, $data{Zip}, $data{URL}, $data{CGI}, $data{DBI},
$data{Email}, $data{LWP}, $data{mod_perl}, $data{SOAP},
$data{TK}, $data{XML}, $data{Comments}, $data{ID})
or DBCroak($dbh, "Unable to execute $sql");
push @html,
$q->h4("Updated record for $data{Name}");
}
return @html;
}
pfDateCheck.pl - Try to match dates in apache log files to specified postfix date.
#!/usr/bin/perl
#-------------------------------------------------------------------------------
# Author: Mike Schienle
# $RCSfile: pfDateCheck.pl,v $
# $Revision: 1.1 $
# Orig: 2004/11/16 03:29:58
# $Date: 2004/11/17 02:32:29 $
#-------------------------------------------------------------------------------
# Purpose: Try to match dates in apache log files to specified postfix date.
# History:
#-------------------------------------------------------------------------------
# $Log: pfDateCheck.pl,v $
# Revision 1.1 2004/11/17 02:32:29 mgs
# Initial entry.
#
#-------------------------------------------------------------------------------
use strict;
use warnings;
use Time::Local;
# get the postfix date from the command line
my @pfDT = @ARGV;
die "Need to provide a PostFix date (i.e. Nov 13 04:41:36)"
unless @pfDT;
# month hash for date calcs
my %months = (
Jan => "01",
Feb => "02",
Mar => "03",
Apr => "04",
May => "05",
Jun => "06",
Jul => "07",
Aug => "08",
Sep => "09",
Oct => "10",
Nov => "11",
Dec => "12"
);
# postfix date range as hash for quick comparisons
my %pfRange = PostfixDateVal(join ':', @pfDT);
# directory and file variables
my ($dirLog, @dirSite, $site, $file, $line, $apacheDT);
$dirLog = $ENV{PWD};
@dirSite = <*>;
# loop through the sites in the Logs directory
for $site (@dirSite) {
# start at the Logs directory each time
chdir $dirLog
or die "Unable to chdir to $dirLog\n";
opendir(DIR, $site)
or die "Unable to open dir $site: $!";
while (defined($file = readdir(DIR))) {
# skip everything but the access_log file
next unless ($file eq "access_log");
print "Processing $site/$file ...\n";
open(FILE, "< $site/$file")
or die "Unable to open $site/$file: $!";
# lop through the access log
while () {
# hang onto the original line if we need to display it
$line = $_;
# 4th item is our date stamp
$apacheDT = (split " ", $_)[3];
# pull off leading bracket ([)
$apacheDT = substr($apacheDT, 1);
# convert string to time var
$apacheDT = ApacheDateVal($apacheDT);
# check if this time is in apache time range
if (exists($pfRange{$apacheDT})) {
printf "\nFound possible match at line %d in %s\n",
$. + 1, "$site/$file";
print "$line\n";
}
}
close(FILE)
or die "Unable to close $site/$file";
}
closedir(DIR);
}
# handle the Postfix formatted date
sub PostfixDateVal {
# +/- seconds range to check against
my $rangeSec = 2;
my $postfixDT = shift;
# split into array
my @dt = split ':', $postfixDT;
# convert month name to number
$dt[0] = $months{$dt[0]};
push @dt, (localtime())[5] + 1900;
$dt[0]--;
my $dtAdjust;
my %range;
# build the range hash
for (my $i = -$rangeSec; $i <= $rangeSec; $i++) {
$dtAdjust = timelocal(@dt[4, 3, 2, 1, 0, 5]) + $i;
$range{$dtAdjust} = 1;
}
return %range;
}
# handle the apache formatted dates
sub ApacheDateVal {
my $apacheDT = shift;
# extract pieces from string
my @dt = $apacheDT =~ m/(\d+)\/(\w+)\/(\d+):(\d+):(\d+):(\d+)/;
# convert month name to number
$dt[1] = $months{$dt[1]};
$dt[1]--;
return timelocal(@dt[5, 4, 3, 0, 1, 2]);
}