Documenting Problems That Were Difficult To Find The Answer To

Category Archives: Perl

A Utility to Convert Date Formats

The following Perl script converts from various forms to various forms:

#!/usr/bin/perl -w

use Time::Local;
use Date::Parse;

use strict;

sub help {
  print( STDERR " - Utility for converting date formats\n" );
  print( STDERR "\n" );
  print( STDERR "Enter a date in one of the following formats:\n" );
  print( STDERR "  epoch: 1526615052 - time in seconds past 1 Jan 1970 UTC\n" );
  print( STDERR "  javaepoch: 1526615092916 - time in ms past 1 Jan 1970 UTC\n" );
  print( STDERR "\n" );

sub display_time {
  my ( $epoch ) = @_;

  printf( "\n" );

  my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);

  my @ltime = localtime( $epoch );
  my @gtime = gmtime( $epoch );

  my $min_diff = ( $ltime[2] - $gtime[2] ) * 60;
  $min_diff += ( $ltime[1] - $gtime[1] );
  if ( $ltime[3] != $gtime[3] ) {
    if ( $ltime[3] == ( $gtime[3] + 1 ) ) {
      $min_diff += ( 24 * 60 );
    } elsif ( $gtime[3] == ( $ltime[3] + 1 ) ) {
      $min_diff -= ( 24 * 60 );
    } elsif ( $ltime[3] == 1 ) {
      $min_diff += ( 24 * 60 );
    } else {
      $min_diff -= ( 24 * 60 );

  my $sign = "+";
  if ( $min_diff <= 0 ) {
    $min_diff = ( 0 - $min_diff );
    $sign = "-";

  my $tz_hour = int( $min_diff / 60 );
  my $tz_min = $min_diff - ( $tz_hour * 60 );

  ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = @ltime;

  my $iso8601;
  $iso8601 = sprintf(
    $year + 1900, $mon + 1, $mday,
    $hour, $min, $sec, $sign, $tz_hour, $tz_min

  printf( "Local time:\n" );
  printf( "  %s\n", $iso8601 );
  printf( "  %s\n", scalar( localtime( $epoch ) ) );
  printf( "\n" );

  ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = @gtime;
  $iso8601 = sprintf(
    $year + 1900, $mon + 1, $mday,
    $hour, $min, $sec

  printf( "GMT/UTC:\n" );
  printf( "  %s\n", $iso8601 );
  printf( "  %s\n", scalar( gmtime( $epoch ) ) );
  printf( "  %d\n", $epoch );
  printf( "\n" );

sub main {
  # Join command line arguments into a single string
  my $input = join( " ", @ARGV );

  my $epoch = undef;

  if ( $input =~ m/^\s*$/ ) {

    print( "Using current time as no time string provided.\n\n" );
    $epoch = time();
  } elsif ( $input =~ m/^\d{1,10}$/ ) {
    printf( STDERR "Detected Unix epoch date format\n" );
    $epoch = int( $input );
  } elsif ( $input =~ m/^\d{13}$/ ) {
    printf( STDERR "Detected Java epoch (in ms) date format\n" );
    $epoch = ( int( $input ) / 1000.00 );
  } else {
    printf( STDERR "Trying to parse date string...\n" );
    $epoch = Date::Parse::str2time( $input );

  if ( ! $epoch ) {
    die( "Failed to parse date" );

  display_time( $epoch );


Installing Selenium for Perl on Ubuntu 16.04

First I had to download the “Selenium Standalone Server” (a Java .jar file) from the Selenium download page (version 3.5.3 as of writing this article).

Then I ensured I had a JRE (Java run-time environment) by executing:

~$ sudo apt-get install openjdk-9-jre

I also downloaded the Mozilla GeckoDriver from the download page specified above (version 0.18.0 as of writing this article). I then extracted geckodriver-v0.18.0-linux64.tar.gz (the geckodriver executable) into the same folder as the Java Selenium Standalone Server .jar.

~$ cd /opt/selenium
~$ tar -xvjf geckodriver-v0.18.0-linux64.tar.gz

I started up the Java Selenium Standalone Server in a different terminal window by running:

~$ cd /opt/selenium
~$ $ java -jar selenium-server-standalone-3.5.3.jar
2017-09-02 04:35:00.772:INFO::main: Logging initialized @601ms to org.seleniumhq.jetty9.util.log.StdErrLog
2017-09-02 04:35:00.973:INFO:osjs.Server:main: jetty-9.4.5.v20170502
2017-09-02 04:35:00.991:WARN:osjs.SecurityHandler:main: ServletContext@o.s.j.s.ServletContextHandler@77f1baf5{/,null,STARTING} has uncovered http methods for path: /
2017-09-02 04:35:00.995:INFO:osjsh.ContextHandler:main: Started o.s.j.s.ServletContextHandler@77f1baf5{/,null,AVAILABLE}
2017-09-02 04:35:01.012:INFO:osjs.AbstractConnector:main: Started ServerConnector@87a85e1{HTTP/1.1,[http/1.1]}{}
2017-09-02 04:35:01.012:INFO:osjs.Server:main: Started @845ms

Next I installed a package for Perl support of Selenium by downloading the CPAN package Selenium-Remote-Driver v1.20 (25 May 2017) and extracting the file Selenium-Remote-Driver-1.20.tar.gz and running the following commands:

~$ sudo apt-get install libwww-perl libarchive-zip-perl libfile-which-perl libio-string-perl libjson-perl libmoo-perl libxml-simple-perl libtry-tiny-perl libsub-install-perl libtest-longstring-perl libnamespace-clean-perl make
~$ cd /opt/selenium
~$ tar -xvjf Selenium-Remote-Driver-1.20.tar.gz
~$ cd Selenium-Remote-Driver-1.20
~$ perl -w Makefile.PL
~$ make

Then I wrote a test script:

#!/usr/bin/perl -w

use lib '/opt/selenium/Selenium-Remote-Driver-1.20/lib';
use Selenium::Remote::Driver;

use strict;

print( "- Connecting to Selenium Server Standalone (Java)...\n" );
my $driver = Selenium::Remote::Driver->new(
  'remote_server_addr' => "localhost",
  'port' => 4444,
  'browser_name' => 'firefox',

print( "- Opening Google webpage...\n" );
$driver->get( "" );

print( "- Display webpage title on console...\n" );
print $driver->get_title() . "\n";

sub find_and_visit() {
  print( "- Search for 'newspaint'...\n" );
  my $elem = $driver->find_element( "//input[\@name='q']" );
  if ( ! $elem ) {
    print( "Could not find input element with name 'q'.\n" );

  $elem->send_keys( "newspaint" );
  sleep( 2 );

  my $submit = $driver->find_element(
    "//input[\@value='Google Search']"
  if ( ! $submit ) {
    print( "Could not find Google Search button.\n" );

  sleep( 5 );

  my @anchors = $driver->find_elements( "//a" );
  foreach my $anchor ( @anchors ) {
    my $href = $anchor->get_attribute( "href" );
    next if ( ! $href );

    if ( $href eq "" ) {
      print( "Clicking on newspaint blog link...\n" );
      sleep( 5 );


print( "Quitting...\n" );

Using HTML::Mason With CGI Provider

So you want to use HTML::Mason (version 1) but your web provider gives you cPanel-like access to CGI scripting only?

Download HTML::Mason from CPAN and extract the contents from the /lib directory into your account, say, into a directory called /lib/perl/mason.

Then create a file, /public_html/cgi-bin/mason_handler.cgi, which contains:


use lib $ENV{"DOCUMENT_ROOT"} . "/../lib/perl/mason";
use HTML::Mason::CGIHandler;

my $h = HTML::Mason::CGIHandler->new(
  data_dir => '/tmp/mason_data',
  allow_globals => [qw(%session $u)],


Now you want to configure your Apache to use this handler for Perl Mason webpages in the /public_html/mason directory (Apache v2.2):

<Directory /public_html/mason>
  <FilesMatch "\.html$">
    Action html-mason /cgi-bin/mason_handler.cgi
    SetHandler html-mason

    # for Apache 2.2
    Order allow,deny
    Allow from all

    # for Apache 2.4 (see
    #Require all granted

  <FilesMatch "^(autohandler|dhandler)$">
    Action html-mason /cgi-bin/mason_handler.cgi
    SetHandler html-mason

    # for Apache 2.2
    Order allow,deny
    Allow from all

    # for Apache 2.4 (see
    #Require all granted

Some CGI website providers require additional Perl modules for HTML::Mason to work, these can all be downloaded and extracted from CPAN:

  • Exception/
  • Devel/
  • Class/
  • Class/Data/
  • Params/ *
  • Params/ *

(the files marked with a * are those that can be downloaded from CPAN and use the command perl Makefile –pm to force native perl code generation).

Using Perl to Make Signed Requests to Public Transport Victoria Timetable API

So you want to create an application to access the Public Transport Victoria (PTV) Timetable API.

You’ve followed the instructions and e-mailed a request for a developer ID and an access key; and you’ve received both in an e-mail that contained text similar to the following:

Thank you for your interest in the PTV Timetable API.

Your email address has now been registered and your user Id and API key are

User Id: 2912345

API Key: 4cc12345-ff11-2222-a00a-dd1297cd04aa

Now you want to create a signed request using Perl to access the API.

The following function will take a URL and return a signed URL that can be used to access that URL:

#!/usr/bin/perl -w

use Digest::HMAC;
use Digest::SHA;

use strict;

my $devid = "2912345";
my $apikey = "4cc12345-ff11-2222-a00a-dd1297cd04aa";

sub sign_url {
  my ( $url ) = @_;

  # add ?devid=$devid or &devid=$devid to URL
  $url .= ( index($url, "?") < $[ ) ? "?" : "&";
  $url .= "devid=$devid";

  # strip out base URL from part used in signing
  my $request = $url;
  $request =~ s{^(([a-z]+)://+)?[^/]+}{};

  # calculate signature using API key and URL without base
  #   e.g. sign over a string like "/v3/routes?devid=2912345"
  my $signature = Digest::HMAC::hmac_hex(

  $url .= "&signature=" . $signature;
  return $url;

print sign_url( "" );

This should output the following:

$ perl -w

The example is using an invalid signature and devid, so this example URL will not actually return a page; you will have to provide the access key and devid you received in your e-mail.

Note: it is absolutely essential that you do not change the capitalisation of the access key in this script. While it looks like a hex string it is actually treated as case-sensitive text.

The Perl Hash Assignment Gotcha

Question: what do you get if you run the following Perl script?

use warnings;

my %hash => (
    'name' => 'Jimmy',

Answer: you get the message:

Useless use of a constant (name) in void context at line 3.
Useless use of a constant (Jimmy) in void context at line 3.

So what went wrong? The answer is simple enough but very easy to miss. You probably wanted to assign to the hash variable – but used the comma operator (=>) instead.

To fix merely use an equals sign only after declaring the hash variable:

use warnings;

my %hash = (
    'name' => 'Jimmy',

Filtering EasyList For Hosts-File Style Adblock

If you have an Android (rooted CyanogenMod) phone you may be wondering how to block advertising from your web browser.

You may have heard of the hosts file trick that makes the phone assume certain (advertising) domains are hosted at the localhost ( – which is the phone itself and not running its own web server and thus will instantly respond to any such requests with a “cannot connect” type response – quickly and simply filtering out advertisement domains.

We can make use of Adblock filtering lists such as EasyList by looking for any whole-domain rules, extracting the domain name, and putting into the hosts file.

The script is as follows:

#!/usr/bin/perl -w

use strict;

my %hosts = ();
while ( <> ) {
    if ( $_ =~ m/^\|\|([a-z][a-z0-9-_.]+\.([a-z]{2,3}))\^\s*$/ ) {
        $hosts{$1} = 1;

foreach my $host ( sort keys %hosts ) {
    print( "\t$host\n" );

We can use this by downloading the EasyList (as, say, easylist.txt). Then:

user@host:~> perl easylist.txt >easylist.hosts

As of 2014-08-18 there were 5029 such hosts in the list. You can add them to a file. This file should look something like (all domains except localhost are fictionalised in this example):	localhost

You must ensure that your hosts file always has a localhost entry in it.

Next, connect your phone via USB and shell to it. The steps are:

  • push the new hosts file to the SD card (temporary location)
  • shell to the phone, become super user
  • find the /system mount path, remount /system as rw (read-write)
  • copy the old /etc/hosts file (backup)
  • copy the new /sdcard/ file to /etc/hosts
  • remount /system as ro (read-only)
user@host:~> adb push /sdcard/
1572 KB/s (236687 bytes in 0.147s)

user@host:~> adb shell
shell@p880:/ $ su
root@p880:/ # mount |grep system
/dev/block/platform/sdhci-tegra.3/by-name/APP \
  /system \
  ext4 \
  ro,seclabel,noatime,nodiratime,user_xattr,acl,barrier=0,data=ordered,noauto_da_alloc \
  0 0
root@p880:/ # mount -o rw,remount \
  /dev/block/platform/sdhci-tegra.3/by-name/APP \
root@p880:/ # cd /etc
root@p880:/etc # cp hosts hosts.old
root@p880:/etc # cp /sdcard/ ./hosts
root@p880:/etc # mount -o ro,remount \
  /dev/block/platform/sdhci-tegra.3/by-name/APP \
root@p880:/etc # exit
shell@p880:/ $ exit

Iterating With OpalORB

If you’re using the Perl CORBA interface, OpalORB, and you want to iterate through a list then you have to use iterator objects and process the list some elements at a time.

Here is a method I’ve used for iterating in Perl:

# list all XML files in this folder
my $numPerGrab = 25;
my ($objectItems, $objectItemIterator); # scalars to hold iteration objects
    +[ "*.xml" ], # pattern_seq
    $numPerGrab, # number per grab

my $next_n_result = 1;
while ( 1 ) {
    # process this chunk of returned items
    foreach ( @{$objectItems} ) {
        printf( "  - file name \"%s\"\n", $_->name() );

    last if ( ! $next_n_result ); # no more
    last if ( $objectItemIterator->_get_orb ); # iterator not valid

    # get next set of items
    $next_n_result = $objectItemIterator->next_n( $numPerGrab, \$objectItems );

# should probably destroy the iterator when done with it
# - but don't know if checking _repo_id is the right way to do it
if ( $objectItemIterator->{_repo_id} ) {

The equivalent iteration done in Java would look like:

ObjectItemsHolder objectItems = new ObjectItemsHolder();
ObjectItemIteratorHolder iterator = new ObjectItemIteratorHolder();

int numPerGrab = 25;

    new String[] { "*.xml" }, /* pattern_seq - the sequence of the patterns (ORed) */
    (int)numPerGrab, /* how_many - how many objects will be returned (0 for all) */
    objectItems, /*  items - the sequence of the subitems requested */
    iterator /* iterator - an iterator to retrieve the remaining subitems */

ObjectItemIterator recordSet = iterator.value;
bool next_n_result = true;
while ( true ) {
    for ( ObjectItem item: objectItems.value ) {
        System.out.println( "  - " + );

    if ( ! next_n_result )

    if ( recordSet == null )

    next_n_result = recordSet.next_n( (int)numPerGrab, objectItems );
} while ( 1 );

It is worth noting that when iterating it may be faster to get smaller groups of items than larger. Initially I was trying to pull 500 filenames at a time but I found my script actually performed much faster pulling 25 filenames at a time. A little counter-intuitive but worth testing depending on your circumstances.

There are probably better patterns to use for iteration and by all means leave me a comment if you can demonstrate a better one. But this should get you going if you have no idea where to start.

How To Get Object’s IOR With OpalORB

If you’re using the Perl CORBA interface, OpalORB, and you want to know how to get a text string representing the IOR of an object you can do the following (where session is the CORBA object I want the IOR of):

my $sior = $session->_get_orb->object_to_string( $session );

This is possible because almost all objects compiled from IDLs in Perl will inherit from the CORBA::Object class which has the _get_orb() method – and this returns a CORBA::ORB class instance which has the object_to_string() method.

A way of doing this in Java is equivalently:

String ior = session.toString();

A CORBA Consumer In Perl

Lately I’ve discovered the OpalORB open source implementation of the Object Management Group (OMG) CORBA standard.

Given a set of interface definition language (IDL) files they can be compiled and the corresponding Perl classes can be used to communicate with a CORBA server.

There isn’t too much example code for this on the Internet – perhaps because the documentation for OpalORB is rather light – and perhaps because CORBA isn’t widely used these days save for some specialist applications in private industry.


Download the OpalORB tarball and extract.

You probably will need to edit Makefile and remove the spaces after the equal signs and all trailing space and comments after the variable definitions for COPY, MKDIR, DESTINATION, and TARGET.

Then, as root, run make install.

Copy your custom IDL files into /usr/local/opalORB/idl/myidl.

Compile your IDLs:

cd /usr/local/opalORB/idl/myidl
for i in *.idl; do echo ===$i===; ../ --client $i; done

Change all references to Object to MyCompany::Object:

find . -type f -name '*.pm' \
  -exec perl -i.bak \
  -pe 's{(?<=[^:A-Za-z0-9.])(Object)(?=[^:A-Za-z0-9.])}{MyCompany::$1}g' {} \;

Running Your Perl Scripts

You’ll probably want to run your Perl scripts in such as way so as they’ll find your OpalORB and custom classes. To do this prepend your Perl executable with the PERL5LIB environment variable, e.g.:

PERL5LIB=/usr/local/opalORB:/usr/local/opalORB/Naming:/usr/lodcal/opalORB/idl/myidl \
  perl script


First of all let’s solve some simple problems in Perl.

Connecting to a CORBA Server and Getting a Repository/Channel/etc

You may have a IOR reference which looks something like IOR:010000002600000049444c… (for 3 or 4 lines of hexadecimal digits). If that’s the case here is how you can get your repository or channel or whatever…

use CORBA;

# compiled from my own IDL files
use MyCompany::Repository;

sub get_repository_from_ior {
    my ( $ior ) = @_;

    my $orb = CORBA::ORB_init( +[ "MyORBInstance" ] );

    my $repositoryObject = $orb->string_to_object( $ior );
    my $repository = MyCompany::Repository::_narrow( $repositoryObject );
    return( $orb, $repository );

Or alternatively if you have a corbaloc string you could use the following function:

use CORBA;
use CosNaming::NamingContextExt;

# compiled from my own IDL files
use MyCompany::Repository;

sub get_repository_from_iiop_and_path {
    my ( $corbaloc, $path ) = @_;

    my $orb = CORBA::ORB_init( +[ "-ORBInitRef", "MyServiceID=$corbaloc" ] );

    my $namingContextObject = $orb->resolve_initial_references('MyServiceID');
    my $namingContext = CosNaming::NamingContextExt::_narrow( $namingContextObject );

    my $name = $namingContext->to_name( $path );
    my $repositoryObject = $namingContext->resolve( $name );
    my $repository = MyCompany::Repository::_narrow( $repositoryObject );
    return( $orb, $repository );

Exception Handling

CORBA servers frequently express inability to perform an action through exceptions. I recommend explicitly including the Error CPAN module with debugging turned on so that you can produce a stacktrace pinpointing the line in your code that resulted in the triggered exception.

use Error qw(:try);
$Error::Debug = 1;

use strict;

my $orb = undef;

try {
    ( $orb, $repository ) = get_repository_from_iiop_and_path(

    my $version = $repository->get_version();
    my $version_string = $version->version_string;
    print( "My database version: $version_string\n" );
catch Error::Simple with {
    my $e = shift;
    print( STDERR "File " . $e->file . ", line " . $e->line . ": $e" );
    warn( $e->stacktrace );
}; # semi-colon MUST be here

# clean up before quitting
$orb->shutdown() if ( $orb );

POA Server

You might have need to receive events from a CORBA server. To this end you will have to run your own infinite-running thread that registers a class to receive messages.

It is VERY important that any dependent classes used in decoding received messages must be included in the script with the “use” pragma otherwise POA may generate exceptions about being unable to find the new method in the sequence or struct objects. To this end I recommend editing the CORBA/ module and adding the following bold line in the _id_to_name() function during debugging so you can become aware of which classes you need to include in your main script:

return $$id_name{$id} if (defined $$id_name{$id});
warn( "Unknown id \"$id\"" );

package ConsumerImpl;

# parent classes
use MyCompany::Consumer;
use PortableServer::ServantBase;

push( @ISA, 'MyCompany::Consumer', 'PortableServer::ServantBase' );

sub new {
    my $class = shift;
    my $self = $class->SUPER::new();
    return( $self );

sub msg_push {
    my $self = shift;

    my ( $event ) = @_;

    printf( "%s: %s\n", $event->name, join( ", ", @{$event->items} ) );


package main;

# setting up naming context and channel
use CosNaming::NamingContextExt;
use MyCompany::Channel;

# POA and dependent classes (must be loaded to be recognised)
use PortableServer::POA;
use MyCompany::ext_event;
use MyCompany::ObjectInfo;

# pragmas
use Error qw(:try);
$Error::Debug = 1;

use strict;

sub get_channel_from_iiop_and_path {
    my ( $corbaloc, $path ) = @_;

    my $orb = CORBA::ORB_init( +[ "-ORBInitRef", "MyServiceID=$corbaloc" ] );

    my $namingContextObject = $orb->resolve_initial_references('MyServiceID');
    my $namingContext = CosNaming::NamingContextExt::_narrow( $namingContextObject );

    my $name = $namingContext->to_name( $path );
    my $object = $namingContext->resolve( $name );

    my $channel = MyCompany::Channel::_narrow( $channelObject );
    return( $orb, $channel );

my $orb = undef;

try {
    my $channel;

    ($orb, $channel) = get_channel_from_iiop_and_path(

    my $consumerImpl = ConsumerImpl->new();
    my $rootPOA = $orb->resolve_initial_references( "RootPOA" );
    my $poaManager = $rootPOA->the_POAManager();
    my $consumerId = $rootPOA->activate_object( $consumerImpl );

    my $consumerRef = $rootPOA->id_to_reference( $consumerId );
    my $consumer = MyCompany::Consumer::_narrow( $consumerRef );

    $orb->run(); # never returns, but consumer will now receive messages
catch Error::Simple with {
    my $e = shift;
    print( STDERR "File " . $e->file . ", line " . $e->line . ": $e" );
    warn( $e->stacktrace );

# clean up before quitting
$orb->shutdown() if ( $orb );

Installing Perl Padre IDE Into Ubuntu 12.04 Precise

Running cpan Padre was giving me all sorts of troubles.

I had to follow the advice in this blog post when I got the error message Undefined subroutine &ExtUtils::ParseXS::errors – which was to apt-get install libwx-perl and edit /usr/local/lib/perl5/5.12.4/ExtUtils/xsubpp and change the errors() call to report_error_count() (as specified in this forum post).

Padre kept failing to install when it couldn’t pass tests depending on Debug::Client. To install that I had to install some dependent libraries:

apt-get install libncurses5-dev
apt-get install libreadline-dev
cpan Term::ReadLine::Gnu
cpan Debug::Client
cpan Padre