diff --git a/1590594541-1/Chapter03/charcount b/1590594541-1/Chapter03/charcount new file mode 100644 index 0000000..9f5b81e --- /dev/null +++ b/1590594541-1/Chapter03/charcount @@ -0,0 +1,68 @@ +#!/usr/bin/perl +# +# prints the line number and the number of consonants, vowels and special +# characters found on each line of the filename given as an argument. + +use strict; +use FileHandle; + +my $file = $ARGV[0] || ''; +my $verbose = $ARGV[1] || 0; + +unless (-f $file) { + die("Usage: $0 filename [-v]"); +} +my $FH = FileHandle->new("< $file") or die("unable to open file($file): $!"); + +my $i_cnt = 0; +my $i_cons = 0; +my $i_vows = 0; +my $i_spec = 0; + +# parse the file +while (<$FH>) { + my $line = $_; + $i_cons += my $cons = &parse($line, '[bcdfghjklmnpqrstvwxyz]'); + $i_vows += my $vows = &parse($line, '[aeiou]'); + $i_spec += my $spec = &parse($line, '[^a-zA-Z0-9\s]'); + $DB::trace = 0; + print sprintf('%6d', $i_cnt).':'. + ' hard'.('.'x(8-length($cons))).$cons. + ' soft'.('.'x(8-length($vows))).$vows. + ' spec'.('.'x(8-length($spec))).$spec; + print $verbose ? " $line\n" : "\n"; + $i_cnt++; +} + +print ' total:'. + ' hard'.(' 'x(8-length($i_cons))).$i_cons. + ' soft'.(' 'x(8-length($i_vows))).$i_vows. + ' spec'.(' 'x(8-length($i_spec))).$i_spec. + "\n"; + +sub parse { + my $str = shift; + my $reg = shift; + my $cnt = my @cnt = ($str =~ /($reg)/g); + return $cnt; +} + +exit 0; + +__END__ + +=head1 NAME + +charcount - display lineinfo on input files + +=head1 SYNOPSIS + + charcount inputfilename + +=head1 DESCRIPTION + +Prints the line number, followed by the number of consonents, vowels and +special characters found on each line of the filename given as an argument. + +=cut + diff --git a/1590594541-1/Chapter03/walrus b/1590594541-1/Chapter03/walrus new file mode 100644 index 0000000..5376f0e --- /dev/null +++ b/1590594541-1/Chapter03/walrus @@ -0,0 +1,128 @@ +The Walrus and The Carpenter by Lewis Carroll. + +The sun was shining on the sea, +Shining with all his might: +He did his very best to make +The billows smooth and bright +And this was odd, because it was +The middle of the night. + +The moon was shining sulkily, +Because she thought the sun +Had got no business to be there +After the day was done +"It's very rude of him," she said, +"To come and spoil the fun!" + +The sea was wet as wet could be, +The sands were dry as dry. +You could not see a cloud, because +No cloud was in the sky: +No birds were flying overhead +There were no birds to fly. + +The Walrus and the Carpenter +Were walking close at hand; +They wept like anything to see +Such quantities of sand: +"If this were only cleared away," +They said, "it would be grand!" + +"If seven maids with seven mops +Swept it for half a year. +Do you suppose," the Walrus said, +"That they could get it clear?" +"I doubt it," said the Carpenter, +And shed a bitter tear. + +"O Oysters, come and walk with us!" +The Walrus did beseech. +"A pleasant walk, a pleasant talk, +Along the briny beach: +We cannot do with more than four, +To give a hand to each." + +The eldest Oyster looked at him, +But never a word he said: +The eldest Oyster winked his eye, +And shook his heavy head +Meaning to say he did not choose +To leave the oyster-bed. + +But four young Oysters hurried up, +All eager for the treat: +Their coats were brushed, their faces washed, +Their shoes were clean and neat +And this was odd, because, you know, +They hadn't any feet. + +Four other Oysters followed them, +And yet another four; +And thick and fast they came at last, +And more, and more, and more +All hopping through the frothy waves, +And scrambling to the shore. + +The Walrus and the Carpenter +Walked on a mile or so, +And then they rested on a rock +Conveniently low: +And all the little Oysters stood +And waited in a row. + +"The time has come," the Walrus said, +"To talk of many things: +Of shoes and ships and sealing-wax +Of cabbages and kings +And why the sea is boiling hot +And whether pigs have wings." + +"But wait a bit," the Oysters cried, +"Before we have our chat; +For some of us are out of breath, +And all of us are fat!" +"No hurry!" said the Carpenter. +They thanked him much for that. + +"A loaf of bread," the Walrus said, +"Is what we chiefly need: +Pepper and vinegar besides +Are very good indeed +Now if you're ready, Oysters dear, +We can begin to feed." + +"But not on us!" the Oysters cried, +Turning a little blue. +"After such kindness, that would be +A dismal thing to do!" +"The night is fine," the Walrus said. +"Do you admire the view? + +"It was so kind of you to come! +And you are very nice!" +The Carpenter said nothing but +"Cut us another slice: +I wish you were not quite so deaf +I've had to ask you twice!" + +"It seems a shame," the Walrus said, +"To play them such a trick, +After we've brought them out so far, +And made them trot so quick!" +The Carpenter said nothing but +"The butter's spread too thick!" + +"I weep for you," the Walrus said: +"I deeply sympathize." +With sobs and tears he sorted out +Those of the largest size, +Holding his pocket-handkerchief +Before his streaming eyes. + +"O Oysters," said the Carpenter, +"You've had a pleasant run! +Shall we be trotting home again?' +But answer came there none +And this was scarcely odd, because +They'd eaten every one. + diff --git a/1590594541-1/Chapter04/findvars b/1590594541-1/Chapter04/findvars new file mode 100644 index 0000000..9659a76 --- /dev/null +++ b/1590594541-1/Chapter04/findvars @@ -0,0 +1,70 @@ +#!/usr/bin/perl + +%INC = (); + +use FileHandle; + +map { eval "require $_;" } @ARGV; + +my $regex = $ENV{REGEX} || '[\$\@\%\*]&+'; + +map { $files{$_} = FileHandle->new("< $INC{$_}") } keys %INC; + +&getdata(%files); +&report(%data); + +exit 0; + +sub wanted { + return ($_[0] =~ /$regex/ && $_[0] !~ /^\s*\#/ ? 1 : 0); +} + +sub getdata { + my %files = @_; + foreach my $f (sort keys %files) { + $cnt = 0; + my $fh = $files{$f}; + while (<$fh>) { + ++$cnt; + $data{$f}{$cnt} = $_ if &wanted; + } + } +} + +sub report { + my %data = @_; + foreach my $k (sort keys %data) { + print "\n$k vars:\n"; + foreach my $r (sort { $a <=> $b } keys %{$data{$k}}) { + print "\t[$r]\t$data{$k}{$r}"; + } + } +} + +__END__ + +=head1 NAME + +findvars - display variables in loaded packages + +=head1 SYNOPSIS + + findvars [modulenames]+ + +=head1 DESCRIPTION + +Given a list of module names, find and display all variables found. + +=head1 REGEX + +The regex used to find variables is fairly the clunky: C<[$@%*]> by default. +If you wish to define another one, set the C enviroment variable, +where C is the regular expression to use. + +=head1 NOTES + +Note that although we ignore directly commented out lines, we slurp up C +indiscriminately. + +=cut + diff --git a/1590594541-1/Chapter04/findvars.diff b/1590594541-1/Chapter04/findvars.diff new file mode 100644 index 0000000..20cf257 --- /dev/null +++ b/1590594541-1/Chapter04/findvars.diff @@ -0,0 +1,25 @@ +--- findvars.original 2004-11-07 10:56:17.000000000 +0100 ++++ findvars.fixed 2004-11-07 10:35:06.000000000 +0100 +@@ -4,9 +4,11 @@ + + use FileHandle; + +-map { eval "require $_;" } @ARGV; ++map { eval "require $_;" ++ or print STDERR "Warning: unable to require $_: $@" ++} @ARGV; + +-my $regex = $ENV{REGEX} || '[\$\@\%\*]&+'; ++my $regex = $ENV{REGEX} || '[\$\@\%\*\&]+'; + + map { $files{$_} = FileHandle->new("< $INC{$_}") } keys %INC; + +@@ -26,7 +28,7 @@ + my $fh = $files{$f}; + while (<$fh>) { + ++$cnt; +- $data{$f}{$cnt} = $_ if &wanted; ++ $data{$f}{$cnt} = $_ if &wanted($_); + } + } + } diff --git a/1590594541-1/Chapter04/findvars.fixed b/1590594541-1/Chapter04/findvars.fixed new file mode 100644 index 0000000..b37f35e --- /dev/null +++ b/1590594541-1/Chapter04/findvars.fixed @@ -0,0 +1,72 @@ +#!/usr/bin/perl + +%INC = (); + +use FileHandle; + +map { eval "require $_;" + or print STDERR "Warning: unable to require $_: $@" +} @ARGV; + +my $regex = $ENV{REGEX} || '[\$\@\%\*\&]+'; + +map { $files{$_} = FileHandle->new("< $INC{$_}") } keys %INC; + +&getdata(%files); +&report(%data); + +exit 0; + +sub wanted { + return ($_[0] =~ /$regex/ && $_[0] !~ /^\s*\#/ ? 1 : 0); +} + +sub getdata { + my %files = @_; + foreach my $f (sort keys %files) { + $cnt = 0; + my $fh = $files{$f}; + while (<$fh>) { + ++$cnt; + $data{$f}{$cnt} = $_ if &wanted($_); + } + } +} + +sub report { + my %data = @_; + foreach my $k (sort keys %data) { + print "\n$k vars:\n"; + foreach my $r (sort { $a <=> $b } keys %{$data{$k}}) { + print "\t[$r]\t$data{$k}{$r}"; + } + } +} + +__END__ + +=head1 NAME + +findvars - display variables in loaded packages + +=head1 SYNOPSIS + + findvars [modulenames]+ + +=head1 DESCRIPTION + +Given a list of module names, find and display all variables found. + +=head1 REGEX + +The regex used to find variables is fairly the clunky: C<[$@%*]> by default. +If you wish to define another one, set the C enviroment variable, +where C is the regular expression to use. + +=head1 NOTES + +Note that although we ignore directly commented out lines, we slurp up C +indiscriminately. + +=cut + diff --git a/1590594541-1/Chapter04/findvars.original b/1590594541-1/Chapter04/findvars.original new file mode 100644 index 0000000..9659a76 --- /dev/null +++ b/1590594541-1/Chapter04/findvars.original @@ -0,0 +1,70 @@ +#!/usr/bin/perl + +%INC = (); + +use FileHandle; + +map { eval "require $_;" } @ARGV; + +my $regex = $ENV{REGEX} || '[\$\@\%\*]&+'; + +map { $files{$_} = FileHandle->new("< $INC{$_}") } keys %INC; + +&getdata(%files); +&report(%data); + +exit 0; + +sub wanted { + return ($_[0] =~ /$regex/ && $_[0] !~ /^\s*\#/ ? 1 : 0); +} + +sub getdata { + my %files = @_; + foreach my $f (sort keys %files) { + $cnt = 0; + my $fh = $files{$f}; + while (<$fh>) { + ++$cnt; + $data{$f}{$cnt} = $_ if &wanted; + } + } +} + +sub report { + my %data = @_; + foreach my $k (sort keys %data) { + print "\n$k vars:\n"; + foreach my $r (sort { $a <=> $b } keys %{$data{$k}}) { + print "\t[$r]\t$data{$k}{$r}"; + } + } +} + +__END__ + +=head1 NAME + +findvars - display variables in loaded packages + +=head1 SYNOPSIS + + findvars [modulenames]+ + +=head1 DESCRIPTION + +Given a list of module names, find and display all variables found. + +=head1 REGEX + +The regex used to find variables is fairly the clunky: C<[$@%*]> by default. +If you wish to define another one, set the C enviroment variable, +where C is the regular expression to use. + +=head1 NOTES + +Note that although we ignore directly commented out lines, we slurp up C +indiscriminately. + +=cut + diff --git a/1590594541-1/Chapter06/Args.pm b/1590594541-1/Chapter06/Args.pm new file mode 100644 index 0000000..cf9449a --- /dev/null +++ b/1590594541-1/Chapter06/Args.pm @@ -0,0 +1,52 @@ +package Args; +use strict; + +print __FILE__." loaded\n"; + +sub new { + my $class = shift; + print __FILE__." running new()\n"; + my $self = { + _args => require 'getargs', + }; + die("Failed to find 'getargs' $@") unless ref($self->{_args}) eq 'ARRAY'; + bless($self, $class); +} + +sub format { + my $self = shift; + my $index = shift; + print __FILE__." running format()\n"; + my $str; + if ($index eq 'all') { + $str = join("<-\n ->", @{$self->{_args}}); + } elsif ($index =~ /^\d+$/) { + $str = $self->{_args}[$index]; + } else { + print "Error: unrecognised index($index)\n"; + } + return "\n ->$str<-\n"; +} + +1; + +BEGIN { + print __FILE__." begun\n"; +} + +__END__ + +=head1 NAME + +Args.pm - capture the commandline args. + +=head1 SYNOPSIS + + print Args->new->format('all'); + +=head1 DESCRIPTION + +A module to get the commandline arguments + +=cut + diff --git a/1590594541-1/Chapter06/NoArg.pm b/1590594541-1/Chapter06/NoArg.pm new file mode 100644 index 0000000..7af7493 --- /dev/null +++ b/1590594541-1/Chapter06/NoArg.pm @@ -0,0 +1,37 @@ +package NoArg; +use strict; + +require Exporter; +use vars qw(@ISA @EXPORT_OK); +@ISA = qw(Exporter); +@EXPORT_OK = qw(noargs); + +print __FILE__." loaded\n"; + +sub noargs { + print __FILE__." running noargs()\n"; + return (scalar(@_) == 0 ? 1 : 0); +} + +1; + +BEGIN { + print __FILE__." begun\n"; +} + +__END__ + +=head1 NAME + +NoArg.pm - are there any args + +=head1 SYNOPSIS + + print "yup\n" if NoArg::noargs(@ARGV); + +=head1 DESCRIPTION + +Decide if there are any arguments on the commandline + +=cut + diff --git a/1590594541-1/Chapter06/getargs b/1590594541-1/Chapter06/getargs new file mode 100644 index 0000000..b336f08 --- /dev/null +++ b/1590594541-1/Chapter06/getargs @@ -0,0 +1,36 @@ +#!/usr/bin/perl + +use strict; + +print __FILE__." loaded\n"; + +my @ARGS = @ARGV; + +while (@ARGV) { + print __FILE__." running: ".shift(@ARGV)."\n"; +} + +print __FILE__." done\n"; + +\@ARGS; + +BEGIN { + print __FILE__." begun\n"; +} + +__END__ + +=head1 NAME + +getargs - print commandline args + +=head1 SYNOPSIS + + getargs one two three + +=head1 DESCRIPTION + +A module to display the commandline arguments + +=cut + diff --git a/1590594541-1/Chapter06/usereq b/1590594541-1/Chapter06/usereq new file mode 100644 index 0000000..33f8c0c --- /dev/null +++ b/1590594541-1/Chapter06/usereq @@ -0,0 +1,38 @@ +#!/usr/bin/perl + +use strict; +use NoArg qw(noargs); +use FileHandle; + +print __FILE__." loaded\n"; + +if (noargs(@ARGV)) { + print __FILE__." has no arguments\n"; +} else { + require Args; + my $o_args = Args->new; + print __FILE__." arguments: ".$o_args->format('all'); +} + +exit; + +BEGIN { + print __FILE__." begun\n"; +} + +__END__ + +=head1 NAME + +usereq - print the command line args + +=head1 SYNOPSIS + + usereq arg1 argn + +=head1 DESCRIPTION + +A short program used as an entry point to load and run Args.pm + +=cut + diff --git a/1590594541-1/Chapter07/Objects.pm b/1590594541-1/Chapter07/Objects.pm new file mode 100644 index 0000000..d26de6a --- /dev/null +++ b/1590594541-1/Chapter07/Objects.pm @@ -0,0 +1,108 @@ +package Object; + +use strict; +use vars qw($AUTOLOAD); + +sub new { + my $class = shift; + bless { + _name => ref($class) || $class, + _desc => 'A thing', + _unknown => 'unknown attribute', + }, $class; +} + +sub AUTOLOAD { + my $self = shift; + return if $AUTOLOAD =~ /DESTROY/; + my $attr = $AUTOLOAD; + $attr =~ s/^.+?([a-zA-Z]+)$/$1/; + return ($self->{"_$attr"} || $self->{_unknown}.": $attr"); +} + +1; + +package Book; + +use strict; +use base qw(Object); +$Book::VERSION = "1.02"; +my $publisher = 'Apress'; + +sub new { + my $class = shift; + my $name = shift; + my $self = Object->new; + $self->{_name} = $name; + $self->{_desc} = 'A book'; + $self->{_contents} = \@_; + $self->{_unknown} = 'unknown book attribute'; + bless $self; +} + +sub linecount { + my $self = shift; + return scalar @{$self->{_contents}}; +} + +1; + +package Fiction; + +use strict; +use base qw(Book); +use vars qw($AUTOLOAD); + +sub new { + my $class = shift; + my $self = Book->new(@_); + $self->{_desc} = 'A story book'; + bless $self; +} + +sub linecount { + return $$; +} + +sub AUTOLOAD { + my $self = shift; + return if $AUTOLOAD =~ /DESTROY/; + my $sub = $AUTOLOAD; + $sub =~ s/.*:://; + if ($sub =~ /^[aeiou]/) { + return "Making this up as we go along($sub)"; + } else { + $sub = "SUPER::$sub"; + return $self->$sub(); + } +} + +1; + +package NonFiction; + +use strict; +use base qw(Book); + +sub new { + my $class = shift; + my $self = Book->new(@_); + $self->{_desc} = 'A true tale'; + $self->{_bibliography} = 'substantial'; + bless $self; +} + +1; + +__END__ + +=head1 NAME + +Objects.pm - several objects + +=head1 DESCRIPTION + +Simple Object packages providing various C-like objects for manipulation. + +=cut + diff --git a/1590594541-1/Chapter07/objects b/1590594541-1/Chapter07/objects new file mode 100644 index 0000000..af19b59 --- /dev/null +++ b/1590594541-1/Chapter07/objects @@ -0,0 +1,42 @@ +#!/usr/bin/perl -w + +use Objects; +use strict; + +unless (@ARGV) { + die("Usage: $0 method [names+]"); +} + +my @contents = ('first line', 'second line', 'third line', 'fourth line'); +foreach my $obj (qw(Object Book NonFiction Fiction)) { + foreach my $meth (qw(name desc linecount), @ARGV) { + my $o_obj = $obj->new("A $obj title", @contents); + eval { + print sprintf('%-25s', ref($o_obj)."->$meth: ").$o_obj->$meth()."\n"; + }; + if ($@) { + print $@; + } + } + print "\n"; +} + +exit 0; + +__END__ + +=head1 NAME + +objects - some object code + +=head1 SYNOPSIS + + objects method_name + +=head1 DESCRIPTION + +Given one or more method names, passes them to each known C, and calls +them in turn, printing out the result. + +=cut + diff --git a/1590594541-1/Chapter09/MyMod.pm b/1590594541-1/Chapter09/MyMod.pm new file mode 100644 index 0000000..b53280d --- /dev/null +++ b/1590594541-1/Chapter09/MyMod.pm @@ -0,0 +1,38 @@ +package MyMod; + +sub handler { + my $r = shift; + + print $r->content_type('text/plain'); + print $r->send_http_header; + print "

