X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FB%2FB.pm;h=feca2e59d6ee101811888905f1ceee0135eb3d66;hb=8ad6cd6e30dd4147303864a0fc6d2311046cabef;hp=a33ff2b79d40106a5a68ad62b9ec882b11b19c17;hpb=7a9b44b9a8839e34e1280d3da2fff4df45384659;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/B/B.pm b/ext/B/B.pm index a33ff2b..feca2e5 100644 --- a/ext/B/B.pm +++ b/ext/B/B.pm @@ -6,6 +6,9 @@ # License or the Artistic License, as specified in the README file. # package B; + +our $VERSION = '1.01'; + use XSLoader (); require Exporter; @ISA = qw(Exporter); @@ -15,10 +18,10 @@ require 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; @@ -80,6 +83,10 @@ sub B::IV::int_value { 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 = (); @@ -119,6 +126,11 @@ sub walkoptree_slow { } 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 { @@ -204,18 +216,18 @@ sub walksymtable { 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 "::" && &$recurse($sym)) { - walksymtable(\%glob, $method, $recurse, $sym); + walksymtable(\%$fullname, $method, $recurse, $sym); } } else { - svref_2object(\*glob)->EGV->$method(); + svref_2object(\*$fullname)->$method(); } } } @@ -404,6 +416,11 @@ string using the length and offset information in the struct: 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 @@ -433,6 +450,10 @@ are always stored with a null terminator, and the length field =item MOREMAGIC +=item precomp + +Only valid on r-magic, returns the string that generated the regexp. + =item PRIVATE =item TYPE @@ -441,8 +462,15 @@ are always stored with a null terminator, and the length field =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 @@ -558,6 +586,13 @@ If you're working with globs at runtime, and need to disambiguate =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 @@ -600,6 +635,8 @@ If you're working with globs at runtime, and need to disambiguate =item XSUBANY +For constant subroutines, returns the constant SV returned by the subroutine. + =item CvFLAGS =item const_sv @@ -716,10 +753,16 @@ This returns the op description from the global C PL_op_desc array =item pmflags +=item pmdynflags + =item pmpermflags =item precomp +=item pmoffet + +Only when perl was compiled with ithreads. + =back =head2 B::SVOP METHOD @@ -795,6 +838,14 @@ program. 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 @@ -808,6 +859,10 @@ Returns the starting op of the main part of the Perl program. 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. @@ -839,19 +894,31 @@ DEBUG argument is non-zero, it sets the debugging flag to that. See the description of C 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, 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) @@ -879,6 +946,11 @@ is only useful in a BEGIN block or else the flag is set too late. 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