@@ -3,18 +3,12 @@ package B::Concise;
33# This program is free software; you can redistribute and/or modify it
44# under the same terms as Perl itself.
55
6- # Note: we need to keep track of how many use declarations/BEGIN
7- # blocks this module uses, so we can avoid printing them when user
8- # asks for the BEGIN blocks in her program. Update the comments and
9- # the count in concise_specials if you add or delete one. The
10- # -MO=Concise counts as use #1.
6+ use strict;
7+ use warnings;
118
12- use strict; # use #2
13- use warnings; # use #3
9+ use Exporter ' import' ;
1410
15- use Exporter ' import' ; # uses #4-6, since Exporter does use strict, no strict
16-
17- our $VERSION = " 1.008" ;
11+ our $VERSION = " 1.009" ;
1812our @EXPORT_OK = qw( set_style set_style_standard add_callback
1913 concise_subref concise_cv concise_main
2014 add_style walk_output compile reset_sequence ) ;
@@ -24,8 +18,6 @@ our %EXPORT_TAGS =
2418 cb => [qw( add_callback ) ],
2519 mech => [qw( concise_subref concise_cv concise_main ) ], );
2620
27- # uses #7-10, since B->import loads Exporter::Heavy which does use strict,
28- # no strict, no warnings.
2921use B qw( class ppname main_start main_root main_cv cstring svref_2object
3022 SVf_IOK SVf_NOK SVf_POK SVf_IVisUV SVf_FAKE OPf_KIDS OPf_SPECIAL
3123 OPf_STACKED
@@ -84,6 +76,7 @@ our @callbacks; # allow external management
8476
8577set_style_standard(" concise" );
8678
79+ my $begin_count ;
8780my $curcv ;
8881my $cop_seq_base ;
8982
@@ -114,7 +107,7 @@ sub add_callback {
114107
115108# output handle, used with all Concise-output printing
116109our $walkHandle ; # public for your convenience
117- BEGIN { $walkHandle = \*STDOUT } # use #11
110+ BEGIN { $walkHandle = \*STDOUT }
118111
119112sub walk_output { # updates $walkHandle
120113 my $handle = shift ;
@@ -180,7 +173,7 @@ sub concise_cv_obj {
180173 return ;
181174 }
182175 if (class($cv -> START) eq " NULL" ) {
183- no strict ' refs' ; # use #12
176+ no strict ' refs' ;
184177 if (ref $name eq ' CODE' ) {
185178 print $walkHandle " coderef $name has no START\n " ;
186179 }
@@ -229,8 +222,9 @@ sub concise_main {
229222sub concise_specials {
230223 my ($name , $order , @cv_s ) = @_ ;
231224 my $i = 1;
225+
232226 if ($name eq " BEGIN" ) {
233- splice (@cv_s , 0, 16 ); # skip 16 BEGIN blocks from this file
227+ splice (@cv_s , 0, $begin_count ); # skip our BEGIN blocks from this file
234228 } elsif ($name eq " CHECK" ) {
235229 pop @cv_s ; # skip the CHECK block that calls us
236230 }
@@ -302,7 +296,7 @@ sub compileOpts {
302296 }
303297 elsif ($o =~ / ^-stash=(.*)/ ) {
304298 my $pkg = $1 ;
305- no strict ' refs' ; # use #13
299+ no strict ' refs' ;
306300 if (! %{$pkg .' ::' }) {
307301 eval " require $pkg " ;
308302 } else {
@@ -367,7 +361,7 @@ sub compile {
367361 next ;
368362 } else {
369363 $objname = " main::" . $objname unless $objname =~ / ::/ ;
370- no strict ' refs' ; # use #14
364+ no strict ' refs' ;
371365 my $glob = \*$objname ;
372366 unless (*$glob {CODE } || *$glob {FORMAT }) {
373367 print $walkHandle " $objname :\n " if $banner ;
@@ -387,7 +381,7 @@ sub compile {
387381 }
388382 }
389383 for my $pkg (@render_packs ) {
390- no strict ' refs' ; # use #15
384+ no strict ' refs' ;
391385 concise_stashref($order , \%{$pkg .' ::' });
392386 }
393387
@@ -407,7 +401,7 @@ my %opclass = ('OP' => "0", 'UNOP' => "1", 'BINOP' => "2", 'LOGOP' => "|",
407401 ' PVOP' => ' "' , ' LOOP' => " {" , ' COP' => " ;" , ' PADOP' => " #" ,
408402 ' METHOP' => ' .' , UNOP_AUX => ' +' );
409403
410- no warnings ' qw' ; # "Possible attempt to put comments..."; use #16
404+ no warnings ' qw' ; # "Possible attempt to put comments..."
411405my @linenoise =
412406 qw' # () sc ( @? 1 $* gv *{ m$ m@ m% m? p/ *$ $ $# & a& pt \\ s\\ rf bl
413407 ` *? <> ?? ?/ r/ c/ // qr s/ /c y/ = @= C sC Cp sp df un BM po +1 +I
@@ -1088,6 +1082,10 @@ sub tree {
10881082 map (" " x (length ($name )+$size ) . $_ , @lines ));
10891083}
10901084
1085+ # Count how many BEGIN blocks have been used to avoid printing them when a
1086+ # user asks for the BEGIN blocks in their program. Must be our last BEGIN.
1087+ BEGIN { $begin_count =()= B::begin_av-> isa(' B::AV' ) ? B::begin_av-> ARRAY : () }
1088+
10911089# *** Warning: fragile kludge ahead ***
10921090# Because the B::* modules run in the same interpreter as the code
10931091# they're compiling, their presence tends to distort the view we have of
0 commit comments