A couple of environment variables:

    \n"; + + foreach my $e (qw(SERVER_SOFTWARE MOD_PERL GATEWAY_INTERFACE)) { + $DB::single=2; + print "\t
  • $e: $ENV{$e}\n"; + } + + print "
\n"; +} + +1; # <- satisfy module rules + +__END__ + +=head1 NAME + +MyMod.pm - A mod_perl module + +=head1 SYNOPSIS + + PerlRequire /home/perltut/code/MyMod.pm + PerlHandler MyMod + +=head1 DESCRIPTION + +An apache module to print out several mod_perl or http related environment +variables + +=cut + + diff --git a/1590594541-1/Chapter09/db.pl b/1590594541-1/Chapter09/db.pl new file mode 100644 index 0000000..250de6e --- /dev/null +++ b/1590594541-1/Chapter09/db.pl @@ -0,0 +1,6 @@ +# db.pl + +use Apache::DB; + +Apache::DB->init; + diff --git a/1590594541-1/Chapter09/example.cgi b/1590594541-1/Chapter09/example.cgi new file mode 100644 index 0000000..53d5dbe --- /dev/null +++ b/1590594541-1/Chapter09/example.cgi @@ -0,0 +1,36 @@ +#!/usr/bin/perl -d + +use CGI qw(:standard); + +my $o_cgi = CGI->new(); + +print + header, + start_html('Perl Debugger Tutorial - CGI example'), + "

