Manfred B. Perl

One of my most used and least understood perl snippets

2012-06-18T20:50:00.001-04:00

# ----- this perl snippet will remove any leading or trailing white spaces
# ----- all spaces in the variable will NOT be reduced to one space

my $variable =~ s/^\s*(.*\S)\s*$/$1/; # trm ld/trl whtspc

Creating a SQL Server view - part 2

2012-06-09T16:49:00.000-04:00

We'll need to present several sql commands to the server in order to create/update a view. So let's talk about what's needed to execute a query from perl on a SQL Server.

First, let's initialize the connection:

use DBI();
my $SQL_Server   = 'changeme';

my $SQL_User     = 'changeme';

my $SQL_password = 'changeme'; 

my $inputfile = @ARGV[0];

my $dbh = DBI->connect("DBI:ODBC:$SQL_Server", "$SQL_User", "$SQL_password", {PrintError => 0, RaiseError => 1}) or die "Can't connect to dev database: $DBI::errstr\n";

# ----- you can enable tracing if you'd like:

#$dbh->trace(1);;
 

# ----- My SQL Server wants a couple of settings set before executing a query, set them here.

$dbh->do("SET ANSI_NULLS ON");
$dbh->do("SET ANSI_WARNINGS ON");
 

# ----- set up the query 

my $drop_query = "USE $Database; IF  EXISTS (SELECT * FROM sys.views WHERE object_id = OBJECT_ID(N'[dbo].[$inputfile]')) DROP VIEW [dbo].[$inputfile]";
 

# ----- execute it

$dbh->do($drop_query);
 

# ----- report any errors

warn "view check terminated early by error: $DBI::errstr\n" if $DBI::err;
 

# ----- disconnect

$dbh->disconnect or warn "Error disconnecting: $DBI::errstr\n";

Creating a SQL Server view - part 1

2012-06-02T21:35:00.000-04:00

One of the things I do on a regular basis at work is query tables in databases that are identical in multiple databaseson the same instance of SQL Server. For instance, there's 30 databases with a transaction table in each database that is identical in all 30 databases. We need to create a unified view across all 30 databases that gives us the overall picture of transaction activity across the organization.

To do this, I use something like the following:

#!/usr/bin/perl

use warnings;
use strict;

use DBI();

my $database_count = 0;
my $TheView = 'ViewName'; # ----- what you'd like to call the resulting view.

my $SQL_Server = 'Fred'; # ----- your database server name here
my $user = 'barney';      # ----- your SQL Server user name goes here
my $password = 'sesame'; # ----- your SQL Server password goes here

my $query = join("", "CREATE VIEW [dbo].[", $TheView, "] AS ");
my $base_table = 'table_name'; # ----- Some Table That Exists identically In All databases

# ----- Connect to database
my $dbh = DBI->connect("DBI:ODBC:$SQL_Server", "$user", "$password", {PrintError => 0, RaiseError => 1}) or die "Can't connect to $SQL_Server database: $DBI::errstr\n"; #$dbh->trace(1);;

# ----- get list of databases to act on
my $sth = $dbh->prepare("SELECT name FROM master.sys.databases WHERE name LIKE 'DB%' ORDER BY name ASC;") or die "Can't prepare SQL statement: $DBI::errstr\n"; #$sth->trace(2, 'trace1.lis');;
$sth->execute() or die "Can't execute SQL statement: $DBI::errstr\n";
while (my $ref = $sth->fetchrow_hashref()) {

    my $DataBase = $ref->{'name'};

    # ----- get ready to munge with the next database
    if ($database_count > 0) {
        $query = join("", $query, "\nUNION ALL\n\n");
    }
    $database_count++;

    $query = join('', $query, 'SELECT ');

    # ----- Pull the column names from the master database in the SQL Server Instance
    my $dbh1 = DBI->connect("DBI:ODBC:$SQL_Server", "$user", "$password", {PrintError => 0, RaiseError => 0}) or die "Can't connect to $SQL_Server_Master database: $DBI::errstr\n"; #$dbh->trace(1);
    my $sth1 = $dbh1->prepare("SELECT name FROM master.sys.columns WHERE OBJECT_NAME(object_id) = '$base_table'") or die "Can't prepare SQL statement: $DBI::errstr\n"; #$sth->trace(2, 'trace.lis');
    $sth1->execute() or die "Can't execute SQL statement: $DBI::errstr\n";
    my $column_count = 0;
    while (my $ref1 = $sth1->fetchrow_hashref()) {

        my $column = $ref1->{'name'};

            # ---- here I put together a select query that includes every column from the table

    }
}

I plan on adding detail to the select query and the code that actually drops the view and loads the new version next time.

Loading an Excel Spreadsheet

2012-05-25T09:30:00.005-04:00

