package perl5i::0::Meta::Instance;
use strict;
use warnings;
require Scalar::Util;
require overload;
require Carp;
use parent qw(perl5i::0::Meta);
sub class {
return ref ${$_[0]};
}
sub reftype {
return Scalar::Util::reftype(${$_[0]});
}
# Only instances can be tainted
# Returns the code which will run when the object is used as a string
my $has_string_overload = sub {
return overload::Method(${$_[0]}, q[""]) || overload::Method(${$_[0]}, q[0+])
};
sub is_tainted {
my $code;
if( $code = $_[0]->$has_string_overload ) {
require Taint::Util;
return Taint::Util::tainted( $code->(${$_[0]}) );
}
else {
return 0;
}
die "Never should be reached";
}
sub taint {
if( $_[0]->$has_string_overload ) {
Carp::croak "Untainted overloaded objects cannot normally be made tainted" if
!$_[0]->is_tainted;
return 1;
}
else {
Carp::croak "Only scalars can normally be made tainted";
}
Carp::confess "Should not be reached";
}
sub untaint {
if( $_[0]->$has_string_overload && $_[0]->is_tainted ) {
Carp::croak "Tainted overloaded objects cannot normally be untainted";
}
else {
return 1;
}
Carp::confess "Should never be reached";
}
1;