view release on metacpan or  search on metacpan

inc/Scalar/Util/PP.pm  view on Meta::CPAN

  $addr =~ /0x(\w+)/;
  local $^W;
  no warnings 'portable';
  hex($1);
}

{
  my %tmap = qw(
    B::NULL   SCALAR

    B::HV     HASH
    B::AV     ARRAY
    B::CV     CODE
    B::IO     IO
    B::GV     GLOB
    B::REGEXP REGEXP
  );

  sub reftype ($) {
    my $r = shift;

    return undef unless length(ref($r));

    my $t = ref(svref_2object($r));

    return
        exists $tmap{$t} ? $tmap{$t}
      : length(ref($$r)) ? 'REF'
      :                    'SCALAR';
  }
}

sub tainted {
  local($@, $SIG{__DIE__}, $SIG{__WARN__});
  local $^W = 0;
  no warnings;
  eval { kill 0 * $_[0] };
  $@ =~ /^Insecure/;
}

sub readonly {
  return 0 if tied($_[0]) || (ref(\($_[0])) ne "SCALAR");

  local($@, $SIG{__DIE__}, $SIG{__WARN__});
  my $tmp = $_[0];

  !eval { $_[0] = $tmp; 1 };
}

sub looks_like_number {
  local $_ = shift;

  # checks from perlfaq4
  return 0 if !defined($_);
  if (ref($_)) {
    require overload;
    return overload::Overloaded($_) ? defined(0 + $_) : 0;
  }
  return 1 if (/^[+-]?[0-9]+$/); # is a +/- integer
  return 1 if (/^([+-]?)(?=[0-9]|\.[0-9])[0-9]*(\.[0-9]*)?([Ee]([+-]?[0-9]+))?$/); # a C float
  return 1 if ($] >= 5.008 and /^(Inf(inity)?|NaN)$/i) or ($] >= 5.006001 and /^Inf$/i);

  0;
}


1;