#!perl

use strict;
use warnings;

use XML::LibXML;
use XML::LibXSLT;

my ( $sourcefile, $stylefile ) = @ARGV;

# Create an XML parser
my $p          = XML::LibXML->new;
my $xml_source = $p->parse_file($sourcefile);

# Create an XSLT engine
my $s          = XML::LibXSLT->new;
#$s->debug_callback(sub {warn @_});
my $stylexml   = $p->parse_file($stylefile);
my $stylesheet = $s->parse_stylesheet($stylexml);
my $transformed   = $stylesheet->transform($xml_source)
    or die "Transformation lost it on $_";

# Generate the output
my $output = $stylesheet->output_string($transformed);

print $output;

##</code><code>##

my $load_task =
    ref($task) eq 'ARRAY' && $load eq 'bed clothes'    ? $task->[1] :
    ref($task) eq 'ARRAY' && $load ne 'bed clothes'    ? $task->[0] :
                                                         $task
;

##</code><code>##

my $load_task =
    ref($task) ne 'ARRAY'         ? $task      :
    $load      eq 'bed clothes'   ? $task->[1] :
    $load      ne 'bed clothes'   ? $task->[0] :
die "huh?";

##</code><code>##

#!/usr/bin/perl -W 

use strict; 
use warnings; 

sub listText {
  my $myDir = $_[0];
  my @fileList;
  my $wanted2 = sub {
    my $filePath = $File::Find::name;
    if ($filePath =~ /txt/) {
      push(@fileList, $filePath); 
    }
  };
  find({wanted => $wanted2, no_chdir => 1}, ($myDir));

  return @fileList;
} 

##</code><code>##

$ 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: blah 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.

##</code><code>##

$ 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

##</code><code>##

if ($a ||    # Some reason
    $b       # Some other reason

##</code><code>##

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

##</code><code>##

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

##</code><code>##

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);


##</code><code>##

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\tMask: $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";
}

##</code><code>##

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';

##</code><code>##

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>


##</code><code>##

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

##</code><code>##

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

##</code><code>##

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

##</code><code>##

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

##</code><code>##

#!/bin/ksh

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

##</code><code>##

#!/bin/ksh

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

##</code><code>##

#!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";