Install Perl CPAN modules behind a firewall

I had to install additional Perl packages using CPAN on a computer behind a firewall. The hack is to install the same version of Perl on a build computer first then copy the Perl/site folder to the destination computer as described in Cloning perl/site/lib directory?.

What's the time?

14 quick ways to find the current time on your computer.

Cmd.exe has two built-in commands for the date and time. You have to add the /t option when calling these commands otherwise you are prompted to set the system time:

> date /t
Wed 27/08/2008
> time /t
07:42 PM

GnuWin's date command prints the date, time and time zone:

> date
Wed Aug 27 19:43:23 AUS Eastern Standard Time 2008

You can use the POSIX module in Perl to get the current date and time:

> perl -e "use POSIX; print asctime(localtime());"
Wed Aug 27 19:44:21 2008

Python has a time module similar to Perl's:

> python -c "import time; print time.asctime()"
Wed Aug 27 19:48:07 2008

PHP's time and date functions return an array, which you can dump using the print_r() function:

> php -r "print_r(get_date());"
Array
(
    [seconds] => 49
    [minutes] => 34
    [hours] => 14
    [mday] => 30
    [wday] => 6
    [mon] => 8
    [year] => 2008
    [yday] => 242
    [weekday] => Saturday
    [month] => August
    [0] => 1220070889
)

Ruby has a Time class:

> ruby -e "print Time.now"
Wed Aug 27 19:45:32 +1000 2008

PowerShell has a get-date cmdlet:

> get-date
Wednesday, 27 August 2008 7:50:13 PM

Or use the .Net System.DateTime.Now property in PowerShell:

> [System.DateTime]::Now
Thursday, 28 August 2008 9:53:21 AM

Firefox can tell you the time using the Javascript Date() object. Enter the following statement in your browser's address bar:

javascript:Date()
Wed Aug 27 2008 20:11:27 GMT+1000 (AUS Eastern Standard Time)

MSIE6 has a similar object but the output is different from Firefox's:

javascript:Date()
Thu Aug 28 10:06:59 2008

Groovy (and Java) has a java.util.Date object which defaults to the current time:

new java.util.Date()
Result: Thu Aug 28 09:58:45 EST 2008

List Empty Access Tables using Perl

A port of my Python DBI program to Perl. Note that you have to install package DBD-ODBC for the ODBC driver.

use warnings;
use strict;
use DBI;

use constant MDB_PATH => '<path>';

my $dbh = DBI->connect('DBI:ODBC:DRIVER=Microsoft Access Driver (*.mdb);Dbq=' . MDB_PATH);

my $sth = $dbh->prepare(
  "SELECT name FROM MSYSOBJECTS WHERE name NOT LIKE 'MSYS%' AND type = 1");
$sth->execute();
my $ref = $sth->fetchall_arrayref();

for my $row ( @{$ref} )  {
  my $table_name = @$row[0];
  my $sth = $dbh->prepare("SELECT COUNT(*) FROM [$table_name]");
  $sth->execute();
  my @data = $sth->fetchrow_array();
  if ($data[0] == 0) {
    print "$table_name is empty\n";
  }
}

$dbh->disconnect();

See Also

• List Empty Access Tables using Python.

PS

2008-08-08: Replaced sprintf("SELECT COUNT(*) FROM [%s]", $table_name) with "SELECT COUNT(*) FROM [$table_name]" since Perl can evaluate variables in a string.

Added empty parentheses when calling functions to be consistent.

Extract Lines with Line Numbers using Gawk, Groovy, Perl, Python and Ruby

More ways to extract a block of text from a stream and prepend the line number to each line.

Below is the Gawk version. The built-in variables NR is the number of the current line and $0 is the content of the current line.

