= Perl Programming =

[[TableOfContents()]]

== Ultra-simple TCP Socket Server ==

Sometimes you just want to know that a connection is being made:

{{{
perl -MIO::Socket::INET -e '
  $s = IO::Socket::INET->new( Listen => 5, LocalAddr => 'localhost', LocalPort => 12345, Proto => 'tcp' );
  while ( push @c, $s->accept() ) { print "got connect\n"; }
'
}}}

Pushing onto {{{@c}}} keeps the connection alive (otherwise it is closed when it goes out of scope). Nothing whatsoever is done with the connection. This can be useful for doing tests like checking if a connection is being made, or checking what happens when a connection can be made but the server then fails to respond (checking post-connection timeout conditions).

To test the actual connection the result of {{{$s->accept()}}} could be used (ie using {{{send}}}/{{{recv}}}).

== Module introspection ==

You can inspect the namespace of an imported module, for example:

{{{
$ perl -MLWP::UserAgent -d -e 1

Loading DB routines from perl5db.pl version 1.32
Editor support available.

Enter h or `h h' for help, or `man perldebug' for more help.

main::(-e:1):   1
  DB<1> x \%{'LWP::UserAgent::'}
0  HASH(0x9dee070)
   'BEGIN' => *LWP::UserAgent::BEGIN
   'ISA' => *LWP::UserAgent::ISA
   'VERSION' => *LWP::UserAgent::VERSION
   '__ANON__[/usr/share/perl5/LWP/UserAgent.pm:608]' => *LWP::UserAgent::__ANON__[/usr/share/perl5/LWP/UserAgent.pm:608]
   '__ANON__[/usr/share/perl5/LWP/UserAgent.pm:611]' => *LWP::UserAgent::__ANON__[/usr/share/perl5/LWP/UserAgent.pm:611]
   '__ANON__[/usr/share/perl5/LWP/UserAgent.pm:632]' => *LWP::UserAgent::__ANON__[/usr/share/perl5/LWP/UserAgent.pm:632]
   '__ANON__[/usr/share/perl5/LWP/UserAgent.pm:635]' => *LWP::UserAgent::__ANON__[/usr/share/perl5/LWP/UserAgent.pm:635]
   '__ANON__[/usr/share/perl5/LWP/UserAgent.pm:735]' => *LWP::UserAgent::__ANON__[/usr/share/perl5/LWP/UserAgent.pm:735]
   '_agent' => *LWP::UserAgent::_agent
   '_need_proxy' => *LWP::UserAgent::_need_proxy
   '_new_response' => *LWP::UserAgent::_new_response
   '_process_colonic_headers' => *LWP::UserAgent::_process_colonic_headers
   'add_handler' => *LWP::UserAgent::add_handler
   'agent' => *LWP::UserAgent::agent
   'clone' => *LWP::UserAgent::clone
   'conn_cache' => *LWP::UserAgent::conn_cache
   'cookie_jar' => *LWP::UserAgent::cookie_jar
   'credentials' => *LWP::UserAgent::credentials
   'default_header' => *LWP::UserAgent::default_header
   'default_headers' => *LWP::UserAgent::default_headers
   'env_proxy' => *LWP::UserAgent::env_proxy
   'from' => *LWP::UserAgent::from
   'get' => *LWP::UserAgent::get
   'get_basic_credentials' => *LWP::UserAgent::get_basic_credentials
   'get_my_handler' => *LWP::UserAgent::get_my_handler
   'handlers' => *LWP::UserAgent::handlers
   'head' => *LWP::UserAgent::head
   'import' => *LWP::UserAgent::import
   'is_protocol_supported' => *LWP::UserAgent::is_protocol_supported
   'local_address' => *LWP::UserAgent::local_address
   'max_redirect' => *LWP::UserAgent::max_redirect
   'max_size' => *LWP::UserAgent::max_size
   'mirror' => *LWP::UserAgent::mirror
   'new' => *LWP::UserAgent::new
   'no_proxy' => *LWP::UserAgent::no_proxy
   'parse_head' => *LWP::UserAgent::parse_head
   'post' => *LWP::UserAgent::post
   'prepare_request' => *LWP::UserAgent::prepare_request
   'progress' => *LWP::UserAgent::progress
   'protocols_allowed' => *LWP::UserAgent::protocols_allowed
   'protocols_forbidden' => *LWP::UserAgent::protocols_forbidden
   'proxy' => *LWP::UserAgent::proxy
   'redirect_ok' => *LWP::UserAgent::redirect_ok
   'remove_handler' => *LWP::UserAgent::remove_handler
   'request' => *LWP::UserAgent::request
   'requests_redirectable' => *LWP::UserAgent::requests_redirectable
   'run_handlers' => *LWP::UserAgent::run_handlers
   'send_request' => *LWP::UserAgent::send_request
   'set_my_handler' => *LWP::UserAgent::set_my_handler
   'show_progress' => *LWP::UserAgent::show_progress
   'simple_request' => *LWP::UserAgent::simple_request
   'timeout' => *LWP::UserAgent::timeout
   'use_alarm' => *LWP::UserAgent::use_alarm
   'use_eval' => *LWP::UserAgent::use_eval
  DB<2> 
}}}

