So, use it or not? (page 1)

Use it for any complicated code that others will have to deal with. Use it no matter how small the script is if there are other scripts that are similar and could be combined in a family. Use it for anything that’s not a shell script in shift()‘s clothing. And start with it. It does take a little longer at the outset, so if you start a project procedurally and half-way through realize it was a job for OOP, you’ll be sorry. No one likes rewriting code, especially one’s own.

Let’s get back to our HTML text coloring module.

package OOPminiscule;
#=====================================================================
sub new { return bless \$empty_scalar, shift }
#=====================================================================
sub AUTOLOAD {
    no warnings;
    my ( $color ) = $AUTOLOAD =~ /^.+::(\w+)$/;
    $color = $color =~ /^[A-F0-9]{6}$/ ? "#$color" : $color;
    *{$AUTOLOAD} = sub {qq|<span style="color:$color">| . 
                            join($",@_[1..$#_]) .
                                "</span>\n" };
    &{$AUTOLOAD};
}
1;

Line 1 we declare the package. We are running without strict which is a no-no but hey, 11 lines of code for a full OOP color module, it’s fun to say, “I can write that module in 11 lines.”

new() is a constructor for the shell of the object. We are never going to have real methods. All methods will be AUTOLOADED. The object is nothing but a placeholder for the namespace that has the AUTOLOAD() we need to construct color methods as we go.

Because our object is a shell, a placeholder, a false object, we don’t care about what it is. Objects are typically constructed of hashes or things that look like hashes. The inimitably flexible Perl don’t give a rat’s rectum what your object is based on. You can make objects from any data types or even as closures or regexes. In this case, it makes no difference so we make the object of the quickest, most innocuous data type: a scalar, \$empty_scalar. sub new { return bless \$empty_scalar, shift } Blesses the namespace (so we have access to its AUTOLOAD) into an empty scalar.

Then we add our AUTOLOAD to take care of automatically creating any color making methods we need as we go.

So why aren’t we done? It’s broken and missing functionality.

This…

print $c->003399('Oooooh, blue.');

doesn’t give us a nice #003399 color. When we try to use it in a script. It gives us something along these lines…

Illegal octal digit '9' at end of line
Number found where operator expected, near "->003399"
        (Missing operator before 003399?)
syntax error, near "->003399"
Execution of aborted due to compilation errors.

Let’s fix it. The problem is that AUTOLOAD will work fine on anything that fits the definition of a perl subroutine. I.e. /^[_a-zA-Z]\w*$/. Subroutines cannot start with a number. So calling 003399() as a method (via AUTOLOAD) breaks the script.

package OOPminisculeHEX;
#=====================================================================
sub new { return bless \$empty_scalar, shift }
#=====================================================================
sub AUTOLOAD {
    no warnings;
    $AUTOLOAD =~ /^.+::(\w+)$/;
    my $color = substr($1,0,3) eq 'hex' ?
        '#' . substr($1,3,8) : $1;
    *{$AUTOLOAD} = sub {qq|<span style="color:$color">| . 
                            join($",@_[1..$#_]) .
                                "</span>\n" };
    &{$AUTOLOAD}; 
}
1;

We’ve changed three lines of code.

$AUTOLOAD =~ /^.+::(\w+)$/;
    my $color = substr($1,0,3) eq 'hex' ?
        '#' . substr($1,3,8) : $1;

package OOPminimal;
#=====================================================================
%COLORS = qw( cornflower        6495ED 
              trademark_yellow  FCDE91 );
#=====================================================================
sub new { return bless {}, shift }
#=====================================================================
sub AUTOLOAD {
    my ( $ego, @text ) = @_;
    $AUTOLOAD =~ /^.+::(\w+)$/;
    $color2print = $COLORS{$1} ?  '#' . $COLORS{$1} : $1;
    *{$AUTOLOAD} = sub {qq|<span style="color:$color2print">| . 
                            join($",@_[1..$#_]) . "</span>\n" };
     &{$AUTOLOAD}; 
}
1;  # POD? what's POD?

Final version

The comments make it look large but the module has less than 50 lines of code.

#  WELCOME TO OOPcolor! (c)2001 apv -- see POD
#=====================================================================
#  PACKAGE OOPcolor
#=====================================================================
package OOPcolor;  # <-- our namespace

#  if this was for real, we might call this OOPclr out of respect for
#  our brethren left behind in the Puritan and Potato exodi.
#  remember, think globally code locally. perl is a world community.

use strict;

#  this allows users of modules to find problems are generated w/i
#  this namespace by outside scripts
use Carp;
#=====================================================================
#  OOPcolor DATA
#=====================================================================
#  we are only going to be OOP so we won't use/need the EXPORTER
use vars qw( $AUTOLOAD $VERSION %COLORS );

#  this is silly, but optimistic, there is no throw-away code
$VERSION = '0.1'; 

#  we can have as many colors as we want. the module would need to
#  support a config system to be useful in a production environment.
%COLORS = qw(
             cornflower    6495ED
             );
{ # keep the methods a bit more private
#=====================================================================
#  FAMILY WIDE METHODS
#=====================================================================
sub new {

#  no args will be used as it stands, but it could be extended to take
#  font sizes, families, default colors, etc through %arg
    my ( $caller, %arg ) = @_;

#  also unecessary for now but we might want to let objects make new
#  objects down the road
    my $class = ref($caller) || $caller; 

#  now we make an object. most kids use $self for the object name w/i
#  methods. i prefer $ego since it means the same thing and is a
#  little shorter. anyone who complains about it being non-standard
#  should learn to use the find/replace in their text editor.  :)

    my $ego = bless {}, $class;

#  we used a hash as the object but we aren't filling it with anything
#  for version 0.1

#  OOPcolor objects have no attributes to initialize so we're done,
#  give the object back
    return $ego;
}
#=====================================================================
sub AUTOLOAD {

#  ALL methods are AUTOLOAD'd in this module
    no strict 'refs';
    my ( $ego, @text ) = @_;

    $AUTOLOAD =~ /^.+::(\w+)$/;

    my $color = $1; # we matched off the method call OOPcolor::(color)

    my $color2print;

    if ( $COLORS{$color} )    # great it's a preset hex in %COLORS 
    {
        $color2print = '#' . $COLORS{$color};
    } 
    elsif ( $color =~ /^X_[A-F0-9]{6}$/ ) # it's a custom hex
    {
        $color2print = '#' . $color;
    }
    elsif ( $color =~ /^X_/ )             # it's a mistake. die!
    {
        croak "Check your method: $AUTOLOAD!";
    }
    else 
    {
        carp "No predetermined method: $AUTOLOAD, coloring as is!";
        $color2print = $color;
    }
#  here we establish the subroutine, we do *not* execute it
    *{$AUTOLOAD} = 
        sub {
             return '<span style="color:' . $color2print . '">' .
                join($",@_[1..$#_]) . "</span>\n";        
            };

#  here we execute it, @_ carries b/c of context. remember this only
#  happens the first time the sub is called during the life of the
#  script. the autoloaded subroutine is in memory hereon
     &{$AUTOLOAD}; 
}
#=====================================================================
sub DESTROY { 1 }          # prevent it from being looked for
}#====================================================================
#  OOPcolor ENDS
#=====================================================================
1;  # let's eval true, shall we?
#=====================================================================
#  POD
#=====================================================================

=head1 NAME

OOPcolor

=head1 DESCRIPTION

Easy, arbitrary, and customizable HTML colors with text.

=head1 SYNOPSIS

  use strict;
  use OOPcolor;
  my $K = OOPcolor->new();
  print $K->sienna("This reminds me of Italy.");

=head1 METHODS

=head2 new

  my $K = OOPcolor->new();

=head2 named colors

Named colors are dependant on the browser understanding them. "Blue,"
"red," "green," and many odd variants like "vermilion" are probably
going to work but you should verfiy them on a web color chart and
check them against all current browsers before using them in
production.

=head2 hex colors

Any color matching X_([A-F0-9]{6}) will be interpreted as hexadecimal
and rendered as such.

=head2 custom colors

Named colors are hardcoded in the module. They can be edited, added,
or removed via %COLORS. The keys are the names and the values are hex
colors. For the next version we should make them into a configuration
file so that many users of the same installation can have many custom
colors. They take precendence over named colors so you could have a
custom "blue."

=head1 COPYRIGHT

(c)2001, Ashley Pond V, distribute and modify under the same terms as
Perl.

=cut

Discussion

This example is not the best to demonstrate the power of OOP. In fact, it borders on the “silly gimick” warned of in the introduction and if this is all you ever want it to do, a procedural module would be superior. An object would have to have attributes and perhaps work with inheritance to show its real power. Still, this example has the advantage of being brief. :)

I’ve picked up OOP from many sources including:

Conway, Damian. Object Oriented Perl.
        Manning Publications (1884777791). 1999.

Christiansen, Tom. "perltoot." perldoc. 1997.