Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

ikegami's scratchpad

by ikegami (Pope)
on Aug 16, 2004 at 23:32 UTC ( #383504=scratchpad: print w/ replies, xml ) Need Help??

My mini tutorials (Follow link, then click Search)
My tutorials (Follow link, then click Search)
Jargon relating to Perl strings


For metalgear119,

>type script.bat @echo off set testa= set testb= echo testa=%testa% echo testb=%testb% for /f "usebackq delims=" %%f in (`perl script.pl`) do %%f echo testa=%testa% echo testb=%testb% >type script.pl print("set testa=abc\n"); print("set testb=def\n"); >script testa= testb= testa=abc testb=def

For Jurassic Monk,

package My::XML::Generator; use strict; use warnings; use Exporter qw( import ); use XML::LibXML qw( ); our @EXPORT_OK = qw( gen_document gen_root_element gen_element gen_data_element ); our %EXPORT_TAGS = ( 'all' => \@EXPORT_OK ); # -------------------- # Public Functions sub gen_document { my $doc = XML::LibXML::Document->new('1.0', 'UTF-8'); $doc->setDocumentElement(gen_root_element(@_)); return $doc->toString(); } # Can't use objects passed as children after calling this. sub gen_root_element { my $name = shift; my $children = pop; my $root = XML::LibXML::Element->new($name); while (@_) { my $key = shift; my $val = shift; if ($key eq '__NAMESPACE') { $root->setNamespace($val); } else { $root->setAttribute($key, $val); } } foreach (@$children) { $root->addChild($_); } return $root; } # Can't use objects passed as children after calling this. sub gen_element { my $name = shift; my $children = @_ % 2 == 1 ? pop : []; my $ele = XML::LibXML::Element->new($name); while (@_) { $ele->setAttribute(shift, shift); } foreach (@$children) { $ele->addChild($_); } return $ele; } sub gen_data_element { my $name = shift; my $text = shift; my $ele = XML::LibXML::Element->new($name); while (@_) { $ele->setAttribute(shift, shift); } $ele->appendTextNode($text); return $ele; } 1; __END__ =head1 NAME My::XML::Generator - A fast XML generator. =head1 SYNOPSIS use My::XML::Generator qw( gen_document gen_element gen_data_eleme +nt ); sub gen_breakdown { ... return gen_element('PTC_Farebreakdown', [ gen_element('PassengerTypeQuantity', 'Code' => format_pax_type($pax_type), 'Quantity' => $pax_qty, ), gen_element('PassengerFare', [ gen_element('BaseFare', 'Amount' => $base_fare), gen_element('Taxes', [ gen_data_element('Tax', 'Taxes and Surcharges', 'A +mount' => $tax_and_surch), ]), gen_element('TotalFare', 'Amount' => $total), ]), ]); }

Re: meaning of '@' sigil on a hash?


Index


Inline and block elements in HTML 4.01 (strict)

The distinction between inline and block is only meaninful to descendants of BODY, so anything that can't be a descendant of BODY is neither. Any instance of an element that isn't a descendant of BODY (e.g. a SCRIPT element in the header) is neither.

Inline
text TT I B BIG SMALL EM STRONG DFN CODE SAMP KBD VAR CITE ABBR ACRONYM A IMG OBJECT BR SCRIPT*1 MAP Q SUB SUP SPAN BDO INPUT SELECT TEXTAREA LABEL BUTTON
Block
P H1 H2 H3 H4 H5 H6 UL OL PRE DL DIV NOSCRIPT BLOCKQUOTE FORM HR TABLE FIELDSET ADDRESS
Both*2
INS DEL

*1 — SCRIPT can also appear as a direct child of BODY and BLOCKQUOTE where only block elements are normally allowed.

*2 — They can be used as both, but a particular instance of these elements is either one or the other, not both.


Working with Odd/Even Elements

Moved to Mini-Tutorial: Working with Odd/Even Elements


Toggling binmode in Perl v5.6.1

use IO::Handle (); # For "flush" method. print("crlf\n"); { STDOUT->flush(); my $fileno = fileno(STDOUT); local *STDOUT; open(STDOUT, ">&$fileno") or die("Unable to dup STDOUT: $!\n"); binmode(STDOUT); print("raw\n"); } print("crlf\n");

Alternative:

use IO::Handle (); # For "flush" method. open(STDOUT_BIN, ">&STDOUT") or die("Unable to dup STDOUT: $!\n"); binmode(STDOUT_BIN); print("crlf\n"); # Flush STDOUT when switching to STDOUT_BIN. STDOUT->flush(); print STDOUT_BIN ("raw\n"); # Flush STDOUT_BIN when switching to STDOUT. STDOUT_BIN->flush(); print("crlf\n");

(See Mini-Tutorial: Scoped changes to PerlIO layers)


for (reverse a..b) Still Inefficient

use strict; use warnings; print("$]\n"); # 5.008008 # Don't inline these. It will cause the # memory to be allocated at compile time. my $min = 0; my $max = 10_000_000; for ( $min .. $max) { print(":"); <STDIN>; last; } # 2.2MB for ( reverse $min .. $max) { print(":"); <STDIN>; last; } # 239MB

Generating a Unique File Name

This will generate a unique file name, IE-style. (filename.ext -> filename[1].ext -> filename[2].ext).

use File::Basename qw( fileparse ); use IO::Dir qw( ); sub find_unique_name { my ($file_name) = @_; return $file_name if not -e $file_name; my ($n, $d, $e) = fileparse($file_name, qr/\.[^.]*/); my $max; if ($n =~ s/\[(\d+)\]\z//) { $max = $1; } else { $max = 0; } # XXX Should the program fall back to using # -e in a loop if the dir can't be read? my $dh = IO::Dir->new("$d.") or die("Unable to list contents of directory \"$d\": $!\n"); my $re = qr/^\Q$n\E\[(\d+)\]\Q$e\E\z/; while (defined(my $f = $dh->read())) { $max = $1 if $f =~ /$re/ && $max < $1; } $max++; return "$d${n}[$max]$e"; }

Mutual Use of Exporting Modules

Moved to Mini-Tutorial: Mutual Use of Exporting Modules


Dereferencing Syntax

Moved to Mini-Tutorial: Dereferencing Syntax


Examples of Functions as Iterators

sub get_iter { my $pass = 0; return sub { ++$pass; if ($pass == 1) { print("Before 1: "); return 1; } if ($pass == 2) { print("Before 2: "); return 2; } return; } } my $i = get_iter(); while ($_ = $i->()) { print("$_\n"); }
sub get_iter { my $pass = 0; return sub { ++$pass; return if $pass > 2; print("Before $pass: "); return $pass; } } my $i = get_iter(); while ($_ = $i->()) { print("$_\n"); }
sub get_fibonacci_iter { my ($x, $y) = (0, 1); return sub { ($x, $y) = ($y, $x+$y); return $x; } } my $i = get_fibonacci_iter(); print($i->(), "\n") for 1..40;

Listing Numbers Matching a Mask

The following loops efficiently through the numbers matching a provided mask.

my $mask = 0x06000003; # or whatever my $val = $mask; for (;;) { #printf("0x%08X\n", $val); # Print big to small. printf("0x%08X\n", $mask-$val); # Print small to big. last if not $val; $val = ($val - 1) & $mask; }

Output:

0x00000000 0x00000001 0x00000002 0x00000003 0x02000000 0x02000001 0x02000002 0x02000003 0x04000000 0x04000001 0x04000002 0x04000003 0x06000000 0x06000001 0x06000002 0x06000003

Hole in use strict 'refs'

&{\&$function_name}(...) and
(\&$function_name)->(...)
call a function by symbol while strict 'refs' is on. Just like
$pkg->$method_name(...) and
$obj->$method_name(...)

Tested on v5.6.1 and v5.8.0.


Aliasing an Array to a Slice of an Array

sub slice_ref { return \@_; } my @foo = (1..5); # If a ref is ok: #my $bar = slice_ref @foo[0..2]; # If an array is prefered: our @bar; *bar = slice_ref @foo[0..2]; print('foo: ', join(', ', @foo), "\n"); # foo: 1, 2, 3, 4, 5 print('bar: ', join(', ', @bar), "\n"); # bar: 1, 2, 3 print("\n"); $bar[0] = 'a'; print("After changing bar0:\n"); # Works: print('foo: ', join(', ', @foo), "\n"); # foo: a, 2, 3, 4, 5 print('bar: ', join(', ', @bar), "\n"); # bar: a, 2, 3 print("\n"); splice(@bar, 1, 0, 6); print("After inserting into bar:\n"); # Doesn't work: print('foo: ', join(', ', @foo), "\n"); # foo: a, 2, 3, 4, 5 print('bar: ', join(', ', @bar), "\n"); # bar: a, 6, 2, 3

Info About FTP


Updating ActivePerl's Docs

perl -M"ActivePerl::DocTools" -e"ActivePerl::DocTools::UpdateHTML(); ActivePerl::DocTools::WriteTOC();"

Removing the File Component from a URL

use URI (); use File::Spec::Unix (); foreach ( "http://www.faqs.org/rfcs/rfc1738.html", "http://www.server.com/math.cgi?eval=4/5", ) { my $uri = URI->new($_); $uri->query(undef); $uri->path( File::Spec::Unix->catpath( (File::Spec::Unix->splitpath($uri->path()))[0,1])); print($uri, $/); } # output # ------ # http://www.faqs.org/rfcs/ # http://www.server.com/

Ways to Launch Another Program

system("... ...") system("...", "...", "...") system("...&") system("start ...") system("start /min ...") system("start /wait ...") system 1, exec fork+exec `` and qx() open("...|") open("|...") Win32::Process IPC::Open2 IPC::Open3 IPC::Run IPC::Run3

TODO: Make a table illustrating the different features and problems each method has. Important information includes:

  • Overwrites current process, or not.
  • Executes in parallel, or waits.
  • Accepts a handle to use as the child's STDIN, or not.
  • Accepts a handle to use as the child's STDOUT, or not.
  • Accepts a handle to use as the child's STDERR, or not.
  • Access to the system call's error code, or not.
  • Access to the child's return code, or not.
  • Limit on the size of the command.
  • OS compatibility.
  • Source of further documentation.

TODO: Add ways of executing Perl code in the current process.


Boolean Logic in Regular Expression

/^(?:(?!$re).)*$/ # NOT re /$re1|$re2/ # re1 OR re2 /^(?=.*$re1)(?=.*$re2)/ # re1 AND re2

The NOT regexp must be anchored on both ends, but it doesn't have to be with ^ and $.

The AND regexp doesn't have to be anchored, but if the start is anchored (with ^ or by some other means), it should speed up the case where there is no match.

The two instances of .* in the AND regexp may need to be replaced with something less general so it doesn't look too far ahead.


The Common Use of a Negative Lookahead

Moved to Re: Look-Arounds in Regexes are Hard (Common Use of a Negative Lookahead)

TODO: Read the following and implement something


Closures Illustrated

sub create_closure { my $var = shift; return sub { print($var, "\n"); }; } my $sub1 = create_closure("foo"); my $sub2 = create_closure("bar"); # $var is no longer is scope, # but a copy of it lives on in # $sub1 and another in $sub2. &$sub1(); # Prints foo. &$sub2(); # Prints bar. # You can say that the anonymous sub # returned by create_closure closes # around $var. I don't know if "closes" # is the official terminology, but # that's what's happening.

Maintaining Proportions When Scaling an Image

sub scale_dimentions { my ($width, $height, $max_width, $max_height) = @_; my $width_factor; my $height_factor; my $factor; $width_factor = $max_width / $width; $height_factor = $max_height / $height; return ($width, $height) if ($width_factor >= 1 && $height_factor >= 1); if ($width_factor < $height_factor) { $factor = $width_factor; } else { $factor = $height_factor; } return ( int($width * $factor + 0.5), int($height * $factor + 0.5), ); } printf("%d,%d$/", scale_dimentions(2272, 1704, 800, 600)); # 800,600 printf("%d,%d$/", scale_dimentions(1704, 2272, 800, 600)); # 450,600 printf("%d,%d$/", scale_dimentions(2272, 1704, 150, 150)); # 150,112 printf("%d,%d$/", scale_dimentions(1704, 2272, 150, 150)); # 112,150

Using glob to Permute

A solution that only works with numbers:

my @ranges = ( [ 0 .. 2 ], [ 0 .. 2 ], [ 0 .. 2 ], [ 0 .. 2 ], ); my $glob_string = join '\\ ', map { '{'.join(',', @$_).'}' } @ranges; my @results; while (glob($glob_string)) { my $i = 0; push(@results, [ map { $ranges[$i++][$_] } split ]); } print(join(' ', @$_), $/) foreach @results;

A more generalized solution:

my @lists = ( [ ... ], [ ... ], [ ... ], [ ... ], ); my @ranges = map { [ 0..$#$_ ] } @lists; my $glob_string = join '\\ ', map { '{'.join(',', @$_).'}' } @ranges; my @results; while (glob($glob_string)) { my $i = 0; push(@results, [ map { $lists[$i++][$_] } split ]); } print(join(' ', @$_), $/) foreach @results;

It can also be written as a generator.


Flexible Binary Search Function

# Add $value to sorted @array, if it's not already there. my $idx = binsearch { $a <=> $b } $value, @array; splice(@array, ~$idx, 0, $value) if $idx < 0;
sub binsearch(&$\@) { my $compare = $_[0]; #my $value = $_[1]; my $array = $_[2]; my $i = 0; my $j = $#$array; return $j if $j == -1; my $ap = do { no strict 'refs'; \*{caller().'::a'} }; local *$ap; my $bp = do { no strict 'refs'; \*{caller().'::b'} }; local *$bp; *$ap = \($_[1]); for (;;) { my $k = int(($i+$j)/2); *$bp = \($array->[$k]); my $cmp = $compare->() or return $k; if ($cmp < 0) { $j = $k-1; return _unsigned_to_signed(~$k) if $i > $j; } else { $i = $k+1; return _unsigned_to_signed(~$i) if $i > $j; } } } sub _unsigned_to_signed { unpack('j', pack('J', $_[0])) }

stmt while vs do while

$i = 4; print($i) while ($i--); # 3210 $i = 4; do { print($i) } while ($i--); # 43210

A Comment on Spyware

If there's any doubt that spyware is harmful, consider that 20% of Dell's service calls are spyware related. (Oct 2004 figure)


Scalar vs List Context

$a = something; # something is executed in a scalar context. @a = something; # something is executed in a list context. something; # something is executed in a void context. # Arrays return their number of elements in a scalar context: @b = qw( a b c ); print( @b , "\n"); # abc print(scalar(@b), "\n"); # 3 # print accepts a list, but scalar() forced scalar context. # Arithmetic forces scalar context: print(@b,"\n"); # abc print(@b."\n"); # 3 # Not just string arithmetic: print(@b, "\n"); # abc print(@b+0, "\n"); # 3 # Functions can examine their context: { local $, = ", "; local $\ = "\n"; print( localtime ); # 59, 14, 15, 1, 9, 104, 5, 274, 1 print(scalar(localtime)); # Fri Oct 1 15:05:32 2004 } # Refer to wantarray in perlfunc.

Rounding to One Significant Digit

This handles any floats, including those which are negative and those between +-1 and 0.

sub nearest { my ($num) = @_; $num += 0; return 0 unless $num; my $f = $num <=> 0; $num = abs($num); while ($num >= 10) { $num /= 10; $f *= 10; } while ($num < 1) { $num *= 10; $f /= 10; } return int($num + 0.5) * $f; }

Rounding to X Significant Digits

This handles any floats, including those which are negative and those between +-1 and 0.

sub nearest { my ($num, $digits) = @_; $num += 0; $digits ||= 1; return 0 unless $num; my $f = $num <=> 0; $num = abs($num); my $d = 1; $d *= 10 while (--$digits); while ($num < $d) { $num *= 10; $f /= 10; } $d *= 10; while ($num >= $d) { $num /= 10; $f *= 10; } return int($num + 0.5) * $f; }

DB Table as a Hash

$stmt = 'SELECT Field1, Field2 FROM Table'; $href = { map { @$_ } @{$dbh->selectall_arrayref($stmt)} }; # Returns: # $href = { # Row1Field1 => Row1Field2, # Row2Field1 => Row2Field2, # ... # };

This is not the same as fetchall_hashref/selectall_hashref:

$stmt = 'SELECT Field1, Field2 FROM Table'; $href = $dbh->selectall_hashref($stmt, 'Field1'); # Returns: # $href = { # Row1Field1 => { Field1 => Row1Field1, Field2 => Row1Field2 }, # Row2Field1 => { Field1 => Row2Field1, Field2 => Row2Field2 }, # ... # };

Serializing a List

# Serializes an array, a hash or a list which contains only # strings and undefs. Everything else will be stringified. # Use FreezeThaw for more complicated structures. sub serialize_string_list { return join('|', map { (defined($_) ? do { local $_=$_; s/\^/^1/g; s/\|/^2/g; $_ } : '^0' ) } @_ ); } # Deserializes a list serialized with serialize_string_list. sub deserialize_string_list { return map { ($_ eq '^0' ? undef : do { local $_=$_; s/\^2/|/g; s/\^1/^/g; $_ } ) } split(/\|/, $_[0]); }

For example,
serialize_string_list('apple' => 'red', 'junk'  => '^|^|^|^', 'undef' => undef);
returns
apple|red|junk|^1^2^1^2^1^2^1|undef|^0

I didn't use a single-character escape mechanism (such as preceeding metacharacters with a slash) since it makes deserialization hard. (i.e. "Should I split on this pipe, or is that an escaped pipe?") The escape mechanism I used -- replacing the seperator character with another character -- avoids that problem, simplifying parsing. IP over Serial Line (SLIP) and maybe Point to Point Protocol (PPP) use a similar escaping algorithm to escape packet delimiters because the delimiters cannot appear inside a packet.


State Passing in CGI Via Hidden Fields

# Untested. use CGI; $q = new CGI(); # Input. my $num1 = $q->param('num1'); my $num2 = $q->param('num2'); $num1 = undef if ($q->param{'clear_num1'}); $num2 = undef if ($q->param{'clear_num2'}); # Validate. $num1 = undef unless (defined($num1) && $num1 =~ /^\d+$/); $num2 = undef unless (defined($num2) && $num2 =~ /^\d+$/); # Start HTML. print($q->header()); print($q->start_html(-title=>'Price guide')); print($q->start_form()); # Display num1 and operations for num1. print('First number: '); if (defined($num1)) { print($num1, $q->hidden(-name=>'num1', -default=>$num1)); print(' '); print($q->submit(-name=>'clear_num1', -value=>'Clear'); } else { print($q->textfield(-name=>'num1')); } print($q->br); # Display num2 and operations for num2. print('Second number: '); if (defined($num2)) { print($num2, $q->hidden(-name=>'num2', -default=>$num2)); print(' '); print($q->submit(-name=>'clear_num2', -value=>'Clear'); } else { print($q->textfield(-name=>'num2')); } print($q->br); print($q->submit()); # End HTML. print($q->end_form()); print($q->end_html());

Flushing a File Handle

sub flush { my $h = select($_[0]); my $af=$|; $|=1; $|=$af; select($h); }

IO::Handle also has a flush method.


Returning an lvalue

package MyStruct; sub new { my $class = shift(@_); return bless({@_}, $class); } sub Counter : lvalue { my $self = shift(@_); $self->{'Counter'} = $_[0] if (scalar(@_)); $self->{'Counter'} } package main; { my $x = MyStruct->new(Counter=>0); print($x->Counter, "\n"); # 0 $x->Counter($x->Counter + 1); print($x->Counter, "\n"); # 1 $x->Counter = $x->Counter + 1; print($x->Counter, "\n"); # 2 ++($x->Counter); print($x->Counter, "\n"); # 3 ++$x->Counter; print($x->Counter, "\n"); # 4 $x->Counter++; print($x->Counter, "\n"); # 5 $x->Counter += 1; print($x->Counter, "\n"); # 6 }

return $var does not return an lvalue, even if the lvalue attribute is present. That means if (condition) { return $var; } won't work as expected. However, condition ? $var1 : $var2 at the end of the function does return an lvalue as expected (if the lvalue attribute is present).


Redirecting STDIN and STDOUT to a string

# This \$var syntax of open() requires Perl 5.8.0 or higher. use 5.8.0; my $input = "test\nfoo\nbar\n"; my $output; { local *STDIN; open(STDIN, '<', \$input) or die("Can't open string for reading.\n"); local *STDOUT; open(STDOUT, '>', \$output) or die("Can't open string for writing.\n"); print while (<STDIN>); } print("\$output contains:\n$output");

Command Prompt Here

The following is file Add 'Open Command Prompt Here' to directories.reg (for Win2k and WinXP). Once you merge this into your registry, you can right-click on any folder or drive icon in Explorer to open a command prompt with that directory as the current directory (although you may start on the wrong drive). To use the directory currently being viewed, right-click on the system menu (the top left icon) of the Explorer window.

Windows Registry Editor Version 5.00 [HKEY_CLASSES_ROOT\Directory\shell\cmd] @="Open &Command Prompt Here" [HKEY_CLASSES_ROOT\Directory\shell\cmd\command] @="cmd.exe /k \"cd %L\"" [HKEY_CLASSES_ROOT\Drive\shell\cmd] @="Open &Command Prompt Here" [HKEY_CLASSES_ROOT\Drive\shell\cmd\command] @="cmd.exe /k \"cd %L\""

Bypassing Prototypes

use strict; use warnings; sub test ($;$$$) { shift(@_) unless ($_[0] =~ /^\d/); printf("test %d: %s\n", @_[0,1]); } my @extra_args = qw( bypassed foo bar ); test(1, @extra_args); &test(2, @extra_args); { local @_ = (3, @extra_args); &test; } &{\&test}(4, @extra_args); main->test(5, @extra_args); __END__ output ====== test 1: 3 test 2: bypassed test 3: bypassed test 4: bypassed test 5: bypassed

Logging and Analysing Performance Counters in Windows

Check out 389211 and Win32::PerfLib


Textbook Case for the Use of the Schwartzian Transform

@status = sort { my $mtime_a = (stat("$target_dir\\$a"))[9]; my $mtime_b = (stat("$target_dir\\$b"))[9]; $mtime_a <=> $mtime_b } @status;

is very expensive because stat can be called multiple times for each file. The workaround is:

@status = ( map { $_->[0] } sort { $a->[1] <=> $b->[1] } map { [ $_, stat("$target_dir\\$_"))[9] ] } @status );

Parsing


Transposing an Array of Strings

use Alorithm::Loops; sub transpose_AoS { # [ [ # 'aeh', # 'abcd', 'bfi', # 'efg', ==> 'cgj', # 'hijkl', 'd k', # ' l', # ] ] return [ MapCarU { join('', map { defined($_) ? $_ : ' ' } @_) } map { [ /(.)/sg ] } @{$_[0]} ]; }

A Bug in use warnings;

use strict; use warnings; my $p = undef; my $a = $p->[0]; ## Gives no warnings!! my $q = undef; my $b = ${$q}[0]; ## Gives no warnings!!

This is not a bug. It's a case of auto-vivification. If you observe $p and $q after executing the above, you'll notice they now have values:

... print("$p\n"); # ARRAY(0x1abefa0) print("$q\n"); # ARRAY(0x1abf054)

I wish there was a means of turning off auto-vivification.


Symtab Exploration

Finding All Packages with a Specified Subroutine
# Create some subroutines to find: sub PACKAGEA::PACKAGEB::test {} sub PACKAGED::test {} sub test {} # Create some packages without the subroutine: $PACKAGEA::PACKAGEB::PACKAGEC::ANYVAR = 1; $PACKAGEE::ANYVAR = 1; sub find_sub { my ($sub_name) = @_; my @pkgs_with_sub; my $helper; # $helper must be initialized seperately from its definition. $helper = sub { my ($pkg_name) = @_; my $pkg = do { no strict 'refs'; \%{$pkg_name.'::'} }; push(@pkgs_with_sub, $pkg_name) if $pkg->{$sub_name} && *{$pkg->{$sub_name}}{CODE}; my $pkg_name_ = ($pkg_name eq 'main' ? '' : $pkg_name.'::' ); /^(.*)::$/ && $1 ne 'main' && &$helper($pkg_name_.$1) foreach (keys(%$pkg)); }; &$helper('main'); return @pkgs_with_sub; } print(join(', ', check_for_sub('test')), $/); # Prints "main, PACKAGEA::PACKAGEB, PACKAGED"

Symtab Exploration

Checking If a List of Packages Exist
# Create some packages for testing: $PACKAGEA::ANYVAR = 1; $PACKAGEA::PACKAGEB::VARANY = 1; foreach (qw( PACKAGEA PACKAGEA::PACKAGEB PACKAGEC )) { my @pkg; my $pkg; @pkg = split(/::/, $_); $pkg = \%main::; $pkg = $pkg->{shift(@pkg).'::'} while ($pkg && scalar(@pkg)); print($_, ' ', $pkg ? 'exists' : 'doesn\'t exist', "\n"); } __END__ output: ======= PACKAGEA exists PACKAGEA::PACKAGEB exists PACKAGEC doesn't exist

Symtab Exploration

Listing Subpackages of a Specified Package
# Create some packages for testing: $PACKAGEA::ANYVAR = 1; $PACKAGEA::PACKAGEB::ANYVAR = 1; $PACKAGEA::PACKAGEB::PACKAGEC::ANYVAR = 1; #my $pkg_name = 'main'; #my $pkg_name = 'PACKAGEA::PACKAGEB'; my $pkg_name = 'Authorizations'; my @pkg; my $pkg; @pkg = split(/::/, $pkg_name); $pkg = \%main::; $pkg = $pkg->{shift(@pkg).'::'} while ($pkg && scalar(@pkg)); $pkg or die("Package ${pkg_name} doesn't exist.\n"); $, = "\n"; print( map { substr($_, 0, -2) } ( grep { substr($_, -2) eq '::' } ( keys(%$pkg) ) ) ); __END__ output for $pkg_name eq 'main': =============================== attributes DB UNIVERSAL <none> DynaLoader Win32 IO CORE main

IE's Handling of <FONT COLOR>

Without semicolon:
a t   d e m e p h q
---
With semicolon:
a t   d e m e p h q
---
Removed first digit and replaced semicolon with zero:
a t   d e m e p h q

It appears that IE does:

$color = substr($color, -6); $color .= '0' x length(6-$color); $color =~ s/[^0-9A-Fa-f]/0/g; $color = hex($color);

Thus,
color="amanda"
is interpreted as:
color="#A0A0DA"


C String Assignments

// K&R C: char string[6] = "hello"; // Initializes string[] to "hello\0". char chars[5] = "hello"; // ERROR at compile-time. // ANSI C: char string[6] = "hello"; // Initializes string[] to "hello\0". char chars[5] = "hello"; // Initializes chars[] to "hello". char bad[4] = "hello"; // ERROR. Only a trailing nul can be cut. // Not the same. char a1[6] = "hello"; char *a2 = "hello"; a1[0] = 'H'; // OK a2[0] = 'H'; // ERROR a1 = "Greetings"; // ERROR a2 = "Greetings"; // OK
Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others about the Monastery: (14)
As of 2015-09-03 21:02 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My preferred temperature scale is:










    Results (125 votes), past polls