my $agent = new Agent;
print $agent->random() . "\n";
package Agent;
my $VERSION = "1.0.0";
use vars qw ($AUTOLOAD);
{
my %_attr_data =
(
_debug => [ 0, "rw" ],
_last_error => [ '', "rw" ],
);
sub _accessible
{
my ($self, $attr, $mode) = @_;
$_attr_data{$attr}[1] =~ /$mode/
}
sub _default_for
{
my ($self, $attr) = @_;
$_attr_data{$attr}[0];
}
sub _standard_keys
{
keys %_attr_data;
}
sub new
{
my ($caller, %arg) = @_;
my $caller_is_obj = ref($caller);
my $class = $caller_is_obj || $caller;
my $self = bless {}, $class;
foreach my $membername ( $self->_standard_keys() )
{
my ($argname) = ($membername =~ /^_(.*)/);
if (exists $arg{$argname})
{ $self->{$membername} = $arg{$argname} }
elsif ($caller_is_obj)
{ $self->{$membername} = $caller->{$membername
+} }
else
{ $self->{$membername} = $self->_default_for($
+membername) }
}
return $self;
}
sub random
{
my ($self) = @_;
my @l = ( "en", "de", "dk", "sh", "cz", "tv", "ca", "fr" );
my @v = ( "2.0", "2.1", "2.2", "2.3",
"3.0", "3.1", "4.0", "4.1", "4.1.1", "4.2", "4.4",
"4.5", "4.51", "4.52", "4.53", "4.54", "4.55", "4.7",
+"4.71",
"5.0", "5.1", "5.5", "6.0", "6.1", );
my @b = ( "a", "b", "g", "rc" );
my @n = ( 1 .. 9);
my @c = ( "AOL", "Netscape", "Mozilla", "MSIE", "Lynx", "Jimmy
+ James Inc." );
my @p = ( "Windows 98", "Windows ME", "Windows XP", "Windows 9
+5",
"Mac_PowerPC", "Apple II+", "Apple //e", "Apple //gs",
+
"Windows 3.1", "MSN", "AOL", "DigExt", "Win 9x", "Win
+9x 4.90",
"Gulliver", "WebTV", "CP/M", "Commodore-PET", );
my $c = int (rand ($#c));
my $cc = $c ? $c - 1 : $c + 1;
return $c[$c] .
"/" .
$v[rand $#v] .
(int (rand (65535)) < 8192 ? $b[rand $#b] . $n[rand $#
+n] : "") .
" [" . $l[rand $#l] . "] " .
"(compatible; " .
$c[$cc] . " " .
$v[rand $#v] .
(int (rand (65535) > 32767) ? $b[rand $#b] . $n[rand $
+#n] : "") .
"; " .
$p[rand $#p] .
")";
}
sub AUTOLOAD
{
no strict "refs";
my ($self, $newval) = @_;
if ($AUTOLOAD =~ /.*::get(_\w+)/ && $self->_accessible($1,'r')
+)
{
my $attr_name = $1;
*{$AUTOLOAD} = sub { return $_[0]->{$attr_name} };
return $self->{$attr_name}
}
if ($AUTOLOAD =~ /.*::set(_\w+)/ && $self->_accessible($1,'rw'
+))
{
my $attr_name = $1;
*{$AUTOLOAD} = sub { $_[0]->{$attr_name} = $_[1] };
$self->{$1} = $newval;
return
}
my ($package, $filename, $line) = caller;
$self->set_last_error
("no such method: $AUTOLOAD ($package, $filename, $lin
+e)");
return undef;
}
sub DESTROY
{
}
}
1;