gawk "(NR >= r1 && NR <= r2) {printf("""%4d %s\n""", NR, $0)}"

The Perl and Ruby scripts are exactly the same. The built-in variable $. holds the number of the current line and $_ holds the text of the current line.

perl|ruby -ne "printf '%4d %s', $., $_ if $. >= r1 && $. <= r2"

The Groovy command line options are similar to the Perl and Ruby version, except that you have to separate -n and -e. The built-in variable count holds the number of the current line and line holds the text of the current line.

groovy -n -e "if (count >= r1 && count <= r2) out.format '%4d %s\n', count, line"

The Python version is verbose due to boilerplate code to iterate through all rows in a file:

python -c "import sys; print ''.join('%4d %s' % (r, l) for r, l in enumerate(sys.stdin) if r >= r1 and r <= r2)"

See Also

• PowerShell and Cat Extract Lines with Line Numbers

PS

2008-07-29: Added Groovy version.

Basic Perl Tk HTTP Server Monitor

Here's a port of my simple Python HTTP Server Monitor to Perl, using the Tkx module to interface with Tk. A minor difference is to use the Tk options database to specify the font of the headers in a configuration file.

# Basic HTTP Server Monitor by Kam-Hung Soh 2008.
use strict;
use warnings;
use Log::Log4perl qw(:easy);
use LWP::Simple;
use Text::CSV;
use POSIX;
use Tkx;

use constant CONFIGURATION_PATH => 'HttpServerMonitor.csv';
use constant LOG_PATH           => 'HttpServerMonitor.log';
use constant OPTION_PATH        => 'HttpServerMonitor.db';
use constant REFRESH_INTERVAL   => 60000; # Miliseconds
use constant TIME_FORMAT        => '%H:%M:%S %d-%m-%y';

sub create_widgets {
  my $logger = get_logger;
  my $app = Tkx::widget->new('.');
  Tkx::wm_title($app, 'HTTP Server Monitor');
  my $col = 0;
  for my $text ('Name', 'Host', 'Port', 'Status', 'Last Check') {
    $app->new_label(-name => 'header' . $col, -text => $text)
      ->g_grid(-row => 0, -column => $col, -padx => 2, -pady => 2);
    $col++;
  }

  my $row = 1;
  my $csv = Text::CSV->new;
  open CSV, "<", CONFIGURATION_PATH;
  ; # Skip header row
  while () {
    $logger->debug('$. = ' . $.);
    if ($csv->parse($_)) {
      my @field = $csv->fields;
      $col = 0;
      for my $s (@field) {
        $app->new_label(-text => $s)
          ->g_grid(-row => $row, -column => $col, -padx => 2, -pady => 2, -sticky => 'W');
        $col++;
      }
      my ($name, $host, $port) = @field;
      my $key = $host . ':' . $port;
      $::status_label{$key} = $app->new_label(-background => 'yellow', -text => 'unknown');
      $::status_label{$key}->g_grid(-row => $row, -column => $col, -padx => 2, -pady => 2, -sticky => 'W');
      $::time_label{$key} = $app->new_label(-text => strftime TIME_FORMAT, localtime);
      $::time_label{$key}->g_grid(-row => $row, -column => $col+1, -padx => 2, -pady => 2, -sticky => 'W');
    }
    $row = $.;
  }
  close CSV;

  $app->new_button(-text => "Refresh", -command => \&refresh)
    ->g_grid(-row => $row, -column => 4, -padx => 2, -pady => 2, -sticky => 'E');
}

sub refresh {
  my $logger = get_logger;
  for my $key (keys %::status_label) {
    my $url = 'http://' . $key;
    $logger->debug($url);
    if (head $url) {
      $::status_label{$key}->configure(-background => 'green', -text => 'up');
    } else {
      $::status_label{$key}->configure(-background => 'red', -text => 'down');
    }
    $::time_label{$key}->configure(-text => strftime TIME_FORMAT, localtime);
  }
  Tkx::after(REFRESH_INTERVAL, \&refresh);
}

Log::Log4perl->easy_init($INFO);
my $logger = get_logger;
$logger->info('Start');
Tkx::option_readfile(OPTION_PATH);
create_widgets;
refresh;
Tkx::MainLoop;
$logger->info('Finish');

This script reads a list of servers in CONFIGURATION_PATH to monitor from a CSV file with three columns, the display name, the host name and the port, such as the one below:

Name,Host,Port
Google,google.com.au,80

When the script starts, it reads Tk widget configuration from an Xdefaults-style file in OPTION_PATH, such as the one below. Note that according to Options and Tk - A Beginner's Guide, you can't set grid options (that's why the script is peppered with padx and pady options).

*header0.font : -size 10 -weight bold
*header1.font : -size 10 -weight bold
*header2.font : -size 10 -weight bold
*header3.font : -size 10 -weight bold
*header4.font : -size 10 -weight bold

The Tk configuration file is more verbose than I expected. Each widget in Tk belongs in a container, containers can be members of other containers, and all widgets belong to a root container (similar to a file system). In each line of a Tk configuration file, you specify the path to a widget (all text up to the last dot), the option (the text between the last dot and colon) and the value to use (the text after the column).

!---- pathname ---+ +option+     +----- value -------+
application.header0.font       : -size 10 -weight bold

You can use an asterisk in the widget pathname if you don't care about the container of the widget. However, there's no wildcard for the widget's name, so in this case, I have to enumerate each widget that I want to configure.

See Also

• Python HTTP Server Monitor
• Options and Tk - A Beginner's Guide

Extract Columns From Tabular Text - Perl and Ruby

My previous posting described using the GnuWin cut command to extract columns from tabular text data but you couldn't specify columns relative to the last column. The cut command is pretty easy to use in a command console, so if you want to overcome this limitation without too additional effort, you could write an ad-hoc script using Perl or Ruby programming languages.

A Perl solution: perl -F <delimiter> -ane "print @F[-1]".

A Ruby solution: ruby -F <delimiter> -ane "print $F[-1]".

Both Perl and Ruby have the same command line switches for splitting lines: -n makes the interpreter iterate through all lines of input for the statement specified in the -e switch, the -a switch turns on the auto-split mode and -F changes the character used to split a line.

All columns in a record are collected in the global F array. For example, you extract column two using @F[1] (Perl) or $F[1] (Ruby). To extract the last column in a record, use $F[-1].

See Also

• PowerShell and Python versions
• Cut command version
• Gawk version