Beefy Boxes and Bandwidth Generously Provided by pair Networks
Come for the quick hacks, stay for the epiphanies.
 
PerlMonks  

ikegami's scratchpad

by ikegami (Patriarch)
on Aug 16, 2004 at 23:32 UTC ( [id://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 $min = $_[3] // 0; my $max = $_[4] // $#$array; my $min = 0; my $max = $#$array; return -1 if $max == -1; my $ap = do { no strict 'refs'; \*{caller().'::a'} }; local *$ap; my $bp = do { no strict 'refs'; \*{caller().'::b'} }; local *$bp; *$ap = \($_[1]); while ($min <= $max) { my $mid = int(($min+$max)/2); *$bp = \($array->[$mid]); my $cmp = $compare->() or return $mid; if ($cmp < 0) { $max = $mid - 1; } else { $min = $mid + 1; } } return _unsigned_to_signed(~$min); } 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
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others meditating upon the Monastery: (2)
As of 2024-03-19 06:31 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found