File Coverage

blib/lib/perl5i/0/Meta/Instance.pm

Criterion	Covered	Total	%
statement	9	29	31.0
branch	0	8	0.0
condition	0	3	0.0
subroutine	3	8	37.5
pod	0	5	0.0
total	12	53	22.6

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;