effective perl programming

by Joseph N. Hall
<joseph@5sigma.com>

Joseph N. Hall is the author of Effective Perl Programming (Addison-Wesley, 1998). He teaches Perl classes, consults, and plays a lot of golf in his spare time.

Manual SQL (It Rhymes)

You Too Can Write an SQL Client

Lately I've found myself spending an increasing amount of time working with Perl and SQL databases, and sometimes with more than one type of server at a time. One minor aggravation in dealing with different kinds of servers at the same time is that their command-line clients work differently.

For example, MySQL's command-line client, mysql, has the GNU readline library built into it, which means that you can use the up and down arrows (or Control-N, Control-P) to access the command-line history, and various emacs-like commands to edit the current line. Oracle's SQL*PLUS client, on the other hand, has a lot of nifty features, but no readline library. Ugh.

Well, I guess if my SQL client(s) don't suit me, I should consider writing my own. And that's exactly what I've done for this article. In years past I probably wouldn't have considered writing my own SQL client, and certainly not as an afternoon "quickie," but as you'll see below, nowadays with Perl it's just a matter of slapping together some modules.

Starting Up

First, make sure you have the DBI, Term::ReadLine, and Term::ReadLine::Gnu modules installed, as well as the DBD module(s) for your favorite server(s).

Our shiny new server-independent SQL client will be called perlsql. Let's start it off like this:

#!/usr/local/bin/perl -w
use strict;
use DBI;
use Term::ReadLine;
use File::MkTemp;

The use DBI directive gives me the DBI module, and use Term::ReadLine gives me an interface to GNU readline-like functionality. File::MkTemp will also come in handy in a bit.

From the UNIX command line, we'll invoke perlsql something like this:

persql 'DBI:Oracle:host=localhost;sid=main' scott/tiger

The first argument is a DBI DSN string. It will, of course, vary (considerably) depending on what server you're connecting to, how it's set up, and what environment you are executing in. The second argument is an Oracle-style username/password identifier. Here's how we process the command line:

my $dsn = shift;
die "usage: perlsql dsn [user/password]" unless $dsn;
my ($user, $passwd) = split(/\/, (shift || ''));

The shift operator works on @ARGV by default if you don't specify an argument. The username and password default to empty string if none are specified. Now we're ready to connect to the database:

$dbh = DBI->connect($dsn, $user, $passwd,
&#nbsp;{ PrintError => 0, RaiseError => 1, AutoCommit => 1 }
) or die "can't connect:\n$@";

This connects us to the database and sets some connect attributes. We turn the PrintError attribute off so that error messages aren't automatically printed. Turning RaiseError on causes DBI to generate an exception when an error is encountered. Turning AutoCommit on automatically commits every statement executed by DBI. Next, let's initialize Term::ReadLine:

my $term = new Term::ReadLine 'PerlSQ';
my $OUT = $term->OUT || *STDOUT{IO};

We're now ready to write some command-processing code.

The Readline Loop

I'll go ahead and show you the entire command-processing loop, and then explain it a piece at a time.

while (defined($_ = $term->readline("$line> ")) ) {
 my $cmd = $_;
 $cmd =~ s/^\s+|\s+$//g;    # lop off whitespace
 next unless $cmd;          # skip blank lines
 my $first = (split(/\s+/, $cmd))[0];
 if ($is_sql_cmd{lc $first}) {
  do_sql($cmd);
 } else {
  if (lc($cmd) eq 'quit') {
   $term->remove_history($term->where_history);
   last;
  } elsif ($cmd =~ /^!/) {
   system substr $cmd, 1;
  } else {
   eval qq(
    package perlsql; no strict; \$save = select(STDOUT);
    \$res = do {$cmd}; select \$save; \$res
   );
   print $@ if $@;
   print "\n";
  }
 }
 $line++;
}

The command-processing line is, overall, a while loop that reads a line at a time from our ReadLine terminal. If the user types the end-of-file character, $term->readline returns undef and drops us out of the loop. Inside the loop we first strip leading/trailing white space from the command line and make sure it's not blank. If it's not, we process the line in one of several possible ways.

First, we check to see if the line is an SQL command. The hash %is_sql_cmd contains a list of SQL commands. This is obviously server-dependent, but simple enough to come up with. I define it like this:

my %is_sql_cmd = map { $_ => 1 } qw(
 alter analyze associate audit call comment commit
 create delete dissociate drop explain grant insert
 lock noaudit rename revoke rollback savepoint select
 set truncate update
);

If it is an SQL command, I pass it to my do_sql subroutine, which I'll explain below. The next possibility is that the user has typed quit. In that case, I delete the current line (containing quit) from the readline history, and exit the loop. Another possibility is a line beginning with an exclamation mark. Those lines get sent to a shell with Perl's system operator.

If the line doesn't fit one of those descriptions, it's treated as a Perl command. If you supply the eval operator a string, Perl takes the string and executes it as Perl code in the current context. Note that I'm using the generalized qq form of double quote — it just looks better to me than ordinary double quotes if I'm quoting several lines.

I don't want the Perl code executed in my current package (otherwise, commands typed in by the user might inadvertently mess up the running perlsql program!), so I change to a different package in the eval — perlsql in this case. I turn off strict and make sure the default filehandle is set to STDOUT, then execute the command line in a do block. Then I restore the default filehandle and return the result of executing the command. (Note that this code doesn't actually do anything with the result, $res, but that's a feature that could be added.) If the eval produced an error, the message will be in the $@ variable, so I check that and print it if necessary.

At the bottom of the loop, I increment the line number counter.

Processing SQL

The do_sql subroutine takes a single SQL command as its argument, double-quote interpolates it, executes it, and then displays the result.

sub do_sql {
 my $sql = shift;
 $sql = eval "package perlsql; no strict; qq\0$sql\0";
 print($@), return if $@;
 print "=> $sql\n";
 my $sth;
 eval {
  $sth = $dbh->prepare($sql);
  my $rv = $sth->execute;
  if ($sql =~ /^\bselect\b/) {
   my ($prec, $names) = @{$sth}{qw(PRECISION NAME_lc)};
   display_result $prec, $names, $sth->fetchall_arrayref;
   print "\n";
  } else {
   print defined($rv) ? ($rv + 0, " rows affected.\n\n") :
         "ok\n\n";
  }
 };
 print $@ if $@;
}

Double-quote interpolating SQL command lines is useful because it lets us use Perl variables inside our commands — something like:

select count(*) from club where state = '$state'

To double-quote interpolate $sql, I eval it in the perlsql package. Note that the argument to eval is a double-quoted string, and that within that I have another double-quoted string. I use a NUL (\0) as the delimiter for the embedded double-quoted string. After that, I echo the interpolated command to the terminal and then prepare and execute the command.

I display the results of select statements with the display_result subroutine:

sub display_result {
 my ($prec, $name, $ary) = @_;
 my $row_format = join(' ', map "%-${_}s", @$prec) . "\n";
 printf $row_format, @$name;
 print join(' ', map { '=' x $_ } @$prec), "\n";
 printf $row_format, @$_ for @$ary;
}

The arguments to display_result are array references containing the "precision" of the result columns (how many characters are required to print the contents), the names of the result columns, and the results themselves. The results are a two-dimensional "array of arrays." I use the precision to create a suitable printf format (just printing the data as strings) and then print each row of the result. The whole thing winds up looking like this:

112> select distinct postal_code from club where name like 'Augusta%'
=> select distinct postal_code from club where name like 'Augusta%'
postal_code
===============
30904
04351
67010
46701

For non-select statements, I print the number of rows affected by the command (if available).

More Powerful Command-line Editing

One of the annoying things about using SQL command-line clients is that you often need to enter rather long commands. Perhaps you'd like to be able to edit them using a separate editor? No problem! We'll just bind the Control-V key to a subroutine that lets you edit the current line in your favorite editor:

$term->add_defun('visual', sub {
 my $fn = mktemp("perlsql$$.XXXXXXXX", "/tmp");
 $fn = "/tmp/$fn";
 open F, ">$fn" or die "can't open $fn: $!";
 print F $term->copy_text;
 close F;
 system +($ENV{EDITOR} || 'vi'), $fn;
 if (-r $fn) {
  local $/;
  open F, $fn;
  my $text = <F>;
  close F;
  $text =~ s/[\r\n]+$//;      # no trailing newline
  $term->begin_undo_group;
  $term->delete_text;
  $term->Attribs->{point} = 0;
  $term->insert_text($text);
  $term->Attribs->{point} = length $term->Attribs->
            {line_buffer};
  $term->end_undo_group;
  unlink $fn;
 }
 $term->forced_update_display;
} );
$term->bind_key(ord("\cv"), 'visual');

The Term::ReadLine::Gnu method add_defun registers a subroutine with the readline library. In this case, I've defined it as an anonymous subroutine (with the sub {} operator). I use the mktemp subroutine from File::MkTemp to create a temporary filename, then create a temporary file with that name, write the contents of the current command line into it (from copy_text), and fire up an editor on that file with system. If the editor leaves a readable file, I read the contents back in as a single blob of text (clearing the $/ special variable makes Perl ignore line endings when reading from the file) and use that to set the current command. I found that it was necessary to manipulate the insertion point with Attribs->{point} manually to avoid some weird problems. A call to forced_update_display after everything's done forces the readline library to update the display.

The bind_key method binds the subroutine that I've registered with the name visual to the Control-V key.

Cleaning Up

An END block handles disconnect from the database and cleanup of any temporary files that might have been left behind:

END {
 print "\n";
 $dbh->disconnect if $dbh;
 unlink </tmp/perlsql$$.*>;
}

Features Gone Begging

I've written a slightly longer version of this program that has a few more frills. It saves the history to a file and restores it on startup, and also reads in a
~/.perlsqlrc file written in Perl on startup. You can see it in its entirety at <http://www.perlfaq.com/examples>.

This short program (the version on my Web site above is only 140 lines long as of this writing) is, I think, an excellent demonstration of how you can quickly create surprisingly powerful and useful things in Perl. It took me only a few hours to write perlsql. Yet, even after that small amount of work, it's a useful database-independent SQL client, and one that knows Perl in addition to everything else!

The idea behind perlsql isn't a new one — there have been previous attempts at writing DBI/ReadLine clients. The notion hit me all on my own but it was of course not original. The first such well-known DBI-based client was Andreas Koenig's pmsql. A later program was dbimon. dbimon is apparently out of date, but I have also seen a few other more recent Perl-based SQL clients.

Predefined Names

The following names have special meaning to perl. I could have used alphabetic symbols for some of these, but I didn't want to take the chance that someone would say reset "a-zA-Z" and wipe them all out. You'll just have to suffer along with these silly symbols. Most of them have reasonable mnemonics, or analogues in one of the shells.

$_

