Public Scratchpad | Download, Select Code To D/L |
(2014/12/18) - for thezip
#!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;
(2014/01/15) - for Lady_Aleena
my $load_task = ref($task) eq 'ARRAY' && $load eq 'bed clothes' ? $task->[1] : ref($task) eq 'ARRAY' && $load ne 'bed clothes' ? $task->[0] : $task ;
or break up the ARRAY check
my $load_task = ref($task) ne 'ARRAY' ? $task : $load eq 'bed clothes' ? $task->[1] : $load ne 'bed clothes' ? $task->[0] : die "huh?";
or just use if/else
(2013/12/06) - for SwaJime
#!/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; }
(2013/10/23) - MLX is the answer to everything
perl -le '$s+=ord($_)>>1 for split//,MLX;print +(scalar reverse $s)<<1' (thanks to shmem)
(2013/10/22) - Limbic~Region's logic puzzle
Filed away for later mulling.
Limbic~Region Logic Puzzle: There are 3 boxes (2 empty, 1 containing a 1 million dollar diamond). You have a truth machine that can answer any yes/no question with 100% accuracy. You may ask 2 questions. The machine will flash red or green Limbic~Region problem is - you don't know if yes = red or green. What 2 questions do you ask to get the diamond? MidLifeXis Hmm, sounds like a variant on the one with a truth teller + liar that guard two doors, one to untold riches and one to certain doom. moritz there must be at least one question with both gives you information about whether red is yes, and some information on the boxes Limbic~Region moritz - boolean logic is allowed so yes Limbic~Region There are 4 possible outcomes and 3 boxes: green, green; green, red; red, green; red, red moritz there are 8 possible questions one can ask MidLifeXis MidLifeXis files that away for later. Is there a name for this puzzle? moritz since asking the same question twice is pretty senseless, you can brute-force your way through 8 * 7 == 56 possible combinations moritz divided by 2, because of commutation Limbic~Region MidLifeXis - not that I know of. I haven't found it online anywhere. The closest I have come is The_Hardest_Logic_Puzzle_Ever Limbic~Region Limbic~Region patiently waits for moritz to come up with a suitable answer from his brute forcing MidLifeXis Can you also include the meaning of the red/green indicator in your question? MidLifeXis If so, I think that you can reduce it to my related problem (I think - not enough coffee yet) MidLifeXis or are you only allowed to ask about the box state? moritz no, there are more possible questions to ask. I was wrong. hdb can you ask your second question depending on the outcome of the first? Limbic~Region MidLifeXis: Your question has to be yes/no so you could ask "does green mean yes" but if it answers green you still don't know. I do not see how to reduce the problem to the one you described Limbic~Region hdb - absolutely MidLifeXis second para under history in LR's link (Knights and Knaves) is the one I was referring to. Limbic~Region There is a class of problems called knights/knaves. One of the variations is where they respond in an unknown language for yes/no - which is also very similar but not exactly like this - also available on wikipedia MidLifeXis With boolean logic, I think you could add in ((yes == green) ^ (diamond in boxa)), but not sure on that yet. Have to mull over it a bit. Limbic~Region Knights_and_knaves MidLifeXis however, since it has been discounted so rapidly by LR, I am guessing that I am going down the wrong path ;-) MidLifeXis (or not - see solution section in The_Hardest_Logic_Puzzle_Ever Limbic~Region MidLifeXis: No. I was discounting the "which path leads to untold riches" puzzle you originally mentioned MidLifeXis Ahh, ok. MidLifeXis It seems like you need to embed, as part of your question, an assertion that eliminates the unknown part of the red/green (something like duct tape) ;-) MidLifeXis and on that note, /me files this diversion away for later. Limbic~Region It is perfectly fine to do something like ask - is my name Limbic~Region to determine if green means yes or no. The problem is that you need to obtain that information while also obtaining information about the boxes or else you don't have enough Qs
(2013/09/09) - IP stuff in perl
(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.
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
(2011/05/05) - Operators
For jellisii2. See perlop. Work from the top of the precedence list to the bottom, adding parens as appropriate.
print @foo or die | print @foo || die | |
---|---|---|
LISTOP LIST or LISTOP | LISTOP LIST || LISTOP | |
LISTOP (LIST) or LISTOP | LISTOP (LIST || LISTOP) |
(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
(2010/02/03) - Trying to trap a die inside of a use
and $module contains....BEGIN { my $success = eval { use_ok($module); 1; }; isnt($success, 1, "eval of use_ok failed (as expected)"); }
BEGIN { if ($foo) { die "this case should not succeed"; } }
(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);
(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"; }
(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';
(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>
(2009/06/19) - Truth under Win32::OLE
use Win32::OLE::Variant; ... $property->{Value} = Win32::OLE::Variant->new(VT_BOOL, 0xFFFFFFFF);
(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(...);
Works properly
$blah->Disconnect; $blah = undef; $blah = Vendor::Lib->Connect(...);
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
(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
(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
(2005/08/16) - differences between shell quoting
Under your favorite sh derived shell, quotes make a big difference... See the following table
Assignment | |||
---|---|---|---|
x=`echo "a\nb"` | x="`echo "a\nb"`" | ||
Output | echo $x | a b | a b |
echo "$x" | a b | a b |
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";