Converting Perl Arguments from Named Arguments to Positional Arguments While Maintaining Legacy Code

I think that's the longest blog title I've ever written. In case it's not clear, here is what is happening.

I used to use only positional arguments in all of my Perl functions simply because I didn't know any better. There are problems with that approach as this article points out. With any new development, I am solely using named arguments but what about legacy code? I wondered if I could change a method to accept named arguments but still use the same positional arguments so that I wouldn't have to update my legacy code base. Here's what I came up with:

if (ref(@_[0]) eq "HASH") {
    my %args = %{@_[0]};
    foreach my $arg (keys %args) {
        eval("\$$arg = \$args{\$arg}");
    }
}

What this code snippet does is look at the first argument in the list to determine its type. If it's a HASH, then we know the arguments are being passed as named arguments. So we convert them using the eval function to look just like the old positional arguments.

So let's say we have this legacy Perl function:

sub test {
    my ($arg1, $arg2, $arg3) = @_;
    
    print "\$arg1 = $arg1\n";
    print "\$arg2 = $arg2\n";
    print "\$arg3 = $arg3\n";
}

To convert it, we just add the new code snippet in. Here's a test script to see it in action.

#!/usr/bin/perl

use strict;

&test("abc", "123", "xyz");

&test({
    arg1 => 'abc',
    arg2 => '123',
    arg3 => 'xyz'
});

sub test {
    my ($arg1, $arg2, $arg3) = @_;
    
    if (ref(@_[0]) eq "HASH") {
        my %args = %{@_[0]};
        foreach my $arg (keys %args) {
            eval("\$$arg = \$args{\$arg}");
        }
    }
    
    print "\$arg1 = $arg1\n";
    print "\$arg2 = $arg2\n";
    print "\$arg3 = $arg3\n";
}

Including ColdFusion Content in Perl CGI Script

I have a site that mostly consists of ColdFusion pages. Occasionally I will use a Perl CGI script when the need arises. For example, long running reports or scripts that need to run shell commands are better suited for Perl than ColdFusion. On a side note, if you are running ColdFusion on a UNIX/Solaris platform like I am, you should avoid CFEXECUTE tags at all costs.

Whenever I create a Perl script on my site, I still want it to have the look and feel of the rest of my ColdFusion pages. I have a standard header that is included on every page of my site. Within that header is a menu that changes depending on which role(s) the user is assigned. To include the header on my Perl pages, I just use wget to retrieve the header file from my site, then display the HTML. It is something similar to this:

print &getHTMLHeader();

sub getHTMLHeader() {
    return `wget -O - http://mysite/myheader.cfm`;
}

The problem is that my ColdFusion session is not passed. Therefore, the menu does not display what a logged in user should see. I first thought I could just pass my cookies to the wget command:

sub getHTMLHeader() {
    open OUT, ">cookies.txt":
    print OUT $ENV{'HTTP_COOKIE'};
    close OUT;
    return `wget --load-cookies=cookies.txt -O - http://mysite/myheader.cfm`;
}

However, the ColdFusion session management is smart enough to recognize that something is not right about this session. That's because the IP address of the server and not the client is being passed to the page.

So here is the solution. After the HTML header is received, I append a little jQuery code to get the menu code and replace what is displayed:

sub getHTMLHeader() {
    my $html = `wget -O - http://mysite/myheader.cfm`;
    $html .= <<"    END";
        <script>
        \$.ajax({
            url: '/path/to/menu/menu.cfm',
            async: false,
            dataType: 'html',
            success: function (data, textStatus, jqXHR) {
                \$(".main-menu-content").html(data);
            }
        });
        </script>
    END
    return $html;
}

Evaluating Backreferences in Oracle REGEXP_REPLACE

Here's the problem. I want to use Oracle's REGEXP_REPLACE function to replace a string of digits with a zero-padded string. In Perl I would do it like this:

#--- Change xyz123 to xyz000123
my $string = "xyz123";
$string =~ s/(\d+)$/sprintf("%06d", $1)/e;

So here is what I started with in Oracle PL/SQL:

my_string := 'xyz123'
regexp_replace(my_string, '(\d+)$', lpad('\1', 6, 0));

And what I got was xyz0000123. What I discovered was that the LPAD function was being evaluated before the backreference (\1) was. So no matter what I did, the LPAD function always saw the string to be padded as 2 characters long.

So to get around this, I wrote another function called evalpad. With this, I do the replacement in 2 steps. The first is to replace the string with an embedded pad psuedo-function. Then I call a second function to do the actual replacement. Here's the code:

create or replace function evalpad (
  strIn in varchar
)
return
  varchar
as
  retval varchar(255);
  arg1 varchar(50);
  arg2 varchar(50);
  padded_number varchar(100);
begin
  retval := strIn;
  while (regexp_instr(retval, 'pad\((\d+)') > 0) loop
    arg1 := regexp_substr(retval, 'pad\((\d+)');
    arg1 := regexp_replace(arg1, 'pad\(', '');
    arg2 := regexp_substr(retval, 'pad\((\d+),\s*(\d+)');
    arg2 := regexp_replace(arg2, 'pad\((\d+),\s*', '');
    padded_number := lpad(arg1, arg2, 0);
    retval := regexp_replace(retval, 'pad\((\d+),\s*(\d+)\)', padded_number, 1, 1);
  end loop;
  return retval;
end;

Then in my original function I do this:

my_string := 'xyz123'
regexp_replace(my_string, '(\d+)$', 'pad(\1, 6)');
my_string := evalpad(my_string);