Perl and ActivePerl Tips

Invoking COM Objects

ActivePerl treats COM objects just like any other Perl object reference.  Properties are accessed via a hash attached to the perl variable.

Here is an example of Perl code that invokes the Microsoft XML parser.
     
use Win32::OLE;

$obj = Win32::OLE->new("Microsoft.XMLDOM");
die "failed" unless ref $obj;

$obj->{async} = 0;

## Prints 1 if successful, 0 if unsuccessful

print $obj->load("file://c:\\foo.xml");

Capturing STDERR

The following code redirects STDERR to a file and then restores STDERR.

local *SAVEERR;
my $fn = "$$.err";

open(SAVEERR, ">&STDERR");
open(STDERR, ">$fn") || die "Failed to open $fn - $!";
##
## Do Work Here
##
close(STDERR);
open(STDERR, ">&SAVEERR");

Processing a List of Filespecs

Many scripts accept a list of filespecs as parameters.  A filespec may contain wildcards or it may specify the full path of a single file.  A filespec can have a directory portion.

Here is an example script that processes filespecs in the best way I know how, which is to use a combination of File::Find and File::Glob.  The purpose of the script is to replace control characters in a set of files with a specified static character.

#!/usr/bin/perl

if ($#ARGV < 0)
{
print <<OUT
Removes control characters from a set of files.

Usage:

[-b] [-r] [-c replace_char] filespec filespec filespec filespec ...

-b       : Create .bak files which contain the original file
-c       : Specify the character to replace control characters
           with (defaults to space).
-r       : Recursive; process sub-directories
filespec : The file(s) to alter.  May contain wildcards. 
OUT
;
quit;
}

use File::Glob(:glob);
use File::Find;
use File::Copy;
use Getopt::Std;
use Cwd;
use File::Basename;

$opt_c = ' ';
getopts("rbc:");

foreach $wildcard (@ARGV)
{
    File::Find::find(\&do, dirname($wildcard));
}

sub do
{
    return unless -d $_;

    my $save = $_;
    my @files = bsd_glob($_ . '/' . basename($::wildcard), GLOB_NOCASE);

    foreach(@files)
    {
        replaceFile($_);
    }

    $_ = $save;
}

sub replaceFile
{
    my $f = $_;
    my $f2 = "$f.bak";

    print "Copying file $f -> $f2\n";

    copy($f, $f2);

    eval
    {
        open(F, $f2) || die "unable to open $_.bak - $!";
        open(W, ">$f") || die "unable to open $_ for writing - $!";
    };

    if ($@)
    {
        print $@;
        print "\n";
        close F;
        close W;
        unlink $f2;
        next;
    }

    binmode F;
    binmode W;

    while(<F>)
    {
        eval "tr/[\1-\10]/${opt_c}/";
        eval "tr/[\13-\14]/${opt_c}/";
        eval "tr/[\16-\37]/${opt_c}/";
        print W $_;
    }

    close F;
    close W;

    unlink $f2 unless $::opt_b;

    $File::Find::prune = !($::opt_r);
}