File Coverage

blib/lib/Acme/Tao.pm

Criterion	Covered	Total	%
statement	38	38	100.0
branch	11	14	78.5
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	54	57	94.7

package Acme::Tao;

use constant 1.01;
use strict;
no strict 'refs';

use vars qw(@messages $VERSION);

$VERSION = 0.03;

@messages = (
    qq(
The Tao doesn't take sides;
it gives birth to both wins and losses.
),
    qq(
        A novice asked the master: "I have a program that sometimes runs and
sometimes aborts.  I have followed the rules of programming, yet I am totally
baffled. What is the reason for this?"
        The master replied: "You are confused because you do not understand
the Tao.  Only a fool expects rational behavior from his fellow humans.  Why
do you expect it from a machine that humans have constructed?  Computers
simulate determinism; only the Tao is perfect.
        The rules of programming are transitory; only the Tao is eternal.
Therefore you must contemplate the Tao before you receive enlightenment."
        "But how will I know when I have received enlightenment?" asked the
novice.
        "Your program will then run correctly," replied the master.
                -- Geoffrey James, "The Tao of Programming"
),
    qq(
        In the beginning was the Tao.  The Tao gave birth to Space and Time.
Therefore, Space and Time are the Yin and Yang of programming.

        Programmers that do not comprehend the Tao are always running out of
time and space for their programs.  Programmers that comprehend the Tao always
have enough time and space to accomplish their goals.
        How could it be otherwise?
                -- Geoffrey James, "The Tao of Programming"
),
);

sub import {
    my $class = shift;
    if(@_) {
        my($pkg, $file, $line) = caller;
        foreach my $v (@_) {

            # this is based on the perl 5.6.1 perldoc (perldoc constant)
            # not sure why we have to pass $v through a regex -- otherwise,
            # it gives us an error that we are trying to modify a constant
            # value (which might be due to the pos($v) being modified)

            $v =~ m{(.*)};
            my $u = $1;
            $u =~ s/^::/main::/;
            my $full_name = $v =~ m{::} ? $u : "${pkg}::$u";
            die "Uh, Oh!  $full_name was declared constant before line $line of $file.\n"
                if $constant::declared{$full_name};
        }
    }
    else {
        if(grep /::Tao$/, keys %constant::declared) {
            my @isas = ($class, @{"${class}::ISA"});
            my $messages;
            while(@isas) {
                my $c = shift @isas;
                if(@{"${c}::ISA"}) {
                    unshift @isas, @{"${c}::ISA"};
                }
                if(@{"${c}::messages"}) {
                    $messages = \@{"${c}::messages"};
                    last;
                }
            }
            # randomly determine if we die or not
            return if rand(rand) < rand(rand);
            die "The Tao is not constant:\n", $messages->[rand @$messages], "\n"
        }
    }
}

1;

__END__