The default input and pattern-searching space. The following pairs are equivalent:

	while (<>) {...	# only equivalent in while!
	while ($_ = <>) {...

	/^Subject:/
	$_ =~ /^Subject:/

	y/a-z/A-Z/
	$_ =~ y/a-z/A-Z/

	chop
	chop($_)

(Mnemonic: underline is understood in certain operations.)

$.

The current input line number of the last filehandle that was read. Readonly. Remember that only an explicit close on the filehandle resets the line number. Since <> never does an explicit close, line numbers increase across ARGV files (but see examples under eof). (Mnemonic: many programs use . to mean the current line number.)

$/

The input record separator, newline by default. Works like awk's RS variable, including treating blank lines as delimiters if set to the null string. You may set it to a multicharacter string to match a multi-character delimiter. Note that setting it to "\n\n" means something slightly different than setting it to "", if the file contains consecutive blank lines. Setting it to "" will treat two or more consecutive blank lines as a single blank line. Setting it to "\n\n" will blindly assume that the next input character belongs to the next paragraph, even if it's a newline. (Mnemonic: / is used to delimit line boundaries when quoting poetry.)

$,

The output field separator for the print operator. Ordinarily the print operator simply prints out the comma separated fields you specify. In order to get behavior more like awk, set this variable as you would set awk's OFS variable to specify what is printed between fields. (Mnemonic: what is printed when there is a , in your print statement.)

$""

This is like $, except that it applies to array values interpolated into a double-quoted string (or similar interpreted string). Default is a space. (Mnemonic: obvious, I think.)

$\

The output record separator for the print operator. Ordinarily the print operator simply prints out the comma separated fields you specify, with no trailing newline or record separator assumed. In order to get behavior more like awk, set this variable as you would set awk's ORS variable to specify what is printed at the end of the print. (Mnemonic: you set $\ instead of adding \n at the end of the print. Also, it's just like /, but it's what you get "back" from perl.)

$#

The output format for printed numbers. This variable is a half-hearted attempt to emulate awk's OFMT variable. There are times, however, when awk and perl have differing notions of what is in fact numeric. Also, the initial value is %.20g rather than %.6g, so you need to set $# explicitly to get awk's value. (Mnemonic: # is the number sign.)

$%

The current page number of the currently selected output channel. (Mnemonic: % is page number in nroff.)

$=

The current page length (printable lines) of the currently selected output channel. Default is 60. (Mnemonic: = has horizontal lines.)

$-

The number of lines left on the page of the currently selected output channel. (Mnemonic: lines_on_page - lines_printed.)

$~

The name of the current report format for the currently selected output channel. Default is name of the filehandle. (Mnemonic: brother to $^.)

$^

The name of the current top-of-page format for the currently selected output channel. Default is name of the filehandle with "_TOP" appended. (Mnemonic: points to top of page.)

$|

If set to nonzero, forces a flush after every write or print on the currently selected output channel. Default is 0. Note that STDOUT will typically be line buffered if output is to the terminal and block buffered otherwise. Setting this variable is useful primarily when you are outputting to a pipe, such as when you are running a perl script under rsh and want to see the output as it's happening. (Mnemonic: when you want your pipes to be piping hot.)

$$

The process number of the perl running this script. (Mnemonic: same as shells.)

$?

The status returned by the last pipe close, backtick (\`\`) command or system operator. Note that this is the status word returned by the wait() system call, so the exit value of the subprocess is actually ($? >> 8). $? & 255 gives which signal, if any, the process died from, and whether there was a core dump. (Mnemonic: similar to sh and ksh.)

$&

The string matched by the last successful pattern match (not counting any matches hidden within a BLOCK or eval enclosed by the current BLOCK). (Mnemonic: like & in some editors.)

$\`

The string preceding whatever was matched by the last successful pattern match (not counting any matches hidden within a BLOCK or eval enclosed by the current BLOCK). (Mnemonic: \` often precedes a quoted string.)

$'

The string following whatever was matched by the last successful pattern match (not counting any matches hidden within a BLOCK or eval enclosed by the current BLOCK). (Mnemonic: ' often follows a quoted string.) Example:

	$_ = 'abcdefghi';
	/def/;
	print "$\`:$&:$'\n";  	# prints abc:def:ghi

$+

The last bracket matched by the last search pattern. This is useful if you don't know which of a set of alternative patterns matched. For example:

    /Version: (.*)|Revision: (.*)/ && ($rev = $+);

(Mnemonic: be positive and forward looking.)

$*

Set to 1 to do multiline matching within a string, 0 to tell perl that it can assume that strings contain a single line, for the purpose of optimizing pattern matches. Pattern matches on strings containing multiple newlines can produce confusing results when $* is 0. Default is 0. (Mnemonic: * matches multiple things.) Note that this variable only influences the interpretation of ^ and $. A literal newline can be searched for even when $* == 0.

$0

Contains the name of the file containing the perl script being executed. Assigning to $0 modifies the argument area that the ps(1) program sees. (Mnemonic: same as sh and ksh.)

$<digit>

Contains the subpattern from the corresponding set of parentheses in the last pattern matched, not counting patterns matched in nested blocks that have been exited already. (Mnemonic: like \digit.)

$[

The index of the first element in an array, and of the first character in a substring. Default is 0, but you could set it to 1 to make perl behave more like awk (or Fortran) when subscripting and when evaluating the index() and substr() functions. (Mnemonic: [ begins subscripts.)

$]

The string printed out when you say "perl -v". It can be used to determine at the beginning of a script whether the perl interpreter executing the script is in the right range of versions. If used in a numeric context, returns the version + patchlevel / 1000. Example:

	# see if getc is available
        ($version,$patchlevel) =
		 $] =~ /(\d+\.\d+).*\nPatch level: (\d+)/;
        print STDERR "(No filename completion available.)\n"
		 if $version * 1000 + $patchlevel < 2016;

or, used numerically,

	warn "No checksumming!\n" if $] < 3.019;

(Mnemonic: Is this version of perl in the right bracket?)

$;

The subscript separator for multi-dimensional array emulation. If you refer to an associative array element as

	$foo{$a,$b,$c}

it really means

	$foo{join($;, $a, $b, $c)}

But don't put

	@foo{$a,$b,$c}		# a slice--note the @

which means

	($foo{$a},$foo{$b},$foo{$c})

Default is "\034", the same as SUBSEP in awk. Note that if your keys contain binary data there might not be any safe value for $;. (Mnemonic: comma (the syntactic subscript separator) is a semi-semicolon. Yeah, I know, it's pretty lame, but $, is already taken for something more important.)

$!

If used in a numeric context, yields the current value of errno, with all the usual caveats. (This means that you shouldn't depend on the value of $! to be anything in particular unless you've gotten a specific error return indicating a system error.) If used in a string context, yields the corresponding system error string. You can assign to $! in order to set errno if, for instance, you want $! to return the string for error n, or you want to set the exit value for the die operator. (Mnemonic: What just went bang?)

$@

The perl syntax error message from the last eval command. If null, the last eval parsed and executed correctly (although the operations you invoked may have failed in the normal fashion). (Mnemonic: Where was the syntax error "at"?)

$<

The real uid of this process. (Mnemonic: it's the uid you came FROM, if you're running setuid.)

$>

The effective uid of this process. Example:

	$< = $>;	# set real uid to the effective uid
	($<,$>) = ($>,$<);	# swap real and effective uid

(Mnemonic: it's the uid you went TO, if you're running setuid.) Note: $< and $> can only be swapped on machines supporting setreuid().

$(

The real gid of this process. If you are on a machine that supports membership in multiple groups simultaneously, gives a space separated list of groups you are in. The first number is the one returned by getgid(), and the subsequent ones by getgroups(), one of which may be the same as the first number. (Mnemonic: parentheses are used to GROUP things. The real gid is the group you LEFT, if you're running setgid.)

$)

The effective gid of this process. If you are on a machine that supports membership in multiple groups simultaneously, gives a space separated list of groups you are in. The first number is the one returned by getegid(), and the subsequent ones by getgroups(), one of which may be the same as the first number. (Mnemonic: parentheses are used to GROUP things. The effective gid is the group that's RIGHT for you, if you're running setgid.)

Note: $<, $>, $( and $) can only be set on machines that support the corresponding set[re][ug]id() routine. $( and $) can only be swapped on machines supporting setregid().

$:

The current set of characters after which a string may be broken to fill continuation fields (starting with ^) in a format. Default is "\ \n-", to break on whitespace or hyphens. (Mnemonic: a "colon" in poetry is a part of a line.)

$^D

The current value of the debugging flags. (Mnemonic: value of -D switch.)

$^F

The maximum system file descriptor, ordinarily 2. System file descriptors are passed to subprocesses, while higher file descriptors are not. During an open, system file descriptors are preserved even if the open fails. Ordinary file descriptors are closed before the open is attempted.

$^I

The current value of the inplace-edit extension. Use undef to disable inplace editing. (Mnemonic: value of -i switch.)

$^L

What formats output to perform a formfeed. Default is \f.

$^P

The internal flag that the debugger clears so that it doesn't debug itself. You could conceivable disable debugging yourself by clearing it.

$^T

The time at which the script began running, in seconds since the epoch. The values returned by the -M , -A and -C filetests are based on this value.

$^W

The current value of the warning switch. (Mnemonic: related to the -w switch.)

$^X

The name that Perl itself was executed as, from argv[0].

$ARGV

contains the name of the current file when reading from <>.

@ARGV

The array ARGV contains the command line arguments intended for the script. Note that $#ARGV is the generally number of arguments minus one, since $ARGV[0] is the first argument, NOT the command name. See $0 for the command name.

@INC

The array INC contains the list of places to look for perl scripts to be evaluated by the "do EXPR" command or the "require" command. It initially consists of the arguments to any -I command line switches, followed by the default perl library, probably "/usr/local/lib/perl", followed by ".", to represent the current directory.

%INC

The associative array INC contains entries for each filename that has been included via "do" or "require". The key is the filename you specified, and the value is the location of the file actually found. The "require" command uses this array to determine whether a given file has already been included.

$ENV{expr}

The associative array ENV contains your current environment. Setting a value in ENV changes the environment for child processes.

$SIG{expr}

The associative array SIG is used to set signal handlers for various signals. Example:

	sub handler {	# 1st argument is signal name
		local($sig) = @_;
		print "Caught a SIG$sig--shutting down\n";
		close(LOG);
		exit(0);
	}

	$SIG{'INT'} = 'handler';
	$SIG{'QUIT'} = 'handler';
	...
	$SIG{'INT'} = 'DEFAULT';	# restore default action
	$SIG{'QUIT'} = 'IGNORE';	# ignore SIGQUIT

The SIG array only contains values for the signals actually set within the perl script.

Alternate Object Representations

Nothing requires objects to be implemented as hash references. An object can be any sort of reference so long as its referent has been suitably blessed. That means scalar, array, and code references are also fair game.

A scalar would work if the object has only one datum to hold. An array would work for most cases, but makes inheritance a bit dodgy because you have to invent new indices for the derived classes.

Arrays as Objects

If the user of your class honors the contract and sticks to the advertised interface, then you can change its underlying interface if you feel like it. Here's another implementation that conforms to the same interface specification. This time we'll use an array reference instead of a hash reference to represent the object.

    package Person;
    use strict;

    my($NAME, $AGE, $PEERS) = ( 0 .. 2 );

    ############################################
    ## the object constructor (array version) ##
    ############################################
    sub new {
        my $self = [];
        $self->[$NAME]   = undef;  # this is unnecessary
        $self->[$AGE]    = undef;  # as is this
        $self->[$PEERS]  = [];     # but this isn't, really
        bless($self);
        return $self;
    }

    sub name {
        my $self = shift;
        if (@_) { $self->[$NAME] = shift }
        return $self->[$NAME];
    }

    sub age {
        my $self = shift;
        if (@_) { $self->[$AGE] = shift }
        return $self->[$AGE];
    }

    sub peers {
        my $self = shift;
        if (@_) { @{ $self->[$PEERS] } = @_ }
        return @{ $self->[$PEERS] };
    }

    1;  # so the require or use succeeds

You might guess that the array access would be a lot faster than the hash access, but they're actually comparable. The array is a little bit faster, but not more than ten or fifteen percent, even when you replace the variables above like $AGE with literal numbers, like 1. A bigger difference between the two approaches can be found in memory use. A hash representation takes up more memory than an array representation because you have to allocate memory for the keys as well as for the values. However, it really isn't that bad, especially since as of version 5.004, memory is only allocated once for a given hash key, no matter how many hashes have that key. It's expected that sometime in the future, even these differences will fade into obscurity as more efficient underlying representations are devised.

Still, the tiny edge in speed (and somewhat larger one in memory) is enough to make some programmers choose an array representation for simple classes. There's still a little problem with scalability, though, because later in life when you feel like creating subclasses, you'll find that hashes just work out better.

Closures as Objects

Using a code reference to represent an object offers some fascinating possibilities. We can create a new anonymous function (closure) who alone in all the world can see the object's data. This is because we put the data into an anonymous hash that's lexically visible only to the closure we create, bless, and return as the object. This object's methods turn around and call the closure as a regular subroutine call, passing it the field we want to affect. (Yes, the double-function call is slow, but if you wanted fast, you wouldn't be using objects at all, eh? :-)

Use would be similar to before:

    use Person;
    $him = Person->new();
    $him->name("Jason");
    $him->age(23);
    $him->peers( [ "Norbert", "Rhys", "Phineas" ] );
    printf "%s is %d years old.\n", $him->name, $him->age;
    print "His peers are: ", join(", ", @{$him->peers}), "\n";

but the implementation would be radically, perhaps even sublimely different:

    package Person;

    sub new {
         my $that  = shift;
         my $class = ref($that) || $that;
         my $self = {
            NAME  => undef,
            AGE   => undef,
            PEERS => [],
         };
         my $closure = sub {
            my $field = shift;
            if (@_) { $self->{$field} = shift }
            return    $self->{$field};
        };
        bless($closure, $class);
        return $closure;
    }

    sub name   { &{ $_[0] }("NAME",  @_[ 1 .. $#_ ] ) }
    sub age    { &{ $_[0] }("AGE",   @_[ 1 .. $#_ ] ) }
    sub peers  { &{ $_[0] }("PEERS", @_[ 1 .. $#_ ] ) }

    1;

Because this object is hidden behind a code reference, it's probably a bit mysterious to those whose background is more firmly rooted in standard procedural or object-based programming languages than in functional programming languages whence closures derive. The object created and returned by the new() method is itself not a data reference as we've seen before. It's an anonymous code reference that has within it access to a specific version (lexical binding and instantiation) of the object's data, which are stored in the private variable $self. Although this is the same function each time, it contains a different version of $self.

When a method like $him->name("Jason") is called, its implicit zeroth argument is the invoking object--just as it is with all method calls. But in this case, it's our code reference (something like a function pointer in C++, but with deep binding of lexical variables). There's not a lot to be done with a code reference beyond calling it, so that's just what we do when we say &{$_[0]}. This is just a regular function call, not a method call. The initial argument is the string ``NAME'', and any remaining arguments are whatever had been passed to the method itself.

Once we're executing inside the closure that had been created in new(), the $self hash reference suddenly becomes visible. The closure grabs its first argument (``NAME'' in this case because that's what the name() method passed it), and uses that string to subscript into the private hash hidden in its unique version of $self.

Nothing under the sun will allow anyone outside the executing method to be able to get at this hidden data. Well, nearly nothing. You could single step through the program using the debugger and find out the pieces while you're in the method, but everyone else is out of luck.

There, if that doesn't excite the Scheme folks, then I just don't know what will. Translation of this technique into C++, Java, or any other braindead-static language is left as a futile exercise for aficionados of those camps.

You could even add a bit of nosiness via the caller() function and make the closure refuse to operate unless called via its own package. This would no doubt satisfy certain fastidious concerns of programming police and related puritans.

If you were wondering when Hubris, the third principle virtue of a programmer, would come into play, here you have it. (More seriously, Hubris is just the pride in craftsmanship that comes from having written a sound bit of well-designed code.)

---

AUTOLOAD: Proxy Methods

Autoloading is a way to intercept calls to undefined methods. An autoload routine may choose to create a new function on the fly, either loaded from disk or perhaps just eval()ed right there. This define-on-the-fly strategy is why it's called autoloading.

But that's only one possible approach. Another one is to just have the autoloaded method itself directly provide the requested service. When used in this way, you may think of autoloaded methods as ``proxy'' methods.

When Perl tries to call an undefined function in a particular package and that function is not defined, it looks for a function in that same package called AUTOLOAD. If one exists, it's called with the same arguments as the original function would have had. The fully-qualified name of the function is stored in that package's global variable $AUTOLOAD. Once called, the function can do anything it would like, including defining a new function by the right name, and then doing a really fancy kind of goto right to it, erasing itself from the call stack.

What does this have to do with objects? After all, we keep talking about functions, not methods. Well, since a method is just a function with an extra argument and some fancier semantics about where it's found, we can use autoloading for methods, too. Perl doesn't start looking for an AUTOLOAD method until it has exhausted the recursive hunt up through @ISA, though. Some programmers have even been known to define a UNIVERSAL::AUTOLOAD method to trap unresolved method calls to any kind of object.

Autoloaded Data Methods

You probably began to get a little suspicious about the duplicated code way back earlier when we first showed you the Person class, and then later the Employee class. Each method used to access the hash fields looked virtually identical. This should have tickled that great programming virtue, Impatience, but for the time, we let Laziness win out, and so did nothing. Proxy methods can cure this.

Instead of writing a new function every time we want a new data field, we'll use the autoload mechanism to generate (actually, mimic) methods on the fly. To verify that we're accessing a valid member, we will check against an _permitted (pronounced ``under-permitted'') field, which is a reference to a file-scoped lexical (like a C file static) hash of permitted fields in this record called %fields. Why the underscore? For the same reason as the _CENSUS field we once used: as a marker that means ``for internal use only''.

Here's what the module initialization code and class constructor will look like when taking this approach:

    package Person;
    use Carp;
    our $AUTOLOAD;  # it's a package global

    my %fields = (
        name        => undef,
        age         => undef,
        peers       => undef,
    );

    sub new {
        my $that  = shift;
        my $class = ref($that) || $that;
        my $self  = {
            _permitted => \%fields,
            %fields,
        };
        bless $self, $class;
        return $self;
    }

If we wanted our record to have default values, we could fill those in where current we have undef in the %fields hash.

Notice how we saved a reference to our class data on the object itself? Remember that it's important to access class data through the object itself instead of having any method reference %fields directly, or else you won't have a decent inheritance.

The real magic, though, is going to reside in our proxy method, which will handle all calls to undefined methods for objects of class Person (or subclasses of Person). It has to be called AUTOLOAD. Again, it's all caps because it's called for us implicitly by Perl itself, not by a user directly.

    sub AUTOLOAD {
        my $self = shift;
        my $type = ref($self)
                    or croak "$self is not an object";

        my $name = $AUTOLOAD;
        $name =~ s/.*://;   # strip fully-qualified portion

        unless (exists $self->{_permitted}->{$name} ) {
            croak "Can't access `$name' field in class $type";
        }

        if (@_) {
            return $self->{$name} = shift;
        } else {
            return $self->{$name};
        }
    }

Pretty nifty, eh? All we have to do to add new data fields is modify %fields. No new functions need be written.

I could have avoided the _permitted field entirely, but I wanted to demonstrate how to store a reference to class data on the object so you wouldn't have to access that class data directly from an object method.

Inherited Autoloaded Data Methods

But what about inheritance? Can we define our Employee class similarly? Yes, so long as we're careful enough.

Here's how to be careful:

    package Employee;
    use Person;
    use strict;
    our @ISA = qw(Person);

    my %fields = (
        id          => undef,
        salary      => undef,
    );

    sub new {
        my $that  = shift;
        my $class = ref($that) || $that;
        my $self = bless $that->SUPER::new(), $class;
        my($element);
        foreach $element (keys %fields) {
            $self->{_permitted}->{$element} = $fields{$element};
        }
        @{$self}{keys %fields} = values %fields;
        return $self;
    }

Once we've done this, we don't even need to have an AUTOLOAD function in the Employee package, because we'll grab Person's version of that via inheritance, and it will all work out just fine.

---

Metaclassical Tools

Even though proxy methods can provide a more convenient approach to making more struct-like classes than tediously coding up data methods as functions, it still leaves a bit to be desired. For one thing, it means you have to handle bogus calls that you don't mean to trap via your proxy. It also means you have to be quite careful when dealing with inheritance, as detailed above.

Perl programmers have responded to this by creating several different class construction classes. These metaclasses are classes that create other classes. A couple worth looking at are Class::Struct and Alias. These and other related metaclasses can be found in the modules directory on CPAN.

Class::Struct

One of the older ones is Class::Struct. In fact, its syntax and interface were sketched out long before perl5 even solidified into a real thing. What it does is provide you a way to ``declare'' a class as having objects whose fields are of a specific type. The function that does this is called, not surprisingly enough, struct(). Because structures or records are not base types in Perl, each time you want to create a class to provide a record-like data object, you yourself have to define a new() method, plus separate data-access methods for each of that record's fields. You'll quickly become bored with this process. The Class::Struct::struct() function alleviates this tedium.

Here's a simple example of using it:

    use Class::Struct qw(struct);
    use Jobbie;  # user-defined; see below

    struct 'Fred' => {
        one        => '$',
        many       => '@',
        profession => Jobbie,  # calls Jobbie->new()
    };

    $ob = Fred->new;
    $ob->one("hmmmm");

    $ob->many(0, "here");
    $ob->many(1, "you");
    $ob->many(2, "go");
    print "Just set: ", $ob->many(2), "\n";

    $ob->profession->salary(10_000);

You can declare types in the struct to be basic Perl types, or user-defined types (classes). User types will be initialized by calling that class's new() method.

Here's a real-world example of using struct generation. Let's say you wanted to override Perl's idea of gethostbyname() and gethostbyaddr() so that they would return objects that acted like C structures. We don't care about high-falutin' OO gunk. All we want is for these objects to act like structs in the C sense.

    use Socket;
    use Net::hostent;
    $h = gethostbyname("perl.com");  # object return
    printf "perl.com's real name is %s, address %s\n",
        $h->name, inet_ntoa($h->addr);

Here's how to do this using the Class::Struct module. The crux is going to be this call:

    struct 'Net::hostent' => [          # note bracket
        name       => '$',
        aliases    => '@',
        addrtype   => '$',
        'length'   => '$',
        addr_list  => '@',
     ];

Which creates object methods of those names and types. It even creates a new() method for us.

We could also have implemented our object this way:

    struct 'Net::hostent' => {          # note brace
        name       => '$',
        aliases    => '@',
        addrtype   => '$',
        'length'   => '$',
        addr_list  => '@',
     };

and then Class::Struct would have used an anonymous hash as the object type, instead of an anonymous array. The array is faster and smaller, but the hash works out better if you eventually want to do inheritance. Since for this struct-like object we aren't planning on inheritance, this time we'll opt for better speed and size over better flexibility.

Here's the whole implementation:

    package Net::hostent;
    use strict;

    BEGIN {
        use Exporter   ();
        our @EXPORT      = qw(gethostbyname gethostbyaddr gethost);
        our @EXPORT_OK   = qw(
                               $h_name         @h_aliases
                               $h_addrtype     $h_length
                               @h_addr_list    $h_addr
                           );
        our %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
    }
    our @EXPORT_OK;

    # Class::Struct forbids use of @ISA
    sub import { goto &Exporter::import }

    use Class::Struct qw(struct);
    struct 'Net::hostent' => [
       name        => '$',
       aliases     => '@',
       addrtype    => '$',
       'length'    => '$',
       addr_list   => '@',
    ];

    sub addr { shift->addr_list->[0] }

    sub populate (@) {
        return unless @_;
        my $hob = new();  # Class::Struct made this!
        $h_name     =    $hob->[0]              = $_[0];
        @h_aliases  = @{ $hob->[1] } = split ' ', $_[1];
        $h_addrtype =    $hob->[2]              = $_[2];
        $h_length   =    $hob->[3]              = $_[3];
        $h_addr     =                             $_[4];
        @h_addr_list = @{ $hob->[4] } =         @_[ (4 .. $#_) ];
        return $hob;
    }

    sub gethostbyname ($)  { populate(CORE::gethostbyname(shift)) }

    sub gethostbyaddr ($;$) {
        my ($addr, $addrtype);
        $addr = shift;
        require Socket unless @_;
        $addrtype = @_ ? shift : Socket::AF_INET();
        populate(CORE::gethostbyaddr($addr, $addrtype))
    }

    sub gethost($) {
        if ($_[0] =~ /^\d+(?:\.\d+(?:\.\d+(?:\.\d+)?)?)?$/) {
           require Socket;
           &gethostbyaddr(Socket::inet_aton(shift));
        } else {
           &gethostbyname;
        }
    }

    1;

We've snuck in quite a fair bit of other concepts besides just dynamic class creation, like overriding core functions, import/export bits, function prototyping, short-cut function call via &whatever, and function replacement with goto &whatever. These all mostly make sense from the perspective of a traditional module, but as you can see, we can also use them in an object module.

You can look at other object-based, struct-like overrides of core functions in the 5.004 release of Perl in File::stat, Net::hostent, Net::netent, Net::protoent, Net::servent, Time::gmtime, Time::localtime, User::grent, and User::pwent. These modules have a final component that's all lowercase, by convention reserved for compiler pragmas, because they affect the compilation and change a builtin function. They also have the type names that a C programmer would most expect.

Data Members as Variables

If you're used to C++ objects, then you're accustomed to being able to get at an object's data members as simple variables from within a method. The Alias module provides for this, as well as a good bit more, such as the possibility of private methods that the object can call but folks outside the class cannot.

Here's an example of creating a Person using the Alias module. When you update these magical instance variables, you automatically update value fields in the hash. Convenient, eh?

    package Person;

    # this is the same as before...
    sub new {
         my $that  = shift;
         my $class = ref($that) || $that;
         my $self = {
            NAME  => undef,
            AGE   => undef,
            PEERS => [],
        };
        bless($self, $class);
        return $self;
    }

    use Alias qw(attr);
    our ($NAME, $AGE, $PEERS);

    sub name {
        my $self = attr shift;
        if (@_) { $NAME = shift; }
        return    $NAME;
    }

    sub age {
        my $self = attr shift;
        if (@_) { $AGE = shift; }
        return    $AGE;
    }

    sub peers {
        my $self = attr shift;
        if (@_) { @PEERS = @_; }
        return    @PEERS;
    }

    sub exclaim {
        my $self = attr shift;
        return sprintf "Hi, I'm %s, age %d, working with %s",
            $NAME, $AGE, join(", ", @PEERS);
    }

    sub happy_birthday {
        my $self = attr shift;
        return ++$AGE;
    }

The need for the our declaration is because what Alias does is play with package globals with the same name as the fields. To use globals while use strict is in effect, you have to predeclare them. These package variables are localized to the block enclosing the attr() call just as if you'd used a local() on them. However, that means that they're still considered global variables with temporary values, just as with any other local().

It would be nice to combine Alias with something like Class::Struct or Class::MethodMaker.

NOTES

Object Terminology

In the various OO literature, it seems that a lot of different words are used to describe only a few different concepts. If you're not already an object programmer, then you don't need to worry about all these fancy words. But if you are, then you might like to know how to get at the same concepts in Perl.

For example, it's common to call an object an instance of a class and to call those objects' methods instance methods. Data fields peculiar to each object are often called instance data or object attributes, and data fields common to all members of that class are class data, class attributes, or static data members.

Also, base class, generic class, and superclass all describe the same notion, whereas derived class, specific class, and subclass describe the other related one.

C++ programmers have static methods and virtual methods, but Perl only has class methods and object methods. Actually, Perl only has methods. Whether a method gets used as a class or object method is by usage only. You could accidentally call a class method (one expecting a string argument) on an object (one expecting a reference), or vice versa.

From the C++ perspective, all methods in Perl are virtual. This, by the way, is why they are never checked for function prototypes in the argument list as regular builtin and user-defined functions can be.

Because a class is itself something of an object, Perl's classes can be taken as describing both a ``class as meta-object'' (also called object factory) philosophy and the ``class as type definition'' (declaring behaviour, not defining mechanism) idea. C++ supports the latter notion, but not the former.

---

SEE ALSO

The following manpages will doubtless provide more background for this one: the perlmod manpage, the perlref manpage, the perlobj manpage, the perlbot manpage, the perltie manpage, and the overload manpage.

---

AUTHOR AND COPYRIGHT

Copyright (c) 1997, 1998 Tom Christiansen All rights reserved.

When included as part of the Standard Version of Perl, or as part of its complete documentation whether printed or otherwise, this work may be distributed only under the terms of Perl's Artistic License. Any distribution of this file or derivatives thereof outside of that package require that special arrangements be made with copyright holder.

Irrespective of its distribution, all code examples in this file are hereby placed into the public domain. You are permitted and encouraged to use this code in your own programs for fun or for profit as you see fit. A simple comment in the code giving credit would be courteous but is not required.

---

COPYRIGHT

Acknowledgments

Thanks to Larry Wall, Roderick Schertler, Gurusamy Sarathy, Dean Roehrich, Raphael Manfredi, Brent Halsey, Greg Bacon, Brad Appleton, and many others for their helpful comments.

perltoot - Tom's object-oriented tutorial for perl

NAME

perltoot - Tom's object-oriented tutorial for perl

---

DESCRIPTION

Object-oriented programming is a big seller these days. Some managers would rather have objects than sliced bread. Why is that? What's so special about an object? Just what is an object anyway?

An object is nothing but a way of tucking away complex behaviours into a neat little easy-to-use bundle. (This is what professors call abstraction.) Smart people who have nothing to do but sit around for weeks on end figuring out really hard problems make these nifty objects that even regular people can use. (This is what professors call software reuse.) Users (well, programmers) can play with this little bundle all they want, but they aren't to open it up and mess with the insides. Just like an expensive piece of hardware, the contract says that you void the warranty if you muck with the cover. So don't do that.

The heart of objects is the class, a protected little private namespace full of data and functions. A class is a set of related routines that addresses some problem area. You can think of it as a user-defined type. The Perl package mechanism, also used for more traditional modules, is used for class modules as well. Objects ``live'' in a class, meaning that they belong to some package.

More often than not, the class provides the user with little bundles. These bundles are objects. They know whose class they belong to, and how to behave. Users ask the class to do something, like ``give me an object.'' Or they can ask one of these objects to do something. Asking a class to do something for you is calling a class method. Asking an object to do something for you is calling an object method. Asking either a class (usually) or an object (sometimes) to give you back an object is calling a constructor, which is just a kind of method.

That's all well and good, but how is an object different from any other Perl data type? Just what is an object really; that is, what's its fundamental type? The answer to the first question is easy. An object is different from any other data type in Perl in one and only one way: you may dereference it using not merely string or numeric subscripts as with simple arrays and hashes, but with named subroutine calls. In a word, with methods.

The answer to the second question is that it's a reference, and not just any reference, mind you, but one whose referent has been bless()ed into a particular class (read: package). What kind of reference? Well, the answer to that one is a bit less concrete. That's because in Perl the designer of the class can employ any sort of reference they'd like as the underlying intrinsic data type. It could be a scalar, an array, or a hash reference. It could even be a code reference. But because of its inherent flexibility, an object is usually a hash reference.

---

Creating a Class

Before you create a class, you need to decide what to name it. That's because the class (package) name governs the name of the file used to house it, just as with regular modules. Then, that class (package) should provide one or more ways to generate objects. Finally, it should provide mechanisms to allow users of its objects to indirectly manipulate these objects from a distance.

For example, let's make a simple Person class module. It gets stored in the file Person.pm. If it were called a Happy::Person class, it would be stored in the file Happy/Person.pm, and its package would become Happy::Person instead of just Person. (On a personal computer not running Unix or Plan 9, but something like MacOS or VMS, the directory separator may be different, but the principle is the same.) Do not assume any formal relationship between modules based on their directory names. This is merely a grouping convenience, and has no effect on inheritance, variable accessibility, or anything else.

For this module we aren't going to use Exporter, because we're a well-behaved class module that doesn't export anything at all. In order to manufacture objects, a class needs to have a constructor method. A constructor gives you back not just a regular data type, but a brand-new object in that class. This magic is taken care of by the bless() function, whose sole purpose is to enable its referent to be used as an object. Remember: being an object really means nothing more than that methods may now be called against it.

While a constructor may be named anything you'd like, most Perl programmers seem to like to call theirs new(). However, new() is not a reserved word, and a class is under no obligation to supply such. Some programmers have also been known to use a function with the same name as the class as the constructor.

Object Representation

By far the most common mechanism used in Perl to represent a Pascal record, a C struct, or a C++ class is an anonymous hash. That's because a hash has an arbitrary number of data fields, each conveniently accessed by an arbitrary name of your own devising.

If you were just doing a simple struct-like emulation, you would likely go about it something like this:

    $rec = {
        name  => "Jason",
        age   => 23,
        peers => [ "Norbert", "Rhys", "Phineas"],
    };

If you felt like it, you could add a bit of visual distinction by up-casing the hash keys:

    $rec = {
        NAME  => "Jason",
        AGE   => 23,
        PEERS => [ "Norbert", "Rhys", "Phineas"],
    };

And so you could get at $rec->{NAME} to find ``Jason'', or @{ $rec->{PEERS} } to get at ``Norbert'', ``Rhys'', and ``Phineas''. (Have you ever noticed how many 23-year-old programmers seem to be named ``Jason'' these days? :-)

This same model is often used for classes, although it is not considered the pinnacle of programming propriety for folks from outside the class to come waltzing into an object, brazenly accessing its data members directly. Generally speaking, an object should be considered an opaque cookie that you use object methods to access. Visually, methods look like you're dereffing a reference using a function name instead of brackets or braces.

Class Interface

Some languages provide a formal syntactic interface to a class's methods, but Perl does not. It relies on you to read the documentation of each class. If you try to call an undefined method on an object, Perl won't complain, but the program will trigger an exception while it's running. Likewise, if you call a method expecting a prime number as its argument with a non-prime one instead, you can't expect the compiler to catch this. (Well, you can expect it all you like, but it's not going to happen.)

Let's suppose you have a well-educated user of your Person class, someone who has read the docs that explain the prescribed interface. Here's how they might use the Person class:

    use Person;

    $him = Person->new();
    $him->name("Jason");
    $him->age(23);
    $him->peers( "Norbert", "Rhys", "Phineas" );

    push @All_Recs, $him;  # save object in array for later

    printf "%s is %d years old.\n", $him->name, $him->age;
    print "His peers are: ", join(", ", $him->peers), "\n";

    printf "Last rec's name is %s\n", $All_Recs[-1]->name;

As you can see, the user of the class doesn't know (or at least, has no business paying attention to the fact) that the object has one particular implementation or another. The interface to the class and its objects is exclusively via methods, and that's all the user of the class should ever play with.

Constructors and Instance Methods

Still, someone has to know what's in the object. And that someone is the class. It implements methods that the programmer uses to access the object. Here's how to implement the Person class using the standard hash-ref-as-an-object idiom. We'll make a class method called new() to act as the constructor, and three object methods called name(), age(), and peers() to get at per-object data hidden away in our anonymous hash.

    package Person;
    use strict;

    ##################################################
    ## the object constructor (simplistic version)  ##
    ##################################################
    sub new {
        my $self  = {};
        $self->{NAME}   = undef;
        $self->{AGE}    = undef;
        $self->{PEERS}  = [];
        bless($self);           # but see below
        return $self;
    }

    ##############################################
    ## methods to access per-object data        ##
    ##                                          ##
    ## With args, they set the value.  Without  ##
    ## any, they only retrieve it/them.         ##
    ##############################################

    sub name {
        my $self = shift;
        if (@_) { $self->{NAME} = shift }
        return $self->{NAME};
    }

    sub age {
        my $self = shift;
        if (@_) { $self->{AGE} = shift }
        return $self->{AGE};
    }

    sub peers {
        my $self = shift;
        if (@_) { @{ $self->{PEERS} } = @_ }
        return @{ $self->{PEERS} };
    }

    1;  # so the require or use succeeds

We've created three methods to access an object's data, name(), age(), and peers(). These are all substantially similar. If called with an argument, they set the appropriate field; otherwise they return the value held by that field, meaning the value of that hash key.

Planning for the Future: Better Constructors

Even though at this point you may not even know what it means, someday you're going to worry about inheritance. (You can safely ignore this for now and worry about it later if you'd like.) To ensure that this all works out smoothly, you must use the double-argument form of bless(). The second argument is the class into which the referent will be blessed. By not assuming our own class as the default second argument and instead using the class passed into us, we make our constructor inheritable.

While we're at it, let's make our constructor a bit more flexible. Rather than being uniquely a class method, we'll set it up so that it can be called as either a class method or an object method. That way you can say:

    $me  = Person->new();
    $him = $me->new();

To do this, all we have to do is check whether what was passed in was a reference or not. If so, we were invoked as an object method, and we need to extract the package (class) using the ref() function. If not, we just use the string passed in as the package name for blessing our referent.

    sub new {
        my $proto = shift;
        my $class = ref($proto) || $proto;
        my $self  = {};
        $self->{NAME}   = undef;
        $self->{AGE}    = undef;
        $self->{PEERS}  = [];
        bless ($self, $class);
        return $self;
    }

That's about all there is for constructors. These methods bring objects to life, returning neat little opaque bundles to the user to be used in subsequent method calls.

Destructors

Every story has a beginning and an end. The beginning of the object's story is its constructor, explicitly called when the object comes into existence. But the ending of its story is the destructor, a method implicitly called when an object leaves this life. Any per-object clean-up code is placed in the destructor, which must (in Perl) be called DESTROY.

If constructors can have arbitrary names, then why not destructors? Because while a constructor is explicitly called, a destructor is not. Destruction happens automatically via Perl's garbage collection (GC) system, which is a quick but somewhat lazy reference-based GC system. To know what to call, Perl insists that the destructor be named DESTROY. Perl's notion of the right time to call a destructor is not well-defined currently, which is why your destructors should not rely on when they are called.

Why is DESTROY in all caps? Perl on occasion uses purely uppercase function names as a convention to indicate that the function will be automatically called by Perl in some way. Others that are called implicitly include BEGIN, END, AUTOLOAD, plus all methods used by tied objects, described in the perltie manpage.

In really good object-oriented programming languages, the user doesn't care when the destructor is called. It just happens when it's supposed to. In low-level languages without any GC at all, there's no way to depend on this happening at the right time, so the programmer must explicitly call the destructor to clean up memory and state, crossing their fingers that it's the right time to do so. Unlike C++, an object destructor is nearly never needed in Perl, and even when it is, explicit invocation is uncalled for. In the case of our Person class, we don't need a destructor because Perl takes care of simple matters like memory deallocation.

The only situation where Perl's reference-based GC won't work is when there's a circularity in the data structure, such as:

    $this->{WHATEVER} = $this;

In that case, you must delete the self-reference manually if you expect your program not to leak memory. While admittedly error-prone, this is the best we can do right now. Nonetheless, rest assured that when your program is finished, its objects' destructors are all duly called. So you are guaranteed that an object eventually gets properly destroyed, except in the unique case of a program that never exits. (If you're running Perl embedded in another application, this full GC pass happens a bit more frequently--whenever a thread shuts down.)

Other Object Methods

The methods we've talked about so far have either been constructors or else simple ``data methods'', interfaces to data stored in the object. These are a bit like an object's data members in the C++ world, except that strangers don't access them as data. Instead, they should only access the object's data indirectly via its methods. This is an important rule: in Perl, access to an object's data should only be made through methods.

Perl doesn't impose restrictions on who gets to use which methods. The public-versus-private distinction is by convention, not syntax. (Well, unless you use the Alias module described below in Data Members as Variables.) Occasionally you'll see method names beginning or ending with an underscore or two. This marking is a convention indicating that the methods are private to that class alone and sometimes to its closest acquaintances, its immediate subclasses. But this distinction is not enforced by Perl itself. It's up to the programmer to behave.

There's no reason to limit methods to those that simply access data. Methods can do anything at all. The key point is that they're invoked against an object or a class. Let's say we'd like object methods that do more than fetch or set one particular field.

    sub exclaim {
        my $self = shift;
        return sprintf "Hi, I'm %s, age %d, working with %s",
            $self->{NAME}, $self->{AGE}, join(", ", @{$self->{PEERS}});
    }

Or maybe even one like this:

    sub happy_birthday {
        my $self = shift;
        return ++$self->{AGE};
    }

Some might argue that one should go at these this way:

    sub exclaim {
        my $self = shift;
        return sprintf "Hi, I'm %s, age %d, working with %s",
            $self->name, $self->age, join(", ", $self->peers);
    }

    sub happy_birthday {
        my $self = shift;
        return $self->age( $self->age() + 1 );
    }

But since these methods are all executing in the class itself, this may not be critical. There are tradeoffs to be made. Using direct hash access is faster (about an order of magnitude faster, in fact), and it's more convenient when you want to interpolate in strings. But using methods (the external interface) internally shields not just the users of your class but even you yourself from changes in your data representation.

---

Class Data

What about ``class data'', data items common to each object in a class? What would you want that for? Well, in your Person class, you might like to keep track of the total people alive. How do you implement that?

You could make it a global variable called $Person::Census. But about only reason you'd do that would be if you wanted people to be able to get at your class data directly. They could just say $Person::Census and play around with it. Maybe this is ok in your design scheme. You might even conceivably want to make it an exported variable. To be exportable, a variable must be a (package) global. If this were a traditional module rather than an object-oriented one, you might do that.

While this approach is expected in most traditional modules, it's generally considered rather poor form in most object modules. In an object module, you should set up a protective veil to separate interface from implementation. So provide a class method to access class data just as you provide object methods to access object data.

So, you could still keep $Census as a package global and rely upon others to honor the contract of the module and therefore not play around with its implementation. You could even be supertricky and make $Census a tied object as described in the perltie manpage, thereby intercepting all accesses.

But more often than not, you just want to make your class data a file-scoped lexical. To do so, simply put this at the top of the file:

    my $Census = 0;

Even though the scope of a my() normally expires when the block in which it was declared is done (in this case the whole file being required or used), Perl's deep binding of lexical variables guarantees that the variable will not be deallocated, remaining accessible to functions declared within that scope. This doesn't work with global variables given temporary values via local(), though.

Irrespective of whether you leave $Census a package global or make it instead a file-scoped lexical, you should make these changes to your Person::new() constructor:

    sub new {
        my $proto = shift;
        my $class = ref($proto) || $proto;
        my $self  = {};
        $Census++;
        $self->{NAME}   = undef;
        $self->{AGE}    = undef;
        $self->{PEERS}  = [];
        bless ($self, $class);
        return $self;
    }

    sub population {
        return $Census;
    }

Now that we've done this, we certainly do need a destructor so that when Person is destroyed, the $Census goes down. Here's how this could be done:

    sub DESTROY { --$Census }

Notice how there's no memory to deallocate in the destructor? That's something that Perl takes care of for you all by itself.

Accessing Class Data

It turns out that this is not really a good way to go about handling class data. A good scalable rule is that you must never reference class data directly from an object method. Otherwise you aren't building a scalable, inheritable class. The object must be the rendezvous point for all operations, especially from an object method. The globals (class data) would in some sense be in the ``wrong'' package in your derived classes. In Perl, methods execute in the context of the class they were defined in, not that of the object that triggered them. Therefore, namespace visibility of package globals in methods is unrelated to inheritance.

Got that? Maybe not. Ok, let's say that some other class ``borrowed'' (well, inherited) the DESTROY method as it was defined above. When those objects are destroyed, the original $Census variable will be altered, not the one in the new class's package namespace. Perhaps this is what you want, but probably it isn't.

Here's how to fix this. We'll store a reference to the data in the value accessed by the hash key ``_CENSUS''. Why the underscore? Well, mostly because an initial underscore already conveys strong feelings of magicalness to a C programmer. It's really just a mnemonic device to remind ourselves that this field is special and not to be used as a public data member in the same way that NAME, AGE, and PEERS are. (Because we've been developing this code under the strict pragma, prior to perl version 5.004 we'll have to quote the field name.)

    sub new {
        my $proto = shift;
        my $class = ref($proto) || $proto;
        my $self  = {};
        $self->{NAME}     = undef;
        $self->{AGE}      = undef;
        $self->{PEERS}    = [];
        # "private" data
        $self->{"_CENSUS"} = \$Census;
        bless ($self, $class);
        ++ ${ $self->{"_CENSUS"} };
        return $self;
    }

    sub population {
        my $self = shift;
        if (ref $self) {
            return ${ $self->{"_CENSUS"} };
        } else {
            return $Census;
        }
    }

    sub DESTROY {
        my $self = shift;
        -- ${ $self->{"_CENSUS"} };
    }

Debugging Methods

It's common for a class to have a debugging mechanism. For example, you might want to see when objects are created or destroyed. To do that, add a debugging variable as a file-scoped lexical. For this, we'll pull in the standard Carp module to emit our warnings and fatal messages. That way messages will come out with the caller's filename and line number instead of our own; if we wanted them to be from our own perspective, we'd just use die() and warn() directly instead of croak() and carp() respectively.

    use Carp;
    my $Debugging = 0;

Now add a new class method to access the variable.

    sub debug {
        my $class = shift;
        if (ref $class)  { confess "Class method called as object method" }
        unless (@_ == 1) { confess "usage: CLASSNAME->debug(level)" }
        $Debugging = shift;
    }

Now fix up DESTROY to murmur a bit as the moribund object expires:

    sub DESTROY {
        my $self = shift;
        if ($Debugging) { carp "Destroying $self " . $self->name }
        -- ${ $self->{"_CENSUS"} };
    }

One could conceivably make a per-object debug state. That way you could call both of these:

    Person->debug(1);   # entire class
    $him->debug(1);     # just this object

To do so, we need our debugging method to be a ``bimodal'' one, one that works on both classes and objects. Therefore, adjust the debug() and DESTROY methods as follows:

    sub debug {
        my $self = shift;
        confess "usage: thing->debug(level)"    unless @_ == 1;
        my $level = shift;
        if (ref($self))  {
            $self->{"_DEBUG"} = $level;         # just myself
        } else {
            $Debugging        = $level;         # whole class
        }
    }

    sub DESTROY {
        my $self = shift;
        if ($Debugging || $self->{"_DEBUG"}) {
            carp "Destroying $self " . $self->name;
        }
        -- ${ $self->{"_CENSUS"} };
    }

What happens if a derived class (which we'll call Employee) inherits methods from this Person base class? Then Employee->debug(), when called as a class method, manipulates $Person::Debugging not $Employee::Debugging.

Class Destructors

The object destructor handles the death of each distinct object. But sometimes you want a bit of cleanup when the entire class is shut down, which currently only happens when the program exits. To make such a class destructor, create a function in that class's package named END. This works just like the END function in traditional modules, meaning that it gets called whenever your program exits unless it execs or dies of an uncaught signal. For example,

    sub END {
        if ($Debugging) {
            print "All persons are going away now.\n";
        }
    }

When the program exits, all the class destructors (END functions) are be called in the opposite order that they were loaded in (LIFO order).

Documenting the Interface

And there you have it: we've just shown you the implementation of this Person class. Its interface would be its documentation. Usually this means putting it in pod (``plain old documentation'') format right there in the same file. In our Person example, we would place the following docs anywhere in the Person.pm file. Even though it looks mostly like code, it's not. It's embedded documentation such as would be used by the pod2man, pod2html, or pod2text programs. The Perl compiler ignores pods entirely, just as the translators ignore code. Here's an example of some pods describing the informal interface:

    =head1 NAME

    Person - class to implement people

    =head1 SYNOPSIS

     use Person;

     #################
     # class methods #
     #################
     $ob    = Person->new;
     $count = Person->population;

     #######################
     # object data methods #
     #######################

     ### get versions ###
         $who   = $ob->name;
         $years = $ob->age;
         @pals  = $ob->peers;

     ### set versions ###
         $ob->name("Jason");
         $ob->age(23);
         $ob->peers( "Norbert", "Rhys", "Phineas" );

     ########################
     # other object methods #
     ########################

     $phrase = $ob->exclaim;
     $ob->happy_birthday;

    =head1 DESCRIPTION

    The Person class implements dah dee dah dee dah....

That's all there is to the matter of interface versus implementation. A programmer who opens up the module and plays around with all the private little shiny bits that were safely locked up behind the interface contract has voided the warranty, and you shouldn't worry about their fate.

---

Aggregation

Suppose you later want to change the class to implement better names. Perhaps you'd like to support both given names (called Christian names, irrespective of one's religion) and family names (called surnames), plus nicknames and titles. If users of your Person class have been properly accessing it through its documented interface, then you can easily change the underlying implementation. If they haven't, then they lose and it's their fault for breaking the contract and voiding their warranty.

To do this, we'll make another class, this one called Fullname. What's the Fullname class look like? To answer that question, you have to first figure out how you want to use it. How about we use it this way:

    $him = Person->new();
    $him->fullname->title("St");
    $him->fullname->christian("Thomas");
    $him->fullname->surname("Aquinas");
    $him->fullname->nickname("Tommy");
    printf "His normal name is %s\n", $him->name;
    printf "But his real name is %s\n", $him->fullname->as_string;

Ok. To do this, we'll change Person::new() so that it supports a full name field this way:

    sub new {
        my $proto = shift;
        my $class = ref($proto) || $proto;
        my $self  = {};
        $self->{FULLNAME} = Fullname->new();
        $self->{AGE}      = undef;
        $self->{PEERS}    = [];
        $self->{"_CENSUS"} = \$Census;
        bless ($self, $class);
        ++ ${ $self->{"_CENSUS"} };
        return $self;
    }

    sub fullname {
        my $self = shift;
        return $self->{FULLNAME};
    }

Then to support old code, define Person::name() this way:

    sub name {
        my $self = shift;
        return $self->{FULLNAME}->nickname(@_)
          ||   $self->{FULLNAME}->christian(@_);
    }

Here's the Fullname class. We'll use the same technique of using a hash reference to hold data fields, and methods by the appropriate name to access them:

    package Fullname;
    use strict;

    sub new {
        my $proto = shift;
        my $class = ref($proto) || $proto;
        my $self  = {
            TITLE       => undef,
            CHRISTIAN   => undef,
            SURNAME     => undef,
            NICK        => undef,
        };
        bless ($self, $class);
        return $self;
    }

    sub christian {
        my $self = shift;
        if (@_) { $self->{CHRISTIAN} = shift }
        return $self->{CHRISTIAN};
    }

    sub surname {
        my $self = shift;
        if (@_) { $self->{SURNAME} = shift }
        return $self->{SURNAME};
    }

    sub nickname {
        my $self = shift;
        if (@_) { $self->{NICK} = shift }
        return $self->{NICK};
    }

    sub title {
        my $self = shift;
        if (@_) { $self->{TITLE} = shift }
        return $self->{TITLE};
    }

    sub as_string {
        my $self = shift;
        my $name = join(" ", @$self{'CHRISTIAN', 'SURNAME'});
        if ($self->{TITLE}) {
            $name = $self->{TITLE} . " " . $name;
        }
        return $name;
    }

    1;

Finally, here's the test program:

    #!/usr/bin/perl -w
    use strict;
    use Person;
    sub END { show_census() }

    sub show_census ()  {
        printf "Current population: %d\n", Person->population;
    }

    Person->debug(1);

    show_census();

    my $him = Person->new();

    $him->fullname->christian("Thomas");
    $him->fullname->surname("Aquinas");
    $him->fullname->nickname("Tommy");
    $him->fullname->title("St");
    $him->age(1);

    printf "%s is really %s.\n", $him->name, $him->fullname;
    printf "%s's age: %d.\n", $him->name, $him->age;
    $him->happy_birthday;
    printf "%s's age: %d.\n", $him->name, $him->age;

    show_census();

---

Inheritance

Object-oriented programming systems all support some notion of inheritance. Inheritance means allowing one class to piggy-back on top of another one so you don't have to write the same code again and again. It's about software reuse, and therefore related to Laziness, the principal virtue of a programmer. (The import/export mechanisms in traditional modules are also a form of code reuse, but a simpler one than the true inheritance that you find in object modules.)

Sometimes the syntax of inheritance is built into the core of the language, and sometimes it's not. Perl has no special syntax for specifying the class (or classes) to inherit from. Instead, it's all strictly in the semantics. Each package can have a variable called @ISA, which governs (method) inheritance. If you try to call a method on an object or class, and that method is not found in that object's package, Perl then looks to @ISA for other packages to go looking through in search of the missing method.

Like the special per-package variables recognized by Exporter (such as @EXPORT, @EXPORT_OK, @EXPORT_FAIL, %EXPORT_TAGS, and $VERSION), the @ISA array must be a package-scoped global and not a file-scoped lexical created via my(). Most classes have just one item in their @ISA array. In this case, we have what's called ``single inheritance'', or SI for short.

Consider this class:

    package Employee;
    use Person;
    @ISA = ("Person");
    1;

Not a lot to it, eh? All it's doing so far is loading in another class and stating that this one will inherit methods from that other class if need be. We have given it none of its own methods. We rely upon an Employee to behave just like a Person.

Setting up an empty class like this is called the ``empty subclass test''; that is, making a derived class that does nothing but inherit from a base class. If the original base class has been designed properly, then the new derived class can be used as a drop-in replacement for the old one. This means you should be able to write a program like this:

    use Employee;
    my $empl = Employee->new();
    $empl->name("Jason");
    $empl->age(23);
    printf "%s is age %d.\n", $empl->name, $empl->age;

By proper design, we mean always using the two-argument form of bless(), avoiding direct access of global data, and not exporting anything. If you look back at the Person::new() function we defined above, we were careful to do that. There's a bit of package data used in the constructor, but the reference to this is stored on the object itself and all other methods access package data via that reference, so we should be ok.

What do we mean by the Person::new() function -- isn't that actually a method? Well, in principle, yes. A method is just a function that expects as its first argument a class name (package) or object (blessed reference). Person::new() is the function that both the Person->new() method and the Employee->new() method end up calling. Understand that while a method call looks a lot like a function call, they aren't really quite the same, and if you treat them as the same, you'll very soon be left with nothing but broken programs. First, the actual underlying calling conventions are different: method calls get an extra argument. Second, function calls don't do inheritance, but methods do.

        Method Call             Resulting Function Call
        -----------             ------------------------
        Person->new()           Person::new("Person")
        Employee->new()         Person::new("Employee")

So don't use function calls when you mean to call a method.

If an employee is just a Person, that's not all too very interesting. So let's add some other methods. We'll give our employee data fields to access their salary, their employee ID, and their start date.

If you're getting a little tired of creating all these nearly identical methods just to get at the object's data, do not despair. Later, we'll describe several different convenience mechanisms for shortening this up. Meanwhile, here's the straight-forward way:

    sub salary {
        my $self = shift;
        if (@_) { $self->{SALARY} = shift }
        return $self->{SALARY};
    }

    sub id_number {
        my $self = shift;
        if (@_) { $self->{ID} = shift }
        return $self->{ID};
    }

    sub start_date {
        my $self = shift;
        if (@_) { $self->{START_DATE} = shift }
        return $self->{START_DATE};
    }

Overridden Methods

What happens when both a derived class and its base class have the same method defined? Well, then you get the derived class's version of that method. For example, let's say that we want the peers() method called on an employee to act a bit differently. Instead of just returning the list of peer names, let's return slightly different strings. So doing this:

    $empl->peers("Peter", "Paul", "Mary");
    printf "His peers are: %s\n", join(", ", $empl->peers);

will produce:

    His peers are: PEON=PETER, PEON=PAUL, PEON=MARY

To do this, merely add this definition into the Employee.pm file:

    sub peers {
        my $self = shift;
        if (@_) { @{ $self->{PEERS} } = @_ }
        return map { "PEON=\U$_" } @{ $self->{PEERS} };
    }

There, we've just demonstrated the high-falutin' concept known in certain circles as polymorphism. We've taken on the form and behaviour of an existing object, and then we've altered it to suit our own purposes. This is a form of Laziness. (Getting polymorphed is also what happens when the wizard decides you'd look better as a frog.)

Every now and then you'll want to have a method call trigger both its derived class (also known as ``subclass'') version as well as its base class (also known as ``superclass'') version. In practice, constructors and destructors are likely to want to do this, and it probably also makes sense in the debug() method we showed previously.

To do this, add this to Employee.pm:

    use Carp;
    my $Debugging = 0;

    sub debug {
        my $self = shift;
        confess "usage: thing->debug(level)"    unless @_ == 1;
        my $level = shift;
        if (ref($self))  {
            $self->{"_DEBUG"} = $level;
        } else {
            $Debugging = $level;            # whole class
        }
        Person::debug($self, $Debugging);   # don't really do this
    }

As you see, we turn around and call the Person package's debug() function. But this is far too fragile for good design. What if Person doesn't have a debug() function, but is inheriting its debug() method from elsewhere? It would have been slightly better to say

    Person->debug($Debugging);

But even that's got too much hard-coded. It's somewhat better to say

    $self->Person::debug($Debugging);

Which is a funny way to say to start looking for a debug() method up in Person. This strategy is more often seen on overridden object methods than on overridden class methods.

There is still something a bit off here. We've hard-coded our superclass's name. This in particular is bad if you change which classes you inherit from, or add others. Fortunately, the pseudoclass SUPER comes to the rescue here.

    $self->SUPER::debug($Debugging);

This way it starts looking in my class's @ISA. This only makes sense from within a method call, though. Don't try to access anything in SUPER:: from anywhere else, because it doesn't exist outside an overridden method call.

Things are getting a bit complicated here. Have we done anything we shouldn't? As before, one way to test whether we're designing a decent class is via the empty subclass test. Since we already have an Employee class that we're trying to check, we'd better get a new empty subclass that can derive from Employee. Here's one:

    package Boss;
    use Employee;        # :-)
    @ISA = qw(Employee);

And here's the test program:

    #!/usr/bin/perl -w
    use strict;
    use Boss;
    Boss->debug(1);

    my $boss = Boss->new();

    $boss->fullname->title("Don");
    $boss->fullname->surname("Pichon Alvarez");
    $boss->fullname->christian("Federico Jesus");
    $boss->fullname->nickname("Fred");

    $boss->age(47);
    $boss->peers("Frank", "Felipe", "Faust");

    printf "%s is age %d.\n", $boss->fullname, $boss->age;
    printf "His peers are: %s\n", join(", ", $boss->peers);

Running it, we see that we're still ok. If you'd like to dump out your object in a nice format, somewhat like the way the 'x' command works in the debugger, you could use the Data::Dumper module from CPAN this way:

    use Data::Dumper;
    print "Here's the boss:\n";
    print Dumper($boss);

Which shows us something like this:

    Here's the boss:
    $VAR1 = bless( {
         _CENSUS => \1,
         FULLNAME => bless( {
                              TITLE => 'Don',
                              SURNAME => 'Pichon Alvarez',
                              NICK => 'Fred',
                              CHRISTIAN => 'Federico Jesus'
                            }, 'Fullname' ),
         AGE => 47,
         PEERS => [
                    'Frank',
                    'Felipe',
                    'Faust'
                  ]
       }, 'Boss' );

Hm.... something's missing there. What about the salary, start date, and ID fields? Well, we never set them to anything, even undef, so they don't show up in the hash's keys. The Employee class has no new() method of its own, and the new() method in Person doesn't know about Employees. (Nor should it: proper OO design dictates that a subclass be allowed to know about its immediate superclass, but never vice-versa.) So let's fix up Employee::new() this way:

    sub new {
        my $proto = shift;
        my $class = ref($proto) || $proto;
        my $self  = $class->SUPER::new();
        $self->{SALARY}        = undef;
        $self->{ID}            = undef;
        $self->{START_DATE}    = undef;
        bless ($self, $class);          # reconsecrate
        return $self;
    }

Now if you dump out an Employee or Boss object, you'll find that new fields show up there now.

Multiple Inheritance

Ok, at the risk of confusing beginners and annoying OO gurus, it's time to confess that Perl's object system includes that controversial notion known as multiple inheritance, or MI for short. All this means is that rather than having just one parent class who in turn might itself have a parent class, etc., that you can directly inherit from two or more parents. It's true that some uses of MI can get you into trouble, although hopefully not quite so much trouble with Perl as with dubiously-OO languages like C++.

The way it works is actually pretty simple: just put more than one package name in your @ISA array. When it comes time for Perl to go finding methods for your object, it looks at each of these packages in order. Well, kinda. It's actually a fully recursive, depth-first order. Consider a bunch of @ISA arrays like this:

    @First::ISA    = qw( Alpha );
    @Second::ISA   = qw( Beta );
    @Third::ISA    = qw( First Second );

If you have an object of class Third:

    my $ob = Third->new();
    $ob->spin();

How do we find a spin() method (or a new() method for that matter)? Because the search is depth-first, classes will be looked up in the following order: Third, First, Alpha, Second, and Beta.

In practice, few class modules have been seen that actually make use of MI. One nearly always chooses simple containership of one class within another over MI. That's why our Person object contained a Fullname object. That doesn't mean it was one.

However, there is one particular area where MI in Perl is rampant: borrowing another class's class methods. This is rather common, especially with some bundled ``objectless'' classes, like Exporter, DynaLoader, AutoLoader, and SelfLoader. These classes do not provide constructors; they exist only so you may inherit their class methods. (It's not entirely clear why inheritance was done here rather than traditional module importation.)

For example, here is the POSIX module's @ISA:

    package POSIX;
    @ISA = qw(Exporter DynaLoader);

The POSIX module isn't really an object module, but then, neither are Exporter or DynaLoader. They're just lending their classes' behaviours to POSIX.

Why don't people use MI for object methods much? One reason is that it can have complicated side-effects. For one thing, your inheritance graph (no longer a tree) might converge back to the same base class. Although Perl guards against recursive inheritance, merely having parents who are related to each other via a common ancestor, incestuous though it sounds, is not forbidden. What if in our Third class shown above we wanted its new() method to also call both overridden constructors in its two parent classes? The SUPER notation would only find the first one. Also, what about if the Alpha and Beta classes both had a common ancestor, like Nought? If you kept climbing up the inheritance tree calling overridden methods, you'd end up calling Nought::new() twice, which might well be a bad idea.

UNIVERSAL: The Root of All Objects

Wouldn't it be convenient if all objects were rooted at some ultimate base class? That way you could give every object common methods without having to go and add it to each and every @ISA. Well, it turns out that you can. You don't see it, but Perl tacitly and irrevocably assumes that there's an extra element at the end of @ISA: the class UNIVERSAL. In version 5.003, there were no predefined methods there, but you could put whatever you felt like into it.

However, as of version 5.004 (or some subversive releases, like 5.003_08), UNIVERSAL has some methods in it already. These are builtin to your Perl binary, so they don't take any extra time to load. Predefined methods include isa(), can(), and VERSION(). isa() tells you whether an object or class ``is'' another one without having to traverse the hierarchy yourself:

   $has_io = $fd->isa("IO::Handle");
   $itza_handle = IO::Socket->isa("IO::Handle");

The can() method, called against that object or class, reports back whether its string argument is a callable method name in that class. In fact, it gives you back a function reference to that method:

   $his_print_method = $obj->can('as_string');

Finally, the VERSION method checks whether the class (or the object's class) has a package global called $VERSION that's high enough, as in:

    Some_Module->VERSION(3.0);
    $his_vers = $ob->VERSION();

However, we don't usually call VERSION ourselves. (Remember that an all uppercase function name is a Perl convention that indicates that the function will be automatically used by Perl in some way.) In this case, it happens when you say

    use Some_Module 3.0;

If you wanted to add version checking to your Person class explained above, just add this to Person.pm:

    our $VERSION = '1.1';

and then in Employee.pm could you can say

    use Employee 1.1;

And it would make sure that you have at least that version number or higher available. This is not the same as loading in that exact version number. No mechanism currently exists for concurrent installation of multiple versions of a module. Lamentably.

---

Chapter 10. Packages

In this chapter, we get to start having fun, because we get to start talking about software design. If we're going to talk about good software design, we have to talk about Laziness, Impatience, and Hubris, the basis of good software design.

We've all fallen into the trap of using cut-and-paste when we should have defined a higher-level abstraction, if only just a loop or subroutine.[1] To be sure, some folks have gone to the opposite extreme of defining ever-growing mounds of higher-level abstractions when they should have used cut-and-paste.[2] Generally, though, most of us need to think about using more abstraction rather than less.

[1] This is a form of False Laziness.

[2]This is a form of False Hubris.

Caught somewhere in the middle are the people who have a balanced view of how much abstraction is good, but who jump the gun on writing their own abstractions when they should be reusing existing code.[3]

[3] You guessed it--this is False Impatience. But if you're determined to reinvent the wheel, at least try to invent a better one.

Whenever you're tempted to do any of these things, you need to sit back and think about what will do the most good for you and your neighbor over the long haul. If you're going to pour your creative energies into a lump of code, why not make the world a better place while you're at it? (Even if you're only aiming for the program to succeed, you need to make sure it fits the right ecological niche.)

The first step toward ecologically sustainable programming is simply this: don't litter in the park. When you write a chunk of code, think about giving the code its own namespace, so that your variables and functions don't clobber anyone else's, or vice versa. A namespace is a bit like your home, where you're allowed to be as messy as you like, as long as you keep your external interface to other citizens moderately civil. In Perl, a namespace is called a package. Packages provide the fundamental building block upon which the higher-level concepts of modules and classes are constructed.

Like the notion of "home", the notion of "package" is a bit nebulous. Packages are independent of files. You can have many packages in a single file, or a single package that spans several files, just as your home could be one small garret in a larger building (if you're a starving artist), or it could comprise several buildings (if your name happens to be Queen Elizabeth). But the usual size of a home is one building, and the usual size of a package is one file. Perl provides some special help for people who want to put one package in one file, as long as you're willing to give the file the same name as the package and use an extension of .pm, which is short for "perl module". The module is the fundamental unit of reusability in Perl. Indeed, the way you use a module is with the use command, which is a compiler directive that controls the importation of subroutines and variables from a module. Every example of use you've seen until now has been an example of module reuse.

The Comprehensive Perl Archive Network, or CPAN, is where you should put your modules if other people might find them useful. Perl has thrived because of the willingness of programmers to share the fruits of their labor with the community. Naturally, CPAN is also where you can find modules that others have thoughtfully uploaded for everyone to use. See Chapter 22, "CPAN", and www.cpan.org for details.

The trend over the last 25 years or so has been to design computer languages that enforce a state of paranoia. You're expected to program every module as if it were in a state of siege. Certainly there are some feudal cultures where this is appropriate, but not all cultures are like this. In Perl culture, for instance, you're expected to stay out of someone's home because you weren't invited in, not because there are bars on the windows.[4]

[4] But Perl provides some bars if you want them, too. See "Handling Insecure Code" in Chapter 23, "Security".

This is not a book about object-oriented methodology, and we're not here to convert you into a raving object-oriented zealot, even if you want to be converted. There are already plenty of books out there for that. Perl's philosophy of object-oriented design fits right in with Perl's philosophy of everything else: use object-oriented design where it makes sense, and avoid it where it doesn't. Your call.

In OO-speak, every object belongs to a grouping called a class. In Perl, classes and packages and modules are all so closely related that novices can often think of them as being interchangeable. The typical class is implemented by a module that defines a package with the same name as the class. We'll explain all of this in the next few chapters.

When you use a module, you benefit from direct software reuse. With classes, you benefit from indirect software reuse when one class uses another through inheritance. And with classes, you get something more: a clean interface to another namespace. Everything in a class is accessed indirectly, insulating the class from the outside world.

As we mentioned in Chapter 8, "References", object-oriented programming in Perl is accomplished through references whose referents know which class they belong to. In fact, now that you know about references, you know almost everything difficult about objects. The rest of it just "lays under the fingers", as a pianist would say. You will need to practice a little, though.

One of your basic finger exercises consists of learning how to protect different chunks of code from inadvertently tampering with each other's variables. Every chunk of code belongs to a particular package, which determines what variables and subroutines are available to it. As Perl encounters a chunk of code, it is compiled into what we call the current package. The initial current package is called "main", but you can switch the current package to another one at any time with the package declaration. The current package determines which symbol table is used to find your variables, subroutines, I/O handles, and formats.

Any variable not declared with my is associated with a package--even seemingly omnipresent variables like $_ and %SIG. In fact, there's really no such thing as a global variable in Perl, just package variables. (Special identifiers like _ and SIG merely seem global because they default to the main package instead of the current one.)

The scope of a package declaration is from the declaration itself through the end of the enclosing scope (block, file, or eval--whichever comes first) or until another package declaration at the same level, which supersedes the earlier one. (This is a common practice).

All subsequent identifiers (including those declared with our, but not including those declared with my or those qualified with a different package name) will be placed in the symbol table belonging to the current package. (Variables declared with my are independent of packages; they are always visible within, and only within, their enclosing scope, regardless of any package declarations.)

Typically, a package declaration will be the first statement of a file meant to be included by require or use. But again, that's by convention. You can put a package declaration anywhere you can put a statement. You could even put it at the end of a block, in which case it would have no effect whatsoever. You can switch into a package in more than one place; a package declaration merely selects the symbol table to be used by the compiler for the rest of that block. (This is how a given package can span more than one file.)

You can refer to identifiers[5] in other packages by prefixing ("qualifying") the identifier with the package name and a double colon: $Package::Variable. If the package name is null, the main package is assumed. That is, $::sail is equivalent to $main::sail.[6]

[5] By identifiers, we mean the names used as symbol table keys for accessing scalar variables, array variables, hash variables, subroutines, file or directory handles, and formats. Syntactically speaking, labels are also identifiers, but they aren't put into a particular symbol table; rather, they are attached directly to the statements in your program. Labels cannot be package qualified.

[6] To clear up another bit of potential confusion, in a variable name like $main::sail, we use the term "identifier" to talk about main and sail, but not main::sail. We call that a variable name instead, because identifiers cannot contain colons.

The old package delimiter was a single quote, so in old Perl programs you'll see variables like $main'sail and $somepack'horse. But the double colon is now the preferred delimiter, in part because it's more readable to humans, and in part because it's more readable to emacs macros. It also makes C++ programmers feel like they know what's going on--as opposed to using the single quote as the separator, which was there to make Ada programmers feel like they knew what's going on. Because the old-fashioned syntax is still supported for backward compatibility, if you try to use a string like "This is $owner's house", you'll be accessing $owner::s; that is, the $s variable in package owner, which is probably not what you meant. Use braces to disambiguate, as in "This is ${owner}'s house".

The double colon can be used to chain together identifiers in a package name: $Red::Blue::var. This means the $var belonging to the Red::Blue package. The Red::Blue package has nothing to do with any Red or Blue packages that might happen to exist. That is, a relationship between Red::Blue and Red or Blue may have meaning to the person writing or using the program, but it means nothing to Perl. (Well, other than the fact that, in the current implementation, the symbol table Red::Blue happens to be stored in the symbol table Red. But the Perl language makes no use of that directly.)

For this reason, every package declaration must declare a complete package name. No package name ever assumes any kind of implied "prefix", even if (seemingly) declared within the scope of some other package declaration.

Only identifiers (names starting with letters or an underscore) are stored in a package's symbol table. All other symbols are kept in the main package, including all the nonalphabetic variables, like $!, $?, and $_. In addition, when unqualified, the identifiers STDIN, STDOUT, STDERR, ARGV, ARGVOUT, ENV, INC, and SIG are forced to be in package main, even when used for other purposes than their built-in ones. Don't name your package m, s, y, tr, q, qq, qr, qw, or qx unless you're looking for a lot of trouble. For instance, you won't be able to use the qualified form of an identifier as a filehandle because it will be interpreted instead as a pattern match, a substitution, or a transliteration.

Long ago, variables beginning with an underscore were forced into the main package, but we decided it was more useful for package writers to be able to use a leading underscore to indicate semi-private identifiers meant for internal use by that package only. (Truly private variables can be declared as file-scoped lexicals, but that works best when the package and module have a one-to-one relationship, which is common but not required.)

The %SIG hash (which is for trapping signals; see Chapter 16, "Interprocess Communication") is also special. If you define a signal handler as a string, it's assumed to refer to a subroutine in the main package unless another package name is explicitly used. Use a fully qualified signal handler name if you want to specify a particular package, or avoid strings entirely by assigning a typeglob or a function reference instead:

$SIG{QUIT} = "Pkg::quit_catcher"; # fully qualified handler name
$SIG{QUIT} = "quit_catcher";      # implies "main::quit_catcher"
$SIG{QUIT} = *quit_catcher;       # forces current package's sub
$SIG{QUIT} = \&quit_catcher;      # forces current package's sub
$SIG{QUIT} = sub { print "Caught SIGQUIT\n" };   # anonymous sub

The notion of "current package" is both a compile-time and run-time concept. Most variable name lookups happen at compile time, but run-time lookups happen when symbolic references are dereferenced, and also when new bits of code are parsed under eval. In particular, when you eval a string, Perl knows which package the eval was invoked in and propagates that package inward when evaluating the string. (You can always switch to a different package inside the eval string, of course, since an eval string counts as a block, just like a file loaded in with do, require, or use.)

Alternatively, if an eval wants to find out what package it's in, the special symbol __PACKAGE__ contains the current package name. Since you can treat it as a string, you could use it in a symbolic reference to access a package variable. But if you were doing that, chances are you should have declared the variable with our instead so it could be accessed as if it were a lexical.

10.1. Symbol Tables

The contents of a package are collectively called a symbol table. Symbol tables are stored in a hash whose name is the same as the package, but with two colons appended. The main symbol table's name is thus %main::. Since main also happens to be the default package, Perl provides %:: as an abbreviation for %main::.

Likewise, the symbol table for the Red::Blue package is named %Red::Blue::. As it happens, the main symbol table contains all other top-level symbol tables, including itself, so %Red::Blue:: is also %main::Red::Blue::.

When we say that a symbol table "contains" another symbol table, we mean that it contains a reference to the other symbol table. Since main is the top-level package, it contains a reference to itself, with the result that %main:: is the same as %main::main::, and %main::main::main::, and so on, ad infinitum. It's important to check for this special case if you write code that traverses all symbol tables.

Inside a symbol table's hash, each key/value pair matches a variable name to its value. The keys are the symbol identifiers, and the values are the corresponding typeglobs. So when you use the *NAME typeglob notation, you're really just accessing a value in the hash that holds the current package's symbol table. In fact, the following have (nearly) the same effect:

*sym = *main::variable;
*sym = $main::{"variable"};

The first is more efficient because the main symbol table is accessed at compile time. It will also create a new typeglob by that name if none previously exists, whereas the second form will not.

Since a package is a hash, you can look up the keys of the package and get to all the variables of the package. Since the values of the hash are typeglobs, you can dereference them in several ways. Try this:

foreach $symname (sort keys %main::) {
    local *sym = $main::{$symname};
    print "\$$symname is defined\n" if defined $sym;
    print "\@$symname is nonnull\n" if         @sym;
    print "\%$symname is nonnull\n" if         %sym;
}

Since all packages are accessible (directly or indirectly) through the main package, you can write Perl code to visit every package variable in your program. The Perl debugger does precisely that when you ask it to dump all your variables with the V command. Note that if you do this, you won't see variables declared with my since those are independent of packages, although you will see variables declared with our. See Chapter 20, "The Perl Debugger".

Earlier we said that only identifiers are stored in packages other than main. That was a bit of a fib: you can use any string you want as the key in a symbol table hash--it's just that it wouldn't be valid Perl if you tried to use a non-identifier directly:

$!@#$%           = 0;         # WRONG, syntax error.
${'!@#$%'}       = 1;         # Ok, though unqualified.

${'main::!@#$%'} = 2;         # Can qualify within the string.
print ${ $main::{'!@#$%'} }   # Ok, prints 2!

Assignment to a typeglob performs an aliasing operation; that is,

*dick = *richard;

causes variables, subroutines, formats, and file and directory handles accessible via the identifier richard to also be accessible via the symbol dick. If you want to alias only a particular variable or subroutine, assign a reference instead:

*dick = \$richard;

That makes $richard and $dick the same variable, but leaves @richard and @dick as separate arrays. Tricky, eh?

This is how the Exporter works when importing symbols from one package to another. For example:

*SomePack::dick = \&OtherPack::richard;

imports the &richard function from package OtherPack into SomePack, making it available as the &dick function. (The Exporter module is described in the next chapter.) If you precede the assignment with a local, the aliasing will only last as long as the current dynamic scope.

This mechanism may be used to retrieve a reference from a subroutine, making the referent available as the appropriate data type:

*units = populate() ;         # Assign \%newhash to the typeglob
print $units{kg};             # Prints 70; no dereferencing needed!

sub populate {
    my %newhash = (km => 10, kg => 70);
    return \%newhash;
}

Likewise, you can pass a reference into a subroutine and use it without dereferencing:

%units = (miles => 6, stones => 11);  
fillerup( \%units );          # Pass in a reference
print $units{quarts};         # Prints 4

sub fillerup {
    local *hashsym = shift;   # Assign \%units to the typeglob
    $hashsym{quarts} = 4;     # Affects %units; no dereferencing needed!
}

These are tricky ways to pass around references cheaply when you don't want to have to explicitly dereference them. Note that both techniques only work with package variables; they would not have worked had we declared %units with my.

Another use of symbol tables is for making "constant" scalars:

*PI = \3.14159265358979;

Now you cannot alter $PI, which is probably a good thing, all in all. This isn't the same as a constant subroutine, which is optimized at compile time. A constant subroutine is one prototyped to take no arguments and to return a constant expression; see Section 10.4.1, "Inlining Constant Functions" in Chapter 6, "Subroutines", for details. The use constant pragma (see Chapter 31, "Pragmatic Modules") is a convenient shorthand:

use constant PI => 3.14159;

Under the hood, this uses the subroutine slot of *PI, instead of the scalar slot used earlier. It's equivalent to the more compact (but less readable):

*PI = sub () { 3.14159 };

That's a handy idiom to know anyway--assigning a sub {} to a typeglob is the way to give a name to an anonymous subroutine at run time.

Assigning a typeglob reference to another typeglob (*sym = \*oldvar) is the same as assigning the entire typeglob, because Perl automatically dereferences the typeglob reference for you. And when you set a typeglob to a simple string, you get the entire typeglob named by that string, because Perl looks up the string in the current symbol table. The following are all equivalent to one another, though the first two compute the symbol table entry at compile time, while the last two do so at run time:

*sym =   *oldvar;
*sym =  \*oldvar;       # autodereference
*sym = *{"oldvar"};     # explicit symbol table lookup
*sym =   "oldvar";      # implicit symbol table lookup

When you perform any of the following assignments, you're replacing just one of the references within the typeglob:

*sym = \$frodo;
*sym = \@sam;
*sym = \%merry;
*sym = \&pippin;

If you think about it sideways, the typeglob itself can be viewed as a kind of hash, with entries for the different variable types in it. In this case, the keys are fixed, since a typeglob can contain exactly one scalar, one array, one hash, and so on. But you can pull out the individual references, like this:

*pkg::sym{SCALAR}      # same as \$pkg::sym
*pkg::sym{ARRAY}       # same as \@pkg::sym
*pkg::sym{HASH}        # same as \%pkg::sym
*pkg::sym{CODE}        # same as \&pkg::sym
*pkg::sym{GLOB}        # same as \*pkg::sym
*pkg::sym{IO}          # internal file/dir handle, no direct equivalent
*pkg::sym{NAME}        # "sym" (not a reference)
*pkg::sym{PACKAGE}     # "pkg" (not a reference)

You can say *foo{PACKAGE} and *foo{NAME} to find out what name and package the *foo symbol table entry comes from. This may be useful in a subroutine that is passed typeglobs as arguments:

sub identify_typeglob {
    my $glob = shift;
    print 'You gave me ', *{$glob}{PACKAGE}, '::', *{$glob}{NAME}, "\n";
}

identify_typeglob(*foo);
identify_typeglob(*bar::glarch);

This prints:

You gave me main::foo
You gave me bar::glarch

The *foo{THING} notation can be used to obtain references to individual elements of *foo. See the section Section 10.2.5, "Symbol Table References" in Chapter 8, "References" for details.

This syntax is primarily used to get at the internal filehandle or directory handle reference, because the other internal references are already accessible in other ways. (The old *foo{FILEHANDLE} is still supported to mean *foo{IO}, but don't let its name fool you into thinking it can distinguish filehandles from directory handles.) But we thought we'd generalize it because it looks kind of pretty. Sort of. You probably don't need to remember all this unless you're planning to write another Perl debugger.

Packages

Perl provides a mechanism for alternate namespaces to protect packages from stomping on each others variables. By default, a perl script starts compiling into the package known as "main". By use of the package declaration, you can switch namespaces. The scope of the package declaration is from the declaration itself to the end of the enclosing block (the same scope as the local() operator). Typically it would be the first declaration in a file to be included by the "require" operator. You can switch into a package in more than one place; it merely influences which symbol table is used by the compiler for the rest of that block. You can refer to variables and filehandles in other packages by prefixing the identifier with the package name and a single quote. If the package name is null, the "main" package as assumed.

Only identifiers starting with letters are stored in the packages symbol table. All other symbols are kept in package "main". In addition, the identifiers STDIN, STDOUT, STDERR, ARGV, ARGVOUT, ENV, INC and SIG are forced to be in package "main", even when used for other purposes than their built-in one. Note also that, if you have a package called "m", "s" or "y", the you can't use the qualified form of an identifier since it will be interpreted instead as a pattern match, a substitution or a translation.

Eval'ed strings are compiled in the package in which the eval was compiled in. (Assignments to $SIG{}, however, assume the signal handler specified is in the main package. Qualify the signal handler name if you wish to have a signal handler in a package.) For an example, examine perldb.pl in the perl library. It initially switches to the DB package so that the debugger doesn't interfere with variables in the script you are trying to debug. At various points, however, it temporarily switches back to the main package to evaluate various expressions in the context of the main package.

The symbol table for a package happens to be stored in the associative array of that name prepended with an underscore. The value in each entry of the associative array is what you are referring to when you use the *name notation. In fact, the following have the same effect (in package main, anyway), though the first is more efficient because it does the symbol table lookups at compile time:

	local(*foo) = *bar;
	local($_main{'foo'}) = $_main{'bar'};

You can use this to print out all the variables in a package, for instance. Here is dumpvar.pl from the perl library:

	package dumpvar;

	sub main'dumpvar {
	    ($package) = @_;
	    local(*stab) = eval("*_$package");
	    while (($key,$val) = each(%stab)) {
	        {
	            local(*entry) = $val;
	            if (defined $entry) {
	                print "\$$key = '$entry'\n";
	            }
	            if (defined @entry) {
	                print "\@$key = (\n";
	                foreach $num ($[ .. $#entry) {
	                    print "  $num\t'",$entry[$num],"'\n";
	                }
	                print ")\n";
	            }
	            if ($key ne "_$package" && defined %entry) {
	                print "\%$key = (\n";
	                foreach $key (sort keys(%entry)) {
	                    print "  $key\t'",$entry{$key},"'\n";
	                }
	                print ")\n";
	            }
	        }
	    }
	}

Note that, even though the subroutine is compiled in package dumpvar, the name of the subroutine is qualified so that its name is inserted

String Processing with Regular ExpressionsPerl's most famous strength is in string manipulation with regular expressions. Perl has a million string processing features -- we'll just cover the main ones here. The simple syntax to search for a pattern in a string is...

($string =~ /pattern/)  ## true if the pattern is found somewhere in the string

("binky" =~ /ink/)  ==> TRUE
("binky" =~ /onk/)  ==> FALSE
 

In the simplest case, the exact characters in the regular expression pattern must occur in the string somewhere. All of the characters in the pattern must be matched, but the pattern does not need to be right at the start or end of the string, and the pattern does not need to use all the characters in the string.

Character Codes

The power of regular expressions is that they can specify patterns, not just fixed characters. First, there are special matching characters...

• a, X, 9 -- ordinary characters just match that character exactly
• . (a period) -- matches any single character except "\n"
• \w -- (lowercase w) matches a "word" character: a letter or digit [a-zA-Z0-9]
• \W -- (uppercase W) any non word character
• \s -- (lowercase s) matches a single whitespace character -- space, newline, return, tab, form [ \n\r\t\f]
• \S -- (uppercase S) any non whitespace character
• \t, \n, \r  -- tab, newline, return
• \d -- decimal digit [0-9]
• \   -- inhibit the "specialness" of a character. So, for example, use \. to match a period or \\ to match a slash. If you are unsure if a character has special meaning, such as '@', you can always put a slash in front of it \@ to make sure it is treated just as a character.

"piiig" =~ /p...g/     ==> TRUE   . = any char (except \n)

"piiig" =~ /.../       ==> TRUE   need not use up the whole string

"piiig" =~ /p....g/    ==> FALSE  must use up the whole pattern (the g is not matched)

"piiig" =~ /p\w\w\wg/  ==> TRUE   \w = any letter or digit

"p123g" =~ /p\d\d\dg/  ==> TRUE   \d = 0..9 digit

The modifier "i" after the last / means the match should be case insensitive...

"PiIIg" =~ /pIiig/     ==> FALSE
"PiIIg" =~ /pIiig/i    ==> TRUE

String interpolation works in regular expression patterns. The variable values are pasted into the expression once before it is evaluated. Characters like * and + continue to have their special meanings in the pattern after interpolation, unless the pattern is bracketed with a \Q..\E. The following examples test if the pattern in $target occurs within brackets < > in $string...

$string =~ /<$target>/        ## Look for <$target>, '.' '*' keep their special meanings in $target

$string =~ /<\Q$target\E>/    ## The \Q..\E puts a backslash in front of every char,
                              ## so '.' '*' etc. in $target will not have their special meanings

Similar to the \Q..\E form, the quotemeta() function returns a string with every character \ escaped. There is an optional "m" (for "match") that comes before the first /. If the "m" is used, then any character can be used for the delimiter instead of / -- so you could use " or # to delimit the pattern. This is handy if what you are trying to match has a lot of /'s in it. If the delimiter is the single quote (') then interpolation is suppressed. The following expressions are all equivalent...

"piiig" =~ m/piiig/
"piiig" =~ m"piiig"
"piiig" =~ m#piiig#
 

Control Codes

Things get really interesting when you add in control codes to the regular expression pattern...

• ?   -- match 0 or 1 occurrences of the pattern to its left
• *   -- 0 or more occurrences of the pattern to its left
• +  -- 1 or more occurrences of the pattern to its left
• |   -- (vertical bar)  logical or -- matches the pattern either on its left or right
• parenthesis ( )  -- group sequences of patterns
• ^   -- matches the start of the string
• $   -- matches the end of the string

Leftmost & Largest

First, Perl tries to find the leftmost match for the pattern, and second it tries to use up as much of the string as possible -- i.e. let + and * use up as many characters as possible.

Regular Expression Examples

The following series gradually demonstrate each of the above control codes. Study them carefully -- small details in regular expressions make a big difference. That's what makes them powerful, but it makes them tricky as well.

Old joke: What do you call a pig with three eyes? Piiig!

#### Search for the pattern 'iiig' in the string 'piiig'
"piiig" =~ m/iiig/ ==> TRUE

#### The pattern may be anywhere inside the string
"piiig" =~ m/iii/ ==> TRUE

#### All of the pattern must match
"piiig" =~ m/iiii/ ==> FALSE

#### . = any char but \n
"piiig" =~ m/...ig/ ==> TRUE

"piiig" =~ m/p.i../ ==> TRUE

#### The last . in the pattern is not matched
"piiig" =~ m/p.i.../ ==> FALSE

#### \d = digit [0-9]
"p123g" =~ m/p\d\d\dg/ ==> TRUE

"p123g" =~ m/p\d\d\d\d/ ==> FALSE

#### \w = letter or digit
"p123g" =~ m/\w\w\w\w\w/ ==> TRUE

#### i+ = one or more i's
"piiig" =~ m/pi+g/ ==> TRUE

#### matches iii
"piiig" =~ m/i+/ ==> TRUE

"piiig" =~ m/p+i+g+/ ==> TRUE

"piiig" =~ m/p+g+/ ==> FALSE

#### i* = zero or more i's
"piiig" =~ m/pi*g/ ==> TRUE

"piiig" =~ m/p*i*g*/ ==> TRUE

#### X* can match zero X's
"piiig" =~ m/pi*X*g/ ==> TRUE

#### ^ = start, $ = end
"piiig" =~ m/^pi+g$/ ==> TRUE

#### i is not at the start
"piiig" =~ m/^i+g$/ ==> FALSE

#### i is not at the end
"piiig" =~ m/^pi+$/ ==> FALSE

"piiig" =~ m/^p.+g$/ ==> TRUE

"piiig" =~ m/^p.+$/ ==> TRUE

"piiig" =~ m/^.+$/ ==> TRUE

#### g is not at the start
"piiig" =~ m/^g.+$/ ==> FALSE

#### Needs at least one char after the g
"piiig" =~ m/g.+/ ==> FALSE

#### Needs at least zero chars after the g
"piiig" =~ m/g.*/ ==> TRUE

#### | = left or right expression
"cat" =~ m/^(cat|hat)$/ ==> TRUE

"hat" =~ m/^(cat|hat)$/ ==> TRUE

"cathatcatcat" =~ m/^(cat|hat)+$/ ==> TRUE

"cathatcatcat" =~ m/^(c|a|t|h)+$/ ==> TRUE

"cathatcatcat" =~ m/^(c|a|t)+$/ ==> FALSE

#### Matches and stops at first 'cat'; does not get to 'catcat' on the right
"cathatcatcat" =~ m/(c|a|t)+/ ==> TRUE

#### ? = optional
"12121x2121x2" =~ m/^(1x?2)+$/ ==> TRUE

"aaaxbbbabaxbb" =~ m/^(a+x?b+)+$/ ==> TRUE

"aaaxxbbb" =~ m/^(a+x?b+)+$/ ==> FALSE

#### Three words separated by spaces
"Easy      does it" =~ m/^\w+\s+\w+\s+\w+$/ ==> TRUE

#### Just matches "gates@microsoft" -- \w does not match the "."
"bill.gates@microsoft.com" =~ m/\w+@\w+/ ==> TRUE

#### Add the .'s to get the whole thing
"bill.gates@microsoft.com" =~ m/^(\w|\.)+@(\w|\.)+$/ ==> TRUE

#### words separated by commas and possibly spaces
"Klaatu,   barada,nikto" =~ m/^\w+(,\s*\w+)*$/ ==> TRUE

Character Classes

Square brackets can be used to represent a set of characters. For example [aeiouAEIOU] is a one character pattern that matches a vowel. Most characters are not special inside a square bracket and so can be used without a leading backslash (\). \w, \s, and \d work inside a character class, and the dash (-) can be used to express a range of characters, so [a-z] matches lowercase "a" through "z". So the \w code is equivalent to [a-zA-Z0-9]. If the first character in a character class is a caret (^) the set is inverted, and matches all the characters not in the given set. So [^0-9] matches all characters that are not digits.

The parts of an email address on either side of the "@" are made up of letters, numbers plus dots, underbars, and dashes. As a character class that's just [\w._-].

"bill.gates_emporer@microsoft.com" =~ m/^[\w._-]+@[\w._-]+$/ ==> TRUE
 

Match Variables

If a =~ match expression is true, the special variables $1, $2, ... will be the substrings that matched parts of the pattern in parenthesis -- $1 matches the first left parenthesis, $2 the second left parenthesis, and so on. The following pattern picks out three words separated by whitespace...

if ("this      and that" =~ /(\w+)\s+(\w+)\s+(\w+)/) {

  ## if the above matches, $1=="this", $2=="and", $3=="that"

This is a nice way to parse a string -- write a regular expression for the pattern you expect putting parenthesis around the parts you want to pull out. Only use $1, $2, etc. when the if =~ returns true. Other regular-expression systems use \1 and \2  instead of $1 $2, and Perl supports that syntax as well. There are three other special variables: $& (dollar-ampersand) = the matched string, $` (dollar-back-quote) = the string before what was matched, and $' (dollar-quote) = the string following what was matched.

The following loop rips through a string and pulls out all the email addresses. It demonstrates using a character class, using $1 etc. to pull out parts of the match string, and using $' after the match.

$str = 'blah blah nick@cs.stanford.edu, blah blah balh billg@microsoft.com blah blah';

while ($str =~ /(([\w._-]+)\@([\w._-]+))/) { ## look for an email addr
  print "user:$2 host:$3  all:$1\n";         ## parts of the addr
  $str = $';       ## set the str to be the "rest" of the string
}

output:
user:nick host:cs.stanford.edu  all:nick@cs.stanford.edu
user:billg host:microsoft.com  all:billg@microsoft.com
 

Substitution

A slight variation of the match operator can be used to search and replace. Put an "s" in front of the pattern and follow the match pattern with a replacement pattern.

## Change all "is" strings to "is not" -- a sure way to improve any document
$str =~ s/is/is not/ig;

The replacement pattern can use $1, $2 to refer to parts of the matched string. The "g" modifier after the last / means do the replacement repeatedly in the target string. The modifier "i" means the match should not be case sensitive. The following example finds instances of the letter "r" or "l" followed by a word character, and replaces that pattern with "w" followed by the same word character. Sounds like Tweety Bird...

## Change "r" and "l" followed by a word char to "w" followed
## by the same word char
$x = "This dress exacerbates the genetic betrayal that is my Legacy.\n";
$x =~ s/(r|l)(\w)/w$2/ig;    ## r or l followed by a word char
## $x is now "This dwess exacewbates the genetic betwayal that is my wegacy."
 

The ? Trick

One problem with * and +, is that they are "greedy" -- they try to use up as many characters as they can. Suppose you are trying to pick out all of the characters between two curly braces { }. The simplest thing would be to use the pattern...

m/{(.*)}/  -- pick up all the characters between {}'s

The problem is that if you match against the string "{group 1} xx {group 2}", the * will aggressively run right over the first } and match the second }. So $1 will be "group 1} xx {group 2" instead of "group 1". Fortunately Perl has a nice solution to the too-aggressive-*/+ problem. If a ? immediately follows the * or +, then it tries to find the shortest repetition which works instead of the longest. You need the ? variant most often when matching with .* or \S* which can easily use up more than you had in mind. Use ".*?" to skip over stuff you don't care about, but have something you do care about immediately to its right. Such as..

m/{(.*?)}/ ## pick up all the characters between {}'s, but stop
           ## at the first }
 

The old way to skip everything up until a certain character, say }, uses the [^}] construct like this...

m/{([^}]*)}/ ## the inner [^}] matches any char except }

I prefer the (.*?) form. In fact, I suspect it was added to the language precisely as an improvement over the [^}]* form.

Substring

The index(string, string-to-look-for, start-index) operator searches the first string starting at the given index for an occurrence of the second string. Returns the 0 based index of the first occurrence, or -1 if not found. The following code uses index() to walk through a string and count the number of times "binky" occurs.

$count = 0;
$pos = 0;
while ( ($pos = index($string, "binky", $pos) != -1) {
 $count++;
 $pos++;
}
 

The function substr(string, index, length) pulls a substring out of the given string. Substr() starts at the given index and continues for the given length.
 

Split

The split operator takes a regular expression, and a string, and returns an array of all the substrings from the original string which were separated by that regular expression. The following example pulls out words separated by commas possibly with whitespace thrown in...

split(/\s*,\s*/, "dress ,      betrayal    ,  legacy") ## returns the array
   ("dress", "betrayal", "legacy")
 

Split is often a useful way to pull an enumeration out of some text for processing. If the number -1 is passed as a third argument to split, then it will interpret an instance of the separator pattern at the end of the string as marking a last, empty element (note the comma after the last word)...

split(/\s*,\s*/, "dress ,      betrayal    ,  legacy,", -1) ## returns the array
   ("dress", "betrayal", "legacy", "")
 

Character Translate -- tr

The tr// operator goes through a string and replaces characters with other characters.

$string =~ tr/a/b/;  -- change all a's to b's
$string =~ tr/A-Z/a-z/; -- change uppercase to lowercase   (actually lc() is better for this)