package Soldier;
use constant NAME => 0;
use constant RANK => 1;
use constant SERIAL => 2;
sub new {
my $class = shift;
$class = ref($class) || $class;
my $self = [ "", "Private", 000 ];
bless($self, $class);
return $self;
}
sub name {
my $self = shift;
if (@_) {
$self->[NAME] = shift;
}
return $self->[NAME];
}
# similar methods for RANK and SERIAL
####
package Password;
use Digest::MD5 qw(md5_base64); # based on an idea by jbontje
sub new {
my $class = shift;
$class = ref($class) || $class;
my $self = shift; # takes a cleartext string for the password
$self = md5_base64($self);
bless($self, $class);
return $self;
}
sub verify {
my $self = shift;
my $candidate = shift;
return ($self eq md5_base64($candidate));
}
##
##
package WordMatch;
sub new {
my $class = shift;
$class = ref($class) || $class;
my $word = shift; # word to match
my $self = qr/\[$word\]/;
bless($self, $class);
return $self;
}
sub match {
my $self = shift;
my $string = shift;
return $string =~ $self ? "Matches!" : "Doesn't match!";
}
package main;
my $wm = WordMatch->new("hi");
print $wm->match("[hi] how are you?"), "\n";
print $wm->match("hi how are you?"), "\n";
##
##
package ReadFile;
use Symbol;
sub new {
my $class = shift;
$class = ref($class) || $class;
my $file = shift;
my $self = gensym;
open ($self, $file) || die;
bless($self, $class);
return $self;
}
sub read_record {
my $self = shift;
local $/ = shift || $/;
my $line = <$self>;
return $line;
}
##
##
my $file = ReadFile->new("obself.pl");
print $file->read_record("package");
print $file->read_record();
##
##
sub DESTROY {
my $self = shift;
close $self;
print "Closed!\n"; # just to prove that it's working
}
##
##
package SubBrowser;
sub new {
my $class = shift;
$class = ref($class) || $class;
my $package = shift;
my $subname = shift;
# assume $package is a reference to a hash of in-memory source code,
# keyed by subroutine name
my $sub;
eval { $sub = $package->{$subname}; }; # ooh, tricky
bless($sub, $class);
return $sub;
}
sub display_args {
# get data from $package
}
sub display_returns {
# get data from $package
}
sub test {
my $self = shift;
return &$self;
}
##
##
package Wrapper;
use vars '$AUTOLOAD';
sub new {
my $class = shift;
$class = ref($class) || $class;
my $obj = shift;
my $self = \$obj;
bless($self, $class);
return $self;
}
sub AUTOLOAD {
my $self = shift;
return if $AUTOLOAD =~ /::DESTROY/;
$AUTOLOAD =~ s/.*:://;
no strict 'refs';
print "Do something interesting here.\n";
return $$self->$AUTOLOAD(@_);
}
package main;
# as before
my $wm = WordMatch->new("hi");
print $wm->match("[hi] how are you?"), "\n";
print $wm->match("hi how are you?"), "\n";
# our new version
my $wm2 = Wrapper->new(WordMatch->new("Hello"));
print $wm2->match("[Hello] little girl"), "\n";