=== Determining specific types of the values in the namespace ===

Functions:
{{{
  DB<1> %ns = %{'LWP::UserAgent::'}
  DB<4> p join ", ", grep { defined &{$ns{$_}} } keys %ns
run_handlers, set_my_handler, post, default_headers, prepare_request, credentials, clone, requests_redirectable, timeout, new, parse_head, request, send_request, head, _new_response, conn_cache, protocols_forbidden, show_progress, _need_proxy, no_proxy, protocols_allowed, local_address, use_eval, get_basic_credentials, remove_handler, proxy, max_size, add_handler, mirror, get_my_handler, simple_request, from, get, env_proxy, _agent, max_redirect, redirect_ok, progress, use_alarm, handlers, default_header, _process_colonic_headers, is_protocol_supported, agent, cookie_jar
}}}

Scalars:
{{{
  DB<5> p join ", ", grep { defined ${$ns{$_}} } keys %ns
VERSION
}}}

Arays:
{{{
  DB<7> p join ", ", grep { defined @{$ns{$_}} } keys %ns
ISA
}}}

=== Another example - not in the debugger ===

Source:
{{{
use strict;
use warnings;

package wibble;
use vars qw($apple @fish %moose);
our $cat_undefined;
our $cat_defined = "meow";
my $hiddenval = 42;

package main;
use Data::Dumper;

my %b_ns = do { no strict "refs"; %{"wibble::"} };

print Dumper(\%b_ns);
print "\n";
print "wibble::apple exists: " . do { exists $b_ns{apple} ? 'yes' : 'no' } . "\n";
print "wibble::hiddenval exists: " . do { exists $b_ns{hiddenval} ? 'yes' : 'no' } . "\n";
print "\n";
print '$wibble::apple defined: ' . do { defined $wibble::apple ? 'yes' : 'no' } . "\n";
print '@wibble::apple defined: ' . do { defined @wibble::apple ? 'yes' : 'no' } . "\n";
print '%wibble::apple defined: ' . do { defined %wibble::apple ? 'yes' : 'no' } . "\n";
print '*wibble::apple defined: ' . do { defined *wibble::apple ? 'yes' : 'no' } . "\n";
print "\n";
print '$wibble::cat_defined defined: ' . do { defined $wibble::cat_defined ? 'yes' : 'no' } . "\n";
print '@wibble::cat_defined defined: ' . do { defined @wibble::cat_defined ? 'yes' : 'no' } . "\n";
print '%wibble::cat_defined defined: ' . do { defined %wibble::cat_defined ? 'yes' : 'no' } . "\n";
print '*wibble::cat_defined defined: ' . do { defined *wibble::cat_defined ? 'yes' : 'no' } . "\n";
}}}

Output:
{{{
$VAR1 = {
          'apple' => *wibble::apple,
          'cat_undefined' => *wibble::cat_undefined,
          'BEGIN' => *wibble::BEGIN,
          'cat_defined' => *wibble::cat_defined,
          'moose' => *wibble::moose,
          'fish' => *wibble::fish
        };

wibble::apple exists: yes
wibble::hiddenval exists: no

$wibble::apple defined: no
@wibble::apple defined: no
%wibble::apple defined: no
*wibble::apple defined: yes

$wibble::cat_defined defined: yes
@wibble::cat_defined defined: no
%wibble::cat_defined defined: no
*wibble::cat_defined defined: yes
}}}