# License or the Artistic License, as specified in the README file.
#
package B;
+
+our $VERSION = '1.01';
+
use XSLoader ();
require Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw(minus_c ppname save_BEGINs
class peekop cast_I32 cstring cchar hash threadsv_names
main_root main_start main_cv svref_2object opnumber
- amagic_generation
+ amagic_generation perlstring
walkoptree_slow walkoptree walkoptree_exec walksymtable
parents comppadlist sv_undef compile_stats timing_info
- begin_av init_av end_av);
+ begin_av init_av end_av regex_padav);
sub OPf_KIDS ();
use strict;
# The regex below corresponds to the isCONTROLVAR macro
# from toke.c
- $name =~ s/^([\cA-\cZ\c\\c[\c]\c?\c_\c^])/"^".chr(64 ^ ord($1))/e;
+ $name =~ s/^([\cA-\cZ\c\\c[\c]\c?\c_\c^])/"^".
+ chr( utf8::unicode_to_native( 64 ^ ord($1) ))/e;
+
+ # When we say unicode_to_native we really mean ascii_to_native,
+ # which matters iff this is a non-ASCII platform (EBCDIC).
+
return $name;
}
return (($self->FLAGS() & SVf_IVisUV()) ? $self->UVX : $self->IV);
}
+sub B::NULL::as_string() {""}
+sub B::IV::as_string() {goto &B::IV::int_value}
+sub B::PV::as_string() {goto &B::PV::PV}
+
my $debug;
my $op_count = 0;
my @parents = ();
}
shift @parents;
}
+ if (class($op) eq 'PMOP' && $op->pmreplroot && ${$op->pmreplroot}) {
+ unshift(@parents, $op);
+ walkoptree_slow($op->pmreplroot, $method, $level + 1);
+ shift @parents;
+ }
}
sub compile_stats {
my ($symref, $method, $recurse, $prefix) = @_;
my $sym;
my $ref;
- no strict 'vars';
- local(*glob);
+ my $fullname;
+ no strict 'refs';
$prefix = '' unless defined $prefix;
while (($sym, $ref) = each %$symref) {
- *glob = "*main::".$prefix.$sym;
+ $fullname = "*main::".$prefix.$sym;
if ($sym =~ /::$/) {
$sym = $prefix . $sym;
if ($sym ne "main::" && $sym ne "<none>::" && &$recurse($sym)) {
- walksymtable(\%glob, $method, $recurse, $sym);
+ walksymtable(\%$fullname, $method, $recurse, $sym);
}
} else {
- svref_2object(\*glob)->EGV->$method();
+ svref_2object(\*$fullname)->$method();
}
}
}
for ordinary scalars it will return the string that you'd see
from Perl, even if it contains null characters.
+=item RV
+
+Same as B::RV::RV, except that it will die() if the PV isn't
+a reference.
+
=item PVX
This method is less often useful. It assumes that the string
=item MOREMAGIC
+=item precomp
+
+Only valid on r-magic, returns the string that generated the regexp.
+
=item PRIVATE
=item TYPE
=item OBJ
+Will die() if called on r-magic.
+
=item PTR
+=item REGEX
+
+Only valid on r-magic, returns the integer value of the REGEX stored
+in the MAGIC.
+
=back
=head2 B::PVLV METHODS
=item IoFLAGS
+=item IsSTD
+
+Takes one arguments ( 'stdin' | 'stdout' | 'stderr' ) and returns true
+if the IoIFP of the object is equal to the handle whose name was
+passed as argument ( i.e. $io->IsSTD('stderr') is true if
+IoIFP($io) == PerlIO_stdin() ).
+
=back
=head2 B::AV METHODS
=item XSUBANY
+For constant subroutines, returns the constant SV returned by the subroutine.
+
=item CvFLAGS
=item const_sv
=item pmflags
+=item pmdynflags
+
=item pmpermflags
=item precomp
+=item pmoffet
+
+Only when perl was compiled with ithreads.
+
=back
=head2 B::SVOP METHOD
Returns the AV object (i.e. in class B::AV) representing INIT blocks.
+=item begin_av
+
+Returns the AV object (i.e. in class B::AV) representing BEGIN blocks.
+
+=item end_av
+
+Returns the AV object (i.e. in class B::AV) representing END blocks.
+
=item main_root
Returns the root op (i.e. an object in the appropriate B::OP-derived
Returns the AV object (i.e. in class B::AV) of the global comppadlist.
+=item regex_padav
+
+Only when perl was compiled with ithreads.
+
=item sv_undef
Returns the SV object corresponding to the C variable C<sv_undef>.
the description of C<walkoptree> above for what the debugging flag
does.
-=item walksymtable(SYMREF, METHOD, RECURSE)
+=item walksymtable(SYMREF, METHOD, RECURSE, PREFIX)
Walk the symbol table starting at SYMREF and call METHOD on each
-symbol visited. When the walk reached package symbols "Foo::" it
-invokes RECURSE and only recurses into the package if that sub
-returns true.
+symbol (a B::GV object) visited. When the walk reaches package
+symbols (such as "Foo::") it invokes RECURSE, passing in the symbol
+name, and only recurses into the package if that sub returns true.
+
+PREFIX is the name of the SYMREF you're walking.
+
+For example...
+
+ # Walk CGI's symbol table calling print_subs on each symbol.
+ # Only recurse into CGI::Util::
+ walksymtable(\%CGI::, 'print_subs', sub { $_[0] eq 'CGI::Util::' },
+ 'CGI::');
+
+print_subs() is a B::GV method you have declared.
+
=item svref_2object(SV)
Takes any Perl variable and turns it into an object in the
appropriate B::OP-derived or B::SV-derived class. Apart from functions
such as C<main_root>, this is the primary way to get an initial
-"handle" on a internal perl data structure which can then be followed
+"handle" on an internal perl data structure which can then be followed
with the other access methods.
=item ppname(OPNUM)
Returns a double-quote-surrounded escaped version of STR which can
be used as a string in C source code.
+=item perlstring(STR)
+
+Returns a double-quote-surrounded escaped version of STR which can
+be used as a string in Perl source code.
+
=item class(OBJ)
Returns the class of an object without the part of the classname
projects / p5sagit/p5-mst-13.2.git / blobdiff