package Net::Amazon::MechanicalTurk::BaseObject;
use strict;
use warnings;
use Carp;
use IO::File;
our $VERSION = '1.01_01';
use constant USE_QUALIFIED_ATTRIBUTE_NAMES => 1;
our %CLASS_DEBUG;
sub new {
my $class = shift;
my $self = bless {}, $class;
$self->init(@_);
return $self;
}
sub init {}
sub DESTROY {}
sub assertRequiredAttributes {
my $self = shift;
foreach my $attr (@_) {
if (!defined($self->$attr)) {
Carp::croak("Required attribute ${attr} was not set.");
}
}
}
sub setAttributesIfNotDefined {
my $self = shift;
my %attrs = ($#_ == 0) ? %{$_[0]} : @_;
while (my ($attr,$value) = each %attrs) {
eval { $self->$attr($value) unless defined($self->$attr); };
if ($@) { Carp::croak("Can't set attribute $attr - $@"); }
}
}
sub setAttributes {
my $self = shift;
my %attrs = ($#_ == 0) ? %{$_[0]} : @_;
while (my ($attr,$value) = each %attrs) {
eval { $self->$attr($value); };
if ($@) { Carp::croak("Can't set attribute $attr - $@"); }
}
}
sub trySetAttributes {
my $self = shift;
my %attrs = ($#_ == 0) ? %{$_[0]} : @_;
my %unsetAttrs;
while (my ($attr,$value) = each %attrs) {
if (UNIVERSAL::can($self, $attr)) {
eval {
$self->$attr($value);
};
if ($@) {
Carp::carp("Couldn't set attribute $attr - $@");
$unsetAttrs{$attr} = $value;
}
}
else {
$unsetAttrs{$attr} = $value;
}
}
return \%unsetAttrs;
}
sub attributes {
my $self = shift;
foreach my $attr (@_) {
$self->attribute($attr);
}
}
sub methodAlias {
my $self = shift;
my %aliases = @_;
my $class = ref($self) || $self;
while (my ($alias,$existing) = each %aliases) {
my $sub = UNIVERSAL::can($class, $existing);
if (!$sub) {
Carp::croak("Method $existing does not exist.");
}
no strict 'refs';
no warnings;
*{"${class}::${alias}"} = $sub;
}
}
sub attribute {
my $self = shift;
my $attr = shift;
my $attr_name = shift || $attr;
my $class = ref($self) || $self;
if (USE_QUALIFIED_ATTRIBUTE_NAMES) {
$attr_name = "${class}::${attr_name}";
}
no strict 'refs';
no warnings;
# Create a subroutine for an attribute getter/setter
*{"${class}::${attr}"} = sub {
my $_self = shift;
if ($#_ == 0) {
$_self->{$attr_name} = $_[0];
}
return $_self->{$attr_name};
};
}
sub debug {
my $self = shift;
my $class = ref($self) || $self;
if ($#_ >= 0) {
my $debug = shift;
if (UNIVERSAL::isa($debug, "CODE") or
UNIVERSAL::isa($debug, "GLOB") or
UNIVERSAL::can($debug, "debugMessage"))
{
$CLASS_DEBUG{$class} = $debug;
}
elsif ($debug =~ /^STDERR$/i or $debug =~ /^(1|yes|true)$/i) {
$CLASS_DEBUG{$class} = \*STDERR;
}
elsif ($debug =~ /^STDOUT$/i) {
$CLASS_DEBUG{$class} = \*STDOUT;
}
elsif ($debug and $debug !~ /^(0|no|false)$/i) { # true value indicating file
$CLASS_DEBUG{$class} = IO::File->new($debug, "a");
if (!$CLASS_DEBUG{$class}) {
print "Setting debug on $class to STDERR\n";
# Couldn't open so go to STDERR.
$CLASS_DEBUG{$class} = \*STDERR;
}
else {
$CLASS_DEBUG{$class}->autoflush(1);
}
}
else {
delete $CLASS_DEBUG{$class};
}
}
return $CLASS_DEBUG{$class};
}
sub debugMessage {
my $self = shift;
my $debug = $self->debug;
if (!defined($debug)) {
return;
}
my @stack = caller(1);
my @time = localtime(time());
my $prefix = sprintf("[%04d-%02d-%02d %02d:%02d:%02d] %s >> ",
$time[5] + 1900,
$time[4] + 1,
$time[3],
$time[2],
$time[1],
$time[0],
$stack[3]
);
my @messages = split(/\n/, join(" ", @_));
if (UNIVERSAL::isa($debug, "GLOB")) {
foreach my $msg (@messages) {
print $debug $prefix.$msg."\n";
}
}
elsif (UNIVERSAL::isa($debug, "CODE")) {
foreach my $msg (@messages) {
$debug->($prefix.$msg."\n");
}
}
else {
foreach my $msg (@messages) {
$debug->debugMessage($prefix.$msg."\n");
}
}
}
return 1;