A lot of what I'll be writing about is based on code I'm using in production. It may not be the most optimized, the most "correct" or even all that elegant. But it works for me. If you're just getting started with perl, you may find this interesting.

I load a lot of data from many sources into a database for further analysis. One of the common forms of data files is an excel spreadsheet. A client's system may produce a daily log of activity, and I need to aggregate that into one place to study long term trends.

Storing the files in a sub-directory (folder to you windows users), and running a perl to load all those files into a database is an easy way to get the data where I need it. See last weeks post for the perl to cycle through all files in a sub-directory.

You'll need to add this statement after the "use strict;" statement:

use Spreadsheet::ParseExcel; 

You'll notice a couple of comments in the code about "having your way with it". Once of the things you can do is load the excel file into arrays for later fun stuff. Here's the code you can insert at either of these comments:

    my $workbook = Spreadsheet::ParseExcel::Workbook->Parse($CurrentFile);
    my($row, $col, $sheet, $WkC);
    foreach my $sheet (@{$workbook->{Worksheet}}) {

        for (my $row = $sheet->{MinRow}; defined $sheet->{MaxRow} && $row <= $sheet->{MaxRow} ; $row++) {

            for (my $col = $sheet->{MinCol}; defined $sheet->{MaxCol} && $col <= $sheet->{MaxCol} ; $col++) {

        # ----- Header Row
                if ($row == $sheet->{MinRow}) {
                    my $column_name = $sheet->{Cells}[0][$col]->{Val};
                    $FieldName[$col] = $column_name;
                } else {

                    $WkC = $sheet->{Cells}[$row][$col];
                    # ----- you could decide to skip a column
                    # ----- if there's no field name in row 1
                    # next if ( !(defined($FieldName[$col])) || ($FieldName[$col] eq '') ); # skip row if it doesn't have a header

                    # ----- cleanup any data here
                    if (($WkC) && ($WkC->Value ne '') && ($FieldName[$col] eq 'SomeSpecificFieldName')) {
                        my $temp_value =$WkC->Value;
                        $temp_value =~ s/\'/\'\'/g; # deal with stinking '

            # ----- Here we might do something interesting with each cell data

                    }

            # ----- Here we can do something interesting with every cell data

                } # end of else for row 0 handling

            } # end of column handling

            # ----- Now that you have the row loaded,
            # ----- You can do something interesting with it here

        } # end of row handling

    } # ----- end of worksheet handling

I hope you find this helpful.

Cycle through all files in a subdirectory

2012-05-18T07:56:00.000-04:00

I recently signed up for the perl Ironman challenge at http://www.enlightenedperl.org/ironman.html. I've had this blog sitting around for a long time (maybe 7 years) but never posted to it. I've been using my blog "The Red Stallion Patrol" for all my posts, but wanted to separate out my perls of wisdom. This is a cross post of an item I posted 4 days ago.

Here's the code I use to cycle through all the files in a sub-directory, make sure they exist and have a non-zero size. If this all passes, process the file. I use this pretty frequently at work to do "something interesting" with all files in a sub-directory (folder to you windows users) that may contain any number of files (probably added to daily) of a certain type.

#!/usr/bin/perl

use warnings;
use strict;

my $DIR = "/some/directory";
my $inputfile = $ARGV[0];

# ----- Go through all the files in a directory
my $InputDir = join("/", $DIR, $inputfile);
opendir (ARCHIVE, $InputDir ) or die "can't opendir ARCHIVE $InputDir: $!";
my @InputDirFiles = grep { -f }                               # select files only
                    map { "$InputDir/$_" }                    # IMPORTANT - prepend directory name
                    grep { ( $_ ne '.' ) and ( $_ ne '..' ) } # throw out dots entries
                    readdir ARCHIVE;
closedir ( ARCHIVE ) or warn "can't closedir ARCHIVE: $!";
local $, = "\n";

foreach my $CurrentFile (@InputDirFiles) {
    # ----- Does the file exist?
    (my $dev,my $ino,my $mode,my $nlink,my $uid,my $gid,my $rdev,my $size,my $atime,my $mtime,my $ctime,my $blksize,my $blocks)
            = stat("$CurrentFile");
    if (-e _) {
        printf "\t$CurrentFile exists.\n";
        if (-z _) {
            printf "\t\tIt is zero bytes\n";
            exit;
        }
        if (-s _) {
            printf "\t\tIt is $size bytes long\n";
            # ----- at this point the file exists and has size.
            #       you could open it and have your way with it.
        }
    } else {
        printf "\tDidn't find $CurrentFile\n";
        exit;
    }
    # ----- You could also wait until this point to
    #       open it and have your way with it.
}

Hello?

2012-04-28T14:22:00.002-04:00

Blogger recently reached out to me to reactivate my old blogger blog. The one I haven't ever posted to, apparently. I have a tumblr and a wordpress blog I never post to. What makes me think I'll use this one?