Params:

    \n" +; + +foreach my $p ($o_cgi->param) { + print "\t
  • $p: ".join(', ', $o_cgi->param($p))."\n"; +} + +print "
\n", end_html; + +exit; + +__END__ + +=head1 NAME + +example.cgi - short cgi program + +=head1 SYNOPSIS + + %> perl -d ./example.cgi this=that this=theother a=param + +=head1 DESCRIPTION + +Print out the parameters given. + +=cut + diff --git a/1590594541-1/Chapter09/httpd.conf b/1590594541-1/Chapter09/httpd.conf new file mode 100644 index 0000000..0ed0ebb --- /dev/null +++ b/1590594541-1/Chapter09/httpd.conf @@ -0,0 +1,16 @@ +# httpd.conf section + +PerlRequire /home/perltut/code/MyMod.pm + + + SetHandler perl-script + PerlHandler MyMod + + + + DocumentRoot /home/perltut/code/ + ServerName perltut + ErrorLog /home/perltut/logs/error_log + CustomLog /home/perltut/logs/access_log common + + diff --git a/1590594541-1/Chapter09/remoteport b/1590594541-1/Chapter09/remoteport new file mode 100644 index 0000000..149b975 --- /dev/null +++ b/1590594541-1/Chapter09/remoteport @@ -0,0 +1,106 @@ +#!/usr/bin/perl -w + +use strict; +use Getopt::Long; +use IO::Socket; +use Term::ReadLine; + +use constant BIGNUM => 65536; + +our $previous_input; + +# Set host and port. +my $host = shift || 'localhost'; +my $port = shift || 12345; # over 1024 please +die("Usage: $0 hostname portno") unless ($host =~ /\w+/ && $port =~ /^\d+$/); +print "listening on $host:$port\n"; + +my $term = new Term::ReadLine 'local prompter'; +my $OUT; +{ + # strict subs complains about STDOUT, so turn it off for the moment. + no strict 'subs'; + $OUT = $term->OUT || STDOUT; +} +$OUT->autoflush(1); + +# Open the socket the debugger will connect to. +my $sock = new IO::Socket::INET( + LocalHost => $host, + LocalPort => $port, + Proto => 'tcp', + Listen => SOMAXCONN, + Reuse => 1); +$sock or die "no socket :$!"; + +my $new_sock = $sock->accept(); + +# Try to pick up the remote hostname for the prompt. +my $remote_host = gethostbyaddr($sock->sockaddr(), AF_INET) || 'remote'; +my $prompt = "($remote_host)> "; + +my ($buf, $input); + +# Read output from the debugger, then read debugger input. +while (1) { + # Drop out if the remote debugger went away. + exit 0 unless sysread($new_sock, $buf, BIGNUM); + print $OUT $buf; + + # Drop out if we got end-of-file locally (warning: this + # causes the remote Perl to drop dead because the socket goes away). + exit 0 unless defined($input = $term->readline($prompt)); + print { $new_sock } munge_input($input); + + # Add the line to the terminal history. + $term->addhistory($input) if $input =~ /\S/; +} + +# The debugger interaction can get all confused if the string it gets +# passed is just a null. We clean this up here. +sub munge_input { + my $actual_input = shift; + $actual_input = "\n" unless $actual_input; +} + +__END__ + +=head1 NAME + +remoteport - connect to a remote Perl debugger + +=head1 SYNOPSIS + + # default to host: localhost and port: 12345 + remoteport + + # specify the same: + remoteport localhost 12345 + + # Use a specific host ip and port: + remoteport 192.168.0.7 17284 + +=head1 DESCRIPTION + +C allows you to set up a remote telnet-like session with a Perl +debugger using the C option. + +You can specify the host (default localhost) and the port (default 12345) you'd +like to use, as in the examples above. + +=head1 NOTES + +Note that this program doesn't attempt to get the correct ip address for you, +but its advantage is that it should run on most machines I. +C is probably the correct module to use, if you wanted +to extend this to handle guessing your ip address correctly, even on Windows +or a Mac. + +Also, remember this is a bit basic and somewhat rough on the edges, so please +be kind. Occassionally it may unexpectedly die on you (in which case just +restart it). Also sometimes you will need to send it an extra newline to get +it to register a command properly; for an example try using C and C. + +Hey, what do you want? It's a demo program, not a production system! + +=cut diff --git a/1590594541-1/Chapter10/debugger.pl b/1590594541-1/Chapter10/debugger.pl new file mode 100644 index 0000000..9ee148f --- /dev/null +++ b/1590594541-1/Chapter10/debugger.pl @@ -0,0 +1,47 @@ +package DB; + +use 5.008000; +use Term::ReadKey; +use strict; + +my $i; + +sub DB::DB { + no strict qw(refs); + my ($p,$f,$l) = caller; + my $line = @{"::_<$f"}[$l] || shift; + print "$f [$l]: $line\n"; + ReadMode(0); + while (1) { + $i++; + print "dbgr <$i> : "; + chomp(my $input = ReadLine(0)); + if ($input eq 'h') { print "h(help) l(print line) n(go to next line) q(quit)" }; + if ($input eq 'l') { print "$f [$1]: $line" }; + if ($input eq 'n') { last }; + if ($input eq 'q') { print "exiting\n"; exit }; + my @res = eval "package $p; $input;\n"; + print "\n"; + } +} + +1; + +=head1 Name + +debugger - an extremely rudimentary alternative + +=head1 Usage + +=over 4 + +=item PERL5DB="BEGIN {require 'debugger.pl'}" perl -d program args + +... + +=head1 AUTHOR + +Richard Foley, Edebugger.example@rfi.net + +=cut + diff --git a/1590594541-1/Chapter10/forker b/1590594541-1/Chapter10/forker new file mode 100644 index 0000000..d5c957f --- /dev/null +++ b/1590594541-1/Chapter10/forker @@ -0,0 +1,68 @@ +#!/usr/bin/perl + +use strict; +use POSIX ':sys_wait_h'; + +my $DEBUG = $ENV{DEBUG} || 0; +my $file = $ARGV[0] || ''; +my $count = $ARGV[1] || 10; +die("Usage: $0 filename [divisor]") unless -r $file && $count =~ /^\d+$/; + +$|=1; + +$SIG{CHLD} = 'IGNORE'; +sub process { print length($_[0]).($DEBUG?"\t->@_<-\n":"\t") }; + +my ($tot) = grep(/\S+/, split(/\s+/, `wc $file`)); +my $num = sprintf('%d', $tot / $count); +print "$file: splitting $tot lines into $count main chunks of $num lines\n"; + +open(FH, "< $file") or die("$0 unable to open file: $file $!"); +print "$file: opened...\n"; +my @lines; +my $pid = 1; + +while () { + push(@lines, $_); + if ((scalar(@lines) == $num) || eof FH) { + chomp(@lines); + my $processid; + if ($processid = fork) { + $pid++; + print "[$$] passed ".@lines." lines to number $pid($processid) for processing\n"; + waitpid($processid, WNOHANG); + @lines = (); + } else { + die "$0 cannot fork: $!" unless defined $processid; + sleep 3; # short pause + print "Process [$pid] $$ processing ".@lines." lines...\n"; + foreach my $line (@lines) { + process($line); + } + print "\n" unless $DEBUG; + exit 0; + } + } +} + +close FH && print "$file: closed => $0($$) done\n"; + +exit 0; + +__END__ + +=head1 NAME + +forker - Perl program using fork + +=head1 SYNOPSIS + + %> perl ./forker inputfilename 3 + +=head1 DESCRIPTION + +A program which takes a filename and splits it into the optionally given number +(or 10) chunks for manipulation via that many forked process. + +=cut + diff --git a/1590594541-1/Chapter10/poe b/1590594541-1/Chapter10/poe new file mode 100644 index 0000000..caac50a --- /dev/null +++ b/1590594541-1/Chapter10/poe @@ -0,0 +1,90 @@ +#!/usr/bin/perl + +use strict; +use POE; + +my $DEBUG = $ENV{DEBUG} || 0; +my $file = $ARGV[0] || ''; +my $count = $ARGV[1] || 10; + +die("Usage: $0 filename [divisor]") unless -r $file && $count =~ /^\d+$/; + +sub process { print length($_[0]).($DEBUG?"\t->@_<-\n":"\t") }; + +sub _start { + my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION]; + my $sid = $session->ID; + my @lines = @_[ARG0..$#_]; + $kernel->yield('dosession' => @lines); +} + +sub anewsession { + my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION]; + my $sid = $session->ID; + my @lines = @_[ARG0..$#_]; + print "Session $sid processing ".@lines." lines\n"; + $DB::single=2 if $sid =~ /[3579]$/; + foreach my $line (@lines) { + process($line); + } + print "\n" unless $DEBUG; +} + +my ($tot) = grep(/\S+/, split(/\s+/, `wc $file`)); +my $num = sprintf('%d', $tot / $count); +print "$file: splitting $tot lines into $count main chunks of $num lines\n"; + +open(FH, "< $file") or die("$0 unable to open file: $file $!"); +print "$file: opened...\n"; + +my @lines; +my $i_cnt; + +while () { + push(@lines, $_); + if ((scalar(@lines) == $num) || eof FH) { + chomp(@lines); + my $session = POE::Session->create( + inline_states => { + _start => \&_start, + dosession => \&anewsession, + }, + args => \@lines, + ); + @lines = (); + } +} + +close FH && print "$file: closed => $0($$) done\n"; + +POE::Kernel->run(); + +exit 0; + +__END__ + +=head1 NAME + +poe - Perl program using POE + +=head1 SYNOPSIS + + %> perl ./poe inputfilename 3 + +=head1 DESCRIPTION + +A program which takes a filename and splits it into the optionally given number +(or 10) chunks for manipulation via that many POE sessions. + +=cut + +for (1..$n) { + POE::Session->create( + inline_states => { + _start => \&_start, + dosession => \&anewsession(@lines), + _stop => \&_stop, + } + ); +} + diff --git a/1590594541-1/Chapter10/threads b/1590594541-1/Chapter10/threads new file mode 100644 index 0000000..d422d63 --- /dev/null +++ b/1590594541-1/Chapter10/threads @@ -0,0 +1,63 @@ +#!/opt/perlthreads/bin/perl -dt + +use strict; +use threads; + +my $DEBUG = $ENV{DEBUG} || 0; +my $file = $ARGV[0] || ''; +my $count = $ARGV[1] || 10; +die("Usage: $0 filename [divisor]") unless -r $file && $count =~ /^\d+$/; + +sub process { print length($_[0]).($DEBUG?"\t->@_<-\n":"\t") }; + +sub anewthread { + my @lines = @_; + my $tid = threads->self->tid; + $DB::single=2 if $tid =~ /[3579]$/; + print "Thread [$tid] processing ".@lines." lines\n"; + foreach my $line (@lines) { + process($line); + } + print "\n" unless $DEBUG; +} + +my ($tot) = grep(/\S+/, split(/\s+/, `wc $file`)); +my $num = sprintf('%d', $tot / $count); +print "$file: splitting $tot lines into $count main chunks of $num lines\n"; + +open(FH, "< $file") or die("$0 unable to open file: $file $!"); +print "$file: opened...\n"; + +my @lines; +my $i_cnt; + +while () { + push(@lines, $_); + if ((scalar(@lines) == $num) || eof FH) { + chomp(@lines); + my $t = threads->create('anewthread', @lines); + @lines = (); + } +} + +close FH && print "$file: closed => $0($$) done\n"; + +exit 0; + +__END__ + +=head1 NAME + +threads - Perl program using threads + +=head1 SYNOPSIS + + %> perl ./threads inputfilename 3 + +=head1 DESCRIPTION + +A program which takes a filename and splits it into the optionally given number +(or 10) chunks for manipulation via that many threaded process. + +=cut + diff --git a/1590594541-1/Chapter11/regex.pl b/1590594541-1/Chapter11/regex.pl new file mode 100644 index 0000000..e69de29 diff --git a/1590594541-1/Chapter13/direct_or_dereference b/1590594541-1/Chapter13/direct_or_dereference new file mode 100644 index 0000000..adc19c7 --- /dev/null +++ b/1590594541-1/Chapter13/direct_or_dereference @@ -0,0 +1,24 @@ +#!/usr/bin/perl + +use Benchmark; + +my $o_ref = { + 'two' => 2, + 'five' => 3, +}; + +timethese($ARGV[0] || 1000000, { + 'direct' => "&direct()", + 'dereference' => "&dereference()", +}); + +sub direct { + my $x = $o_ref->{'two'} + $o_ref->{'five'}; +} + +sub dereference { + my $one = $o_ref->{'two'}; + my $two = $o_ref->{'five'}; + my $x = $one + $two; +} + diff --git a/1590594541-1/README.txt b/1590594541-1/README.txt new file mode 100644 index 0000000..95b3fa8 --- /dev/null +++ b/1590594541-1/README.txt @@ -0,0 +1,4 @@ + +There are no specific instructions to run the code beyond those described in +the book, and a working Perl interpreter. + diff --git a/2218.pdf b/2218.pdf new file mode 100644 index 0000000..6fa4017 Binary files /dev/null and b/2218.pdf differ diff --git a/9781590594544.jpg b/9781590594544.jpg new file mode 100644 index 0000000..7dca881 Binary files /dev/null and b/9781590594544.jpg differ diff --git a/LICENSE.txt b/LICENSE.txt new file mode 100644 index 0000000..7ba0ca2 --- /dev/null +++ b/LICENSE.txt @@ -0,0 +1,27 @@ +Freeware License, some rights reserved + +Copyright (c) 2005 Andy Lester and Richard Foley + +Permission is hereby granted, free of charge, to anyone obtaining a copy +of this software and associated documentation files (the "Software"), +to work with the Software within the limits of freeware distribution and fair use. +This includes the rights to use, copy, and modify the Software for personal use. +Users are also allowed and encouraged to submit corrections and modifications +to the Software for the benefit of other users. + +It is not allowed to reuse, modify, or redistribute the Software for +commercial use in any way, or for a user’s educational materials such as books +or blog articles without prior permission from the copyright holder. + +The above copyright notice and this permission notice need to be included +in all copies or substantial portions of the software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS OR APRESS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. + + diff --git a/README.md b/README.md new file mode 100644 index 0000000..dff1369 --- /dev/null +++ b/README.md @@ -0,0 +1,15 @@ +#Apress Source Code + +This repository accompanies [*Pro Perl Debugging*](http://www.apress.com/9781590594544) by Andy Lester and Richard Foley (Apress, 2005). + +![Cover image](9781590594544.jpg) + +Download the files as a zip using the green button, or clone the repository to your machine using Git. + +##Releases + +Release v1.0 corresponds to the code in the published book, without corrections or updates. + +##Contributions + +See the file Contributing.md for more information on how you can contribute to this repository. diff --git a/contributing.md b/contributing.md new file mode 100644 index 0000000..f6005ad --- /dev/null +++ b/contributing.md @@ -0,0 +1,14 @@ +# Contributing to Apress Source Code + +Copyright for Apress source code belongs to the author(s). However, under fair use you are encouraged to fork and contribute minor corrections and updates for the benefit of the author(s) and other readers. + +## How to Contribute + +1. Make sure you have a GitHub account. +2. Fork the repository for the relevant book. +3. Create a new branch on which to make your change, e.g. +`git checkout -b my_code_contribution` +4. Commit your change. Include a commit message describing the correction. Please note that if your commit message is not clear, the correction will not be accepted. +5. Submit a pull request. + +Thank you for your contribution! \ No newline at end of file