(2011/12/02) - Test::More

with use_ok not in a BEGIN block...

$ perl -MTest::More -e 'plan "no_plan"; print use_ok("Does::Not::Exist
+"), "\n"; print pass("This is ok"), "\n"'
not ok 1 - use Does::Not::Exist;
#   Failed test 'use Does::Not::Exist;'
#   at -e line 1.
#     Tried to use 'Does::Not::Exist'.
#     Error:  Can't locate Does/Not/Exist.pm in @INC (@INC contains: b
+lah blah blah) at (eval 3) line 2.
# BEGIN failed--compilation aborted at -e line 1.
0
ok 2 - This is ok
1
1..2
# Looks like you failed 1 test of 2.
[download]

With use_ok in a BEGIN block...

$ perl -MTest::More -e 'plan "no_plan"; BEGIN {print use_ok("Does::Not
+::Exist"), "\n"} print pass("This is ok"), "\n"'
ok 1 - This is ok
1
1..1
[download]

(2011/05/05) - Operators

For jellisii2. See perlop. Work from the top of the precedence list to the bottom, adding parens as appropriate.

(2011/01/23) - differences between table and div thread layouts

Work in progress

Structure for table-based layout

Structure for div-based layout

(2010/06/24) - code that displays differently based on tabstops

if ($a ||    # Some reason
    $b       # Some other reason
[download]

(2010/02/03) - Trying to trap a die inside of a use

BEGIN {
  my $success = eval {
    use_ok($module);
    1;
  };
  isnt($success, 1, "eval of use_ok failed (as expected)");
}
[download]

BEGIN {
    if ($foo) { die "this case should not succeed"; }
}
[download]

(2010/01/15) - for MikeDexter: Rework II

use strict;
use warnings;

my ($ifh, $var1, $var2);
my $infilename = '/etc/issue';
open($ifh, '<', $infilename);
while (<$ifh>) {
    chomp;
    if ( /^(Red) (Hat)/ ) {
        ($var1, $var2) = ($1, $2);
        print "$var1$var2\n";
    }
}
close ($ifh);

[download]

(2010/01/08) - for MikeDexter: Rework

my $nics = qx |/sbin/ifconfig| or die("Can't get info from ifconfig: $
+!\n");
my @nics = split /(?<=\n)(?=\w)/, $nics;
for (@nics) {
    my %nic;
    ($nic{device}) = $_ =~ /^(eth\d)\s/
      or next;
    if (/\binet addr:([\d.]+)\s.+?:([\d.]+)\s.+?:([\d.]+)/) {
      $nic{ip}    = $1;
      $nic{bcast} = $2;
      $nic{mask}  = $3;
      # print "Device: $nic{device} has the IP Address of $nic{ip}\n\t
+Mask: $nic{mask}\n\tBroadcast: $nic{bcast}\n";

    }
    if (/^\s+ inet6 addr:\s*(\S+)/m) {
      $nic{ip6} = $1;
#      print "Device: $nic{device} also has IPv6 address of $nic{ip6}\
+n";
    }
    # Do all printing here....
    # this statement needs work.
    #  print "Device: $a\n\tIPv4: $b\n\tBcast: $c\n\tMask: $d\n\tIPv6:
+ $e\n";
}
[download]

(2009/10/23) - for gmtheodore: simple helloworld.cgi

use strict;
use warnings;
use diagnostics;

binmode STDOUT;

# This should really be explicit about the \r\n
print "Content-Type: text/plain\n\n";
print 'Hello World';
[download]

(2009/07/22) - For samwyse: capturing matches in array

use strict;
use warnings;

my $tr="<tr>" . ("<td>(.*?)</td>"x8) . "</tr>";

while (<DATA>) {
        my @x = m/\G$tr/cgo or next;
        print join("|", @x), "\n";
}

__DATA__

<tr><td>I</td><td>am</td><td>Santa</td><td>Clause</td><td>I</td><td>am
+</td><td>Santa</td><td>Clause</td></tr>

Blah Blah This Will Not Match

<tr><td>I</td><td>am</td><td>Easter</td><td>Bunny</td><td>I</td><td>am
+</td><td>Easter</td><td>Bunny</td></tr>

<tr><td>Neither</td><td>Will</td><td>This</td></tr>

[download]

(2009/06/19) - Truth under Win32::OLE

use Win32::OLE::Variant;
...
$property->{Value} =
    Win32::OLE::Variant->new(VT_BOOL, 0xFFFFFFFF);
[download]

(2009/02/18) - Shouldn't these be the same?

Shouldn't these be the same? The first is giving a coredump, and the second works correctly.

Fails with a coredump

  $blah->Disconnect;
  $blah = Vendor::Lib->Connect(...);
[download]

Works properly

  $blah->Disconnect;
  $blah = undef;
  $blah = Vendor::Lib->Connect(...);
[download]

It looks to me like the undef assignment is calling the DESTROY method on $blah, but just the assignment is not. Since it generates a coredump, I am reporting it as a bug anyway, but just for my knowledge, shouldn't the DESTROY method also be called on the first example?

(2007/Mar/21) - How to diff the file structures of two directories

(cd d1 && find .) | sort > out.1
(cd d2 && find .) | sort > out.2
diff out.1 out.2
[download]

(2007/Feb/06) - How to make a program execute only once and only if a file matching a pattern exists, oh, and continue after checking the first if...

#!/bin/ksh

for x in *.pl; do
    if [[ -f "$x" ]]; then
      ./what_you_want_to_do *.pl
      break
    fi
done
[download]

(2007/Feb/06) - How to make a program execute only once and only if a file matching a pattern exists

#!/bin/ksh

for x in *.pl; do
    if [[ -f "$x" ]]; then
      exec ./what_you_want_to_do *.pl
    fi
done
[download]

(2005/08/16) - differences between shell quoting

Under your favorite sh derived shell, quotes make a big difference... See the following table

Trying to store all unique matches for a pattern....

#!perl

use strict;
use warnings;

my $base = shift;
my $pattern = shift;

print "Base = $base, pattern = $pattern\n\n";

my %checkthese;
while ($base =~ m/\G($pattern)/g) {
  my $pos = pos($base);
  print "POS = ", $pos, "\n";
  my $pre = substr($base,0,$pos - 1);
  my $match = $1;
  my $post = substr($base,$pos);
  $checkthese{"$pre:$match:$post"} = {
    pre => $pre,
    match => $match,
    post => $post,
  };
  pos($base) = $pos + 1;
}

print "\n\n", "End", "\n\n";
print join("\n", keys %checkthese), "\n";
[download]