Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister

MidLifeXis's scratchpad

by MidLifeXis (Monsignor)
on Jun 01, 2004 at 18:01 UTC ( [id://358325]=scratchpad: print w/replies, xml ) Need Help??

(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/ 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 dieprint @foo || die

(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

BEGIN { my $success = eval { use_ok($module); 1; }; isnt($success, 1, "eval of use_ok failed (as expected)"); }
and $module contains....
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

x=`echo "a\nb"`x="`echo "a\nb"`"
Outputecho $xa ba b
echo "$x"a ba

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";
Log In?

What's my password?
Create A New User
Domain Nodelet?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others chilling in the Monastery: (2)
As of 2024-06-22 10:24 GMT
Find Nodes?
    Voting Booth?

    No recent polls found

    erzuuli‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.