view release on metacpan or  search on metacpan

lib/Acme/PerlML.pm  view on Meta::CPAN

35
36
37
38
39
40
41
42
43
44
45
        return ${ $SAX->{Output} };
}
 
# Allow people to use Acme::PerlML () sanely
sub import {
        ## This code isn't Acme::Bleach evil yet as that would be teh hard to debug
        open 0 or die "Couldn't open $0: $!";
        (my $code = join "", <0>) =~ s/(.*)^\s*use\s+Acme::PerlML\s*;\n//sm;
 
        # Already converted
        if ( $code =~ /^<document>/m ) {

 view release on metacpan or  search on metacpan

lib/Acme/Phlegethoth.pm  view on Meta::CPAN

75
76
77
78
79
80
81
82
83
84
85
        print "goodbye, world!\n";
 
=head1 DESCRIPTION
 
Acme::Phlegethoth improves the readability of your Perl programs to
the Elder Gods.  This may accelerate a debugging session where you
feel compelled to invoke them.  After all, if you're outsourcing
development to Cthulhu, you'd better damn well be sure He can read
your code.
 
Acme::Phlegethoth translates your code to Aklo the first time your

 view release on metacpan or  search on metacpan

inc/MyCheckVersionIncremented.pm  view on Meta::CPAN

26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
sub _indexed_distversion_via_query
{
    my ($self, $module) = @_;
 
    my $url = 'http://cpanmetadb.plackperl.org/v1.0/package/' . $module;
    $self->log_debug([ 'fetching %s', $url ]);
    my $res = HTTP::Tiny->new->get($url);
    $self->log('could not query the index?'), return undef if not $res->{success};
 
    my $data = $res->{content};
 
    if (my $charset = HTTP::Headers->new(%{ $res->{headers} })->content_type_charset)
    {
        $data = Encode::decode($charset, $data, Encode::FB_CROAK);
    }
    $self->log_debug([ 'got response: %s', $data ]);
 
    my $payload = YAML::Tiny->read_string($data);
 
    $self->log('invalid payload returned?'), return undef unless $payload;
    $self->log_debug([ '%s not indexed', $module ]), return undef if not defined $payload->[0]{version};
    return CPAN::DistnameInfo->new($payload->[0]{distfile})->version;
}
 
1;

 view release on metacpan or  search on metacpan

lib/Acme/ppport.h  view on Meta::CPAN

1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
debop||5.005000|
debprofdump||5.005000|
debprof|||
debstackptrs||5.007003|
debstack||5.007003|
debug_start_match|||
deb||5.007003|v
defelem_target|||
del_sv|||
delete_eval_scope|||
delimcpy||5.004000|n

lib/Acme/ppport.h  view on Meta::CPAN

1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
get_context||5.006000|n
get_cvn_flags|5.009005||p
get_cvs|5.011000||p
get_cv|5.006000||p
get_db_sub|||
get_debug_opts|||
get_hash_seed|||
get_hv|5.006000||p
get_invlist_iter_addr|||n
get_invlist_offset_addr|||n
get_invlist_previous_index_addr|||n

lib/Acme/ppport.h  view on Meta::CPAN

1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
incpush|||
ingroup|||
init_argv_symbols|||
init_constants|||
init_dbargs|||
init_debugger|||
init_global_struct|||
init_i18nl10n||5.006000|
init_i18nl14n||5.006000|
init_ids|||
init_interp|||

lib/Acme/ppport.h  view on Meta::CPAN

1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
magic_dump||5.006000|
magic_existspack|||
magic_freearylen_p|||
magic_freeovrld|||
magic_getarylen|||
magic_getdebugvar|||
magic_getdefelem|||
magic_getnkeys|||
magic_getpack|||
magic_getpos|||
magic_getsig|||

lib/Acme/ppport.h  view on Meta::CPAN

1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
magic_scalarpack|||
magic_set_all_env|||
magic_setarylen|||
magic_setcollxfrm|||
magic_setdbline|||
magic_setdebugvar|||
magic_setdefelem|||
magic_setenv|||
magic_sethint|||
magic_setisa|||
magic_setlvref|||

lib/Acme/ppport.h  view on Meta::CPAN

2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
rsignal_save|||
rsignal_state||5.004000|
rsignal||5.004000|
run_body|||
run_user_filter|||
runops_debug||5.005000|
runops_standard||5.005000|
rv2cv_op_cv||5.013006|
rvpv_dup|||
rxres_free|||
rxres_restore|||

lib/Acme/ppport.h  view on Meta::CPAN

2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
unreferenced_to_tmp_stack|||
unshare_hek_or_pvn|||
unshare_hek|||
unsharepvn||5.003070|
unwind_handler_stack|||
update_debugger_info|||
upg_version||5.009005|
usage|||
utf16_textfilter|||
utf16_to_utf8_reversed||5.006001|
utf16_to_utf8||5.006001|

 view release on metacpan or  search on metacpan

lib/Acme/Pythonic.pm  view on Meta::CPAN

12
13
14
15
16
17
18
19
20
21
22
 
use Text::Tabs;
 
sub import {
    my ($package, %cfg) = @_;
    $DEBUG = $cfg{debug};
    $CALLER = caller() # to be able to check sub prototypes
}
 
 
use Filter::Simple;

lib/Acme/Pythonic.pm  view on Meta::CPAN

529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
L<Filter::ExtractSource> can be used to inspect the source code
generated by Acme::Pythonic:
 
    perl -c -MFilter::ExtractSource pythonic_script.pl
 
Acme::Pythonic itself has a C<debug> flag though:
 
    use Acme::Pythonic debug => 1;
 
In debug mode the module prints to standard output the code it has
generated, and passes just a dummy C<1;> to L<Filter::Simple>.
 
This happens I<before> L<Filter::Simple> undoes the blanking out of
PODs, strings, and regexps. Those parts are marked with the label
C<BLANKED_OUT> for easy identification.

 view release on metacpan or  search on metacpan

RTB/RTB.pm  view on Meta::CPAN

92
93
94
95
96
97
98
99
100
101
 
Current colour of the robot, change it if you find it ugly.
 
=head3 GameOption [optionnr (int)] [value (double)]
 
At the beginning of each game the robots will be sent a number of settings, which can be useful for the robot. For a complete list of these, look in the file Messagetypes.h for the game_option_type enum. In the options chapter you can get more detail...
 
=head3 GameStarts
 
This message is sent when the game starts (surprise!)

RTB/RTB.pm  view on Meta::CPAN

253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
 
=head2 Debug [message (string)]
 
=back
 
Print message on the message window if in debug-mode.
 
 
=over 4
 
=head2 DebugLine [angle1 (double)] [radius1 (double)] [angle2 (double)] [radius2 (double)]
 
=back
 
Draw a line direct to the arena. This is only allowed in the highest debug level(5), otherwise a warning message is sent. The arguments are the start and end point of the line given in polar coordinates relative to the robot.
 
 
=over 4
 
=head2 DebugCircle [center angle (double)] [center radius (double)] [circle radius (double)]

 view release on metacpan or  search on metacpan

t/pms/RayApp.pm  view on Meta::CPAN

392
393
394
395
396
397
398
399
400
401
402
B<handler> methods from different applications do not clash. In
app.xsl, there should be an XSLT stylesheet.
 
If you issue a request for /sub/app.xml, the presentation
postprocessing is skipped and you get the XML output -- ideal for
debugging.
 
If the app.html file exists in the filesystem, it "overrides" any
attempts to is generate dynamic content, and the file is returned.
Likewise, if there is a app.xml file in the filesystem and there is
a request for app.xml, the XML file is returned. If there is app.xml

 view release on metacpan or  search on metacpan

lib/Acme/RightSideOutObject.pm  view on Meta::CPAN

20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
 
sub import {
    *{caller().'::guts'} = sub {
        my $their_self = shift;
        my $weaken = grep $_ eq 'weaken', @_;
        my $debug = grep $_ eq 'debug', @_;
        my $id = Class::InsideOut::id($their_self) or die;
        my $class = ref $their_self;
        my %as_a_hash;
        my $self = bless \%as_a_hash, $class;
        my $our_id = Class::InsideOut::id($self) or die; # sooo bad
        for my $sym (keys %{$class.'::'}) {
            $debug and warn "$class\::$sym\n";
            my $code = *{$class.'::'.$sym}{CODE} or next;
            my $op = B::svref_2object($code) or next;
            my $rootop = $op->ROOT or next;
            $$rootop or next; # not XS
            $op->STASH->NAME eq $class or next; # not imported
            my $vars = PadWalker::peek_sub($code) or next; # don't know why this would fail but when it does, I think it dies
            for my $var (keys %$vars) {
                next unless $var =~ m/^\%/;
                next unless exists $vars->{$var};
                next unless exists $vars->{$var}->{$id};
                $debug and warn "  ... $var is $vars->{$var}->{$id}\n";
                (my $var_without_sigil) = $var =~ m/^.(.*)/;
                alias $as_a_hash{$var_without_sigil} = $vars->{$var}->{$id};
                alias $vars->{$var}->{$our_id} = $vars->{$var}->{$id}; # so $self->func works as well as $their_self->func
                if($weaken) {
                    Scalar::Util::weaken($as_a_hash{$var_without_sigil});

lib/Acme/RightSideOutObject.pm  view on Meta::CPAN

101
102
103
104
105
106
107
108
109
110
 
  use Acme::RightSideOutObject 'weaken';
 
Attempt not to leak so much memory. 
 
  use Acme::RightSideOutObject 'debug';
 
Print information to STDERR about instance data found while righting objects.
 
=head2 EXPORT

 view release on metacpan or  search on metacpan

MANIFEST.SKIP  view on Meta::CPAN

17
18
19
20
21
22
23
24
25
26
27
^Makefile$
.metadata/
.idea/
pm_to_blib$
.git/
.debug$
.gitignore$
^\w+.pl$
.ignore.txt$
.travis.yml$
.iml$

 view release on metacpan or  search on metacpan

inc/Spiffy.pm  view on Meta::CPAN

50
51
52
53
54
55
56
57
58
59
60
no warnings;
my $self_package = shift;
 
# XXX Using parse_arguments here might cause confusion, because the
# subclass's boolean_arguments and paired_arguments can conflict, causing
# difficult debugging. Consider using something truly local.
my ($args, @export_list) = do {
    local *boolean_arguments = sub { 
        qw(
            -base -Base -mixin -selfless 
            -XXX -dumper -yaml 

 view release on metacpan or  search on metacpan

local/lib/perl5/Future.pm  view on Meta::CPAN

145
146
147
148
149
150
151
152
153
154
155
futures might be integrated with various event systems.
 
=head2 DEBUGGING
 
By the time a C<Future> object is destroyed, it ought to have been completed
or cancelled. By enabling debug tracing of objects, this fact can be checked.
If a future object is destroyed without having been completed or cancelled, a
warning message is printed.
 
 $ PERL_FUTURE_DEBUG=1 perl -MFuture -E 'my $f = Future->new'
 Future=HASH(0xaa61f8) was constructed at -e line 1 and was lost near -e line 0 before it was ready.

local/lib/perl5/Future.pm  view on Meta::CPAN

169
170
171
172
173
174
175
176
177
178
179
 print "Finished\n";
 
 Future=HASH(0x14a2220) was constructed at - line 2 and was lost near - line 6 before it was ready.
 Finished
 
A warning is also printed in debug mode if a C<Future> object is destroyed
that completed with a failure, but the object believes that failure has not
been reported anywhere.
 
 $ PERL_FUTURE_DEBUG=1 perl -Mblib -MFuture -E 'my $f = Future->fail("Oops")'
 Future=HASH(0xac98f8) was constructed at -e line 1 and was lost near -e line 0 with an unreported failure of: Oops

local/lib/perl5/Future.pm  view on Meta::CPAN

266
267
268
269
270
271
272
273
274
275
276
}
 
my $GLOBAL_END;
END { $GLOBAL_END = 1; }
 
sub DESTROY_debug {
   my $self = shift;
   return if $GLOBAL_END;
   return if $self->{ready} and ( $self->{reported} or !$self->{failure} );
 
   my $lost_at = join " line ", (caller)[1,2];

local/lib/perl5/Future.pm  view on Meta::CPAN

285
286
287
288
289
290
291
292
293
294
   }
   elsif( !$self->{ready} ) {
      warn "${\$self->__selfstr} was $self->{constructed_at} and was lost near $lost_at before it was ready.\n";
   }
}
*DESTROY = \&DESTROY_debug if DEBUG;
 
=head2 done I<(class method)>
 
=head2 fail I<(class method)>

local/lib/perl5/Future.pm  view on Meta::CPAN

1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
 
I<Since version 0.28.>
 
Chaining mutator and accessor for the label of the C<Future>. This should be a
plain string value, whose value will be stored by the future instance for use
in debugging messages or other tooling, or similar purposes.
 
=cut
 
sub set_label
{

 view release on metacpan or  search on metacpan

lib/Acme/State.pm  view on Meta::CPAN

94
95
96
97
98
99
100
101
102
103
        }
    }
    return $node;
}->('main::');
 
# use Data::Dumper; print "debug: ", Data::Dumper::Dumper($tree), "\n";
 
local $Storable::Deparse = $wantcoderefs;
 
my $save_fn = save_file_name();

 view release on metacpan or  search on metacpan

lib/Acme/Sub/Parms.pod  view on Meta::CPAN

137
138
139
140
141
142
143
144
145
146
147
 
=item :dump_to_stdout
 
This signals that the code should be printed to STDOUT as the source
filter runs. This is useful primarily to see what the source filter
actually does, for debugging, or if you want to capture the transformed
code so it can be used B<without> needing Acme::Sub::Parms to be
installed at all.
 
This would typically be used by setting the flag on the
'use Acme::Sub::Parms', and then running 

 view release on metacpan or  search on metacpan

lib/Acme/Syntax/Python.pm  view on Meta::CPAN

17
18
19
20
21
22
23
24
25
26
27
        _last_begin => 0,
        _in_block => 0,
        _block_depth => 0,
        _lambda_block => {},
        _class_block => {},
        _debug => $params{debug}
    );
    filter_add(bless \%context, $class);
}
 
sub error {

lib/Acme/Syntax/Python.pm  view on Meta::CPAN

123
124
125
126
127
128
129
130
131
132
    if(/else:/) {
        s{:$}{\{}gmx;
        _start_block($self);
    }
 
    if($self->{_debug}) {
        print "$self->{line_no} $_";
    }
    return $status;
}

 view release on metacpan or  search on metacpan

lib/Acme/TLDR.pm  view on Meta::CPAN

29
30
31
32
33
34
35
36
37
38
39
        while (my ($long, $short) = each %{$shortened}) {
            s{\b\Q$short\E\b}{$long}gsx;
        }
    };
 
sub _debug {
    my ($fmt, @args) = @_;
    printf STDERR qq($fmt\n) => @args
        if exists $ENV{DEBUG};
    return;
}

lib/Acme/TLDR.pm  view on Meta::CPAN

41
42
43
44
45
46
47
48
49
50
51
sub _installed {
    my $cache = catfile(
        File::HomeDir->my_data,
        q(.Acme-TLDR-) . md5_hex(join ':' => sort @INC) . q(.cache)
    );
    _debug(q(ExtUtils::Installed cache: %s), $cache);
 
    my $updated = -M $cache;
 
    my $modules;
    if (

lib/Acme/TLDR.pm  view on Meta::CPAN

54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
        grep { -e and -M _ < $updated }
        map { catfile($_, q(perllocal.pod)) }
        @INC
    ) {
        ## no critic (ProhibitPackageVars)
        _debug(q(no cache found; generating));
        $modules = [
            uniq
                keys %{$Module::CoreList::version{$]}},
                ExtUtils::Installed->new->modules,
        ];
        store $modules => $cache
            unless exists $ENV{NOCACHE};
    } else {
        _debug(q(reading from cache));
        $modules = retrieve $cache;
    }
 
    return $modules;
}

lib/Acme/TLDR.pm  view on Meta::CPAN

85
86
87
88
89
90
91
92
93
94
95
96
97
        next if $short eq $long;
 
        unless (exists $collisions{$short}) {
            ++$collisions{$short};
            $modules{$long} = $short;
            _debug(q(%-64s => %s), $long, $short);
        } else {
            _debug(q(%-64s => *undef*), $long);
        }
    }
 
    return \%modules;
}

 view release on metacpan or  search on metacpan

t/testrules.yml  view on Meta::CPAN

1
2
3
4
5
6
7
8
---
seq:
  # extra tests temporarily here for debugging
  - seq:
    - t/a1.t
    - t/a2.t
 # rest of the tests
  - par: **

 view release on metacpan or  search on metacpan

lib/Acme/Takahashi/Method.pm  view on Meta::CPAN

65
66
67
68
69
70
71
72
73
74
75
#use Data::Dumper;
#print Dumper \%args;
my $columns = $arg{columns} || 80;
my $rows    = $arg{rows}    || 24;
my $show_slide = !$arg{noslideshow} || 1;
$arg{debug} and $DEBUG = 1;
my $nslides = make_slide($0, $columns, $rows);
clobber($0, $columns, $rows) unless $arg{noclobber};
show_slides($0, $nslides) if $show_slide;
do_slides($0) unless $arg{noexec};
exit;

 view release on metacpan or  search on metacpan

lib/Acme/Teddy.pm  view on Meta::CPAN

242
243
244
245
246
247
248
249
250
251
252
    # Your test here. 
 
Start a test script with a bare block in AT (or subclass it). Then define 
whatever behavior you like. After you switch into "your own" package, test 
for that behavior. You should be able to verify by eye that your expectations 
are correct; therefore, you can concentrate on debugging your testing module. 
 
Writing the bare block is just like writing a module, except that much of the 
dull work is done for you. 
 
Lexical declarations will "leak" across package boundaries if you leave off 

 view release on metacpan or  search on metacpan

lib/Acme/Test/Buffy.pm  view on Meta::CPAN

111
112
113
114
115
116
117
118
119
120
121
# We failed. We want to test Test::Builder to print something
# like:
#      Failed test at line <line number>
#    Expected 'Buffy' but got '<what we got>' instead
# that is to say we print failure first, _then_ the extra diag
# stuff that will help people debug the code better.
 
# print not okay with the right text ("not ok <number> - <text>")
$Tester->ok(0,$text);
 
# print diagnostics of *why* it failed.  Don't just print to

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

2
3
4
5
6
7
8
9
10
11
12
 
0.2      Fri Feb 21 2003
 
         - Updated 'cloudy' tests to test for 'overcast' -ness
 
         - Ack! Removed extraneous debugging information.
 
         - Updated POD.
 
0.1      Thu Feb 20 2003
         

 view release on metacpan or  search on metacpan

ppport.h  view on Meta::CPAN

1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
debop||5.005000|
debprofdump||5.005000|
debprof|||
debstackptrs||5.007003|
debstack||5.007003|
debug_start_match|||
deb||5.007003|v
defelem_target|||
del_sv|||
delete_eval_scope|||
delimcpy||5.004000|n

ppport.h  view on Meta::CPAN

1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
get_context||5.006000|n
get_cvn_flags|5.009005||p
get_cvs|5.011000||p
get_cv|5.006000||p
get_db_sub|||
get_debug_opts|||
get_hash_seed|||
get_hv|5.006000||p
get_invlist_iter_addr|||n
get_invlist_offset_addr|||n
get_invlist_previous_index_addr|||n

ppport.h  view on Meta::CPAN

1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
incpush|||
ingroup|||
init_argv_symbols|||
init_constants|||
init_dbargs|||
init_debugger|||
init_global_struct|||
init_i18nl10n||5.006000|
init_i18nl14n||5.006000|
init_ids|||
init_interp|||

ppport.h  view on Meta::CPAN

1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
magic_dump||5.006000|
magic_existspack|||
magic_freearylen_p|||
magic_freeovrld|||
magic_getarylen|||
magic_getdebugvar|||
magic_getdefelem|||
magic_getnkeys|||
magic_getpack|||
magic_getpos|||
magic_getsig|||

ppport.h  view on Meta::CPAN

1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
magic_scalarpack|||
magic_set_all_env|||
magic_setarylen|||
magic_setcollxfrm|||
magic_setdbline|||
magic_setdebugvar|||
magic_setdefelem|||
magic_setenv|||
magic_sethint|||
magic_setisa|||
magic_setlvref|||

ppport.h  view on Meta::CPAN

2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
rsignal_save|||
rsignal_state||5.004000|
rsignal||5.004000|
run_body|||
run_user_filter|||
runops_debug||5.005000|
runops_standard||5.005000|
rv2cv_op_cv||5.013006|
rvpv_dup|||
rxres_free|||
rxres_restore|||

ppport.h  view on Meta::CPAN

2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
unreferenced_to_tmp_stack|||
unshare_hek_or_pvn|||
unshare_hek|||
unsharepvn||5.003070|
unwind_handler_stack|||
update_debugger_info|||
upg_version||5.009005|
usage|||
utf16_textfilter|||
utf16_to_utf8_reversed||5.006001|
utf16_to_utf8||5.006001|

 view release on metacpan or  search on metacpan

lib/Acme/Tests/Perl.pm  view on Meta::CPAN

8
9
10
11
12
13
14
15
16
17
18
  (2) jhi
  (3) jhj
  (4) jhk
Ans: 2
----
Which debugger does lwall use ?
  (1) perl -d
  (2) gdb
  (3) American Heritage Dictionary
  (4) printf
Ans: 4

 view release on metacpan or  search on metacpan

t/lib/Capture/Tiny.pm  view on Meta::CPAN

51
52
53
54
55
56
57
58
59
60
61
##our $DEBUG = $ENV{PERL_CAPTURE_TINY_DEBUG};
##
##my $DEBUGFH;
##open $DEBUGFH, "> DEBUG" if $DEBUG;
##
##*_debug = $DEBUG ? sub(@) { print {$DEBUGFH} @_ } : sub(){0};
 
our $TIMEOUT = 30;
 
#--------------------------------------------------------------------------#
# command to tee output -- the argument is a filename that must

t/lib/Capture/Tiny.pm  view on Meta::CPAN

73
74
75
76
77
78
79
80
81
82
83
84
85
86
# filehandle manipulation
#--------------------------------------------------------------------------#
 
sub _relayer {
  my ($fh, $layers) = @_;
  # _debug("# requested layers (@{$layers}) for @{[fileno $fh]}\n");
  my %seen = ( unix => 1, perlio => 1 ); # filter these out
  my @unique = grep { !$seen{$_}++ } @$layers;
  # _debug("# applying unique layers (@unique) to @{[fileno $fh]}\n");
  binmode($fh, join(":", ":raw", @unique));
}
 
sub _name {
  my $glob = shift;

t/lib/Capture/Tiny.pm  view on Meta::CPAN

88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
  return *{$glob}{NAME};
}
 
sub _open {
  open $_[0], $_[1] or Carp::confess "Error from open(" . join(q{, }, @_) . "): $!";
  # _debug( "# open " . join( ", " , map { defined $_ ? _name($_) : 'undef' } @_ ) . " as " . fileno( $_[0] ) . "\n" );
}
 
sub _close {
  # _debug( "# closing " . ( defined $_[0] ? _name($_[0]) : 'undef' )  . " on " . fileno( $_[0] ) . "\n" );
  close $_[0] or Carp::confess "Error from close(" . join(q{, }, @_) . "): $!";
}
 
my %dup; # cache this so STDIN stays fd0
my %proxy_count;

t/lib/Capture/Tiny.pm  view on Meta::CPAN

104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
  my %proxies;
  if ( ! defined fileno STDIN ) {
    $proxy_count{stdin}++;
    if (defined $dup{stdin}) {
      _open \*STDIN, "<&=" . fileno($dup{stdin});
      # _debug( "# restored proxy STDIN as " . (defined fileno STDIN ? fileno STDIN : 'undef' ) . "\n" );
    }
    else {
      _open \*STDIN, "<" . File::Spec->devnull;
      # _debug( "# proxied STDIN as " . (defined fileno STDIN ? fileno STDIN : 'undef' ) . "\n" );
      _open $dup{stdin} = IO::Handle->new, "<&=STDIN";
    }
    $proxies{stdin} = \*STDIN;
    binmode(STDIN, ':utf8') if $] >= 5.008; ## no critic
  }
  if ( ! defined fileno STDOUT ) {
    $proxy_count{stdout}++;
    if (defined $dup{stdout}) {
      _open \*STDOUT, ">&=" . fileno($dup{stdout});
      # _debug( "# restored proxy STDOUT as " . (defined fileno STDOUT ? fileno STDOUT : 'undef' ) . "\n" );
    }
    else {
      _open \*STDOUT, ">" . File::Spec->devnull;
       # _debug( "# proxied STDOUT as " . (defined fileno STDOUT ? fileno STDOUT : 'undef' ) . "\n" );
      _open $dup{stdout} = IO::Handle->new, ">&=STDOUT";
    }
    $proxies{stdout} = \*STDOUT;
    binmode(STDOUT, ':utf8') if $] >= 5.008; ## no critic
  }
  if ( ! defined fileno STDERR ) {
    $proxy_count{stderr}++;
    if (defined $dup{stderr}) {
      _open \*STDERR, ">&=" . fileno($dup{stderr});
       # _debug( "# restored proxy STDERR as " . (defined fileno STDERR ? fileno STDERR : 'undef' ) . "\n" );
    }
    else {
      _open \*STDERR, ">" . File::Spec->devnull;
       # _debug( "# proxied STDERR as " . (defined fileno STDERR ? fileno STDERR : 'undef' ) . "\n" );
      _open $dup{stderr} = IO::Handle->new, ">&=STDERR";
    }
    $proxies{stderr} = \*STDERR;
    binmode(STDERR, ':utf8') if $] >= 5.008; ## no critic
  }
  return %proxies;
}
 
sub _unproxy {
  my (%proxies) = @_;
  # _debug( "# unproxying: " . join(" ", keys %proxies) . "\n" );
  for my $p ( keys %proxies ) {
    $proxy_count{$p}--;
    # _debug( "# unproxied " . uc($p) . " ($proxy_count{$p} left)\n" );
    if ( ! $proxy_count{$p} ) {
      _close $proxies{$p};
      _close $dup{$p} unless $] < 5.008; # 5.6 will have already closed this as dup
      delete $dup{$p};
    }

t/lib/Capture/Tiny.pm  view on Meta::CPAN

187
188
189
190
191
192
193
194
195
196
197
sub _start_tee {
  my ($which, $stash) = @_; # $which is "stdout" or "stderr"
  # setup pipes
  $stash->{$_}{$which} = IO::Handle->new for qw/tee reader/;
  pipe $stash->{reader}{$which}, $stash->{tee}{$which};
  # _debug( "# pipe for $which\: " .  _name($stash->{tee}{$which}) . " " . fileno( $stash->{tee}{$which} ) . " => " . _name($stash->{reader}{$which}) . " " . fileno( $stash->{reader}{$which}) . "\n" );
  select((select($stash->{tee}{$which}), $|=1)[0]); # autoflush
  # setup desired redirection for parent and child
  $stash->{new}{$which} = $stash->{tee}{$which};
  $stash->{child}{$which} = {
    stdin   => $stash->{reader}{$which},

t/lib/Capture/Tiny.pm  view on Meta::CPAN

202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
$stash->{flag_files}{$which} = scalar tmpnam();
# execute @cmd as a separate process
if ( $IS_WIN32 ) {
  local $@;
  eval "use Win32API::File qw/CloseHandle GetOsFHandle SetHandleInformation fileLastError HANDLE_FLAG_INHERIT INVALID_HANDLE_VALUE/ ";
  # _debug( "# Win32API::File loaded\n") unless $@;
  my $os_fhandle = GetOsFHandle( $stash->{tee}{$which} );
  # _debug( "# Couldn't get OS handle: " . fileLastError() . "\n") if ! defined $os_fhandle || $os_fhandle == INVALID_HANDLE_VALUE();
  my $result = SetHandleInformation( $os_fhandle, HANDLE_FLAG_INHERIT(), 0);
  # _debug( $result ? "# set no-inherit flag on $which tee\n" : ("# can't disable tee handle flag inherit: " . fileLastError() . "\n"));
  _open_std( $stash->{child}{$which} );
  $stash->{pid}{$which} = system(1, @cmd, $stash->{flag_files}{$which});
  # not restoring std here as it all gets redirected again shortly anyway
}
else { # use fork

t/lib/Capture/Tiny.pm  view on Meta::CPAN

223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
  my $pid = fork;
  if ( not defined $pid ) {
    Carp::confess "Couldn't fork(): $!";
  }
  elsif ($pid == 0) { # child
    # _debug( "# in child process ...\n" );
    untie *STDIN; untie *STDOUT; untie *STDERR;
    _close $stash->{tee}{$which};
    # _debug( "# redirecting handles in child ...\n" );
    _open_std( $stash->{child}{$which} );
    # _debug( "# calling exec on command ...\n" );
    exec @cmd, $stash->{flag_files}{$which};
  }
  $stash->{pid}{$which} = $pid
}

t/lib/Capture/Tiny.pm  view on Meta::CPAN

255
256
257
258
259
260
261
262
263
264
265
266
267
}
 
sub _kill_tees {
  my ($stash) = @_;
  if ( $IS_WIN32 ) {
    # _debug( "# closing handles with CloseHandle\n");
    CloseHandle( GetOsFHandle($_) ) for values %{ $stash->{tee} };
    # _debug( "# waiting for subprocesses to finish\n");
    my $start = time;
    1 until wait == -1 || (time - $start > 30);
  }
  else {
    _close $_ for values %{ $stash->{tee} };

t/lib/Capture/Tiny.pm  view on Meta::CPAN

270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
}
 
sub _slurp {
  my ($name, $stash) = @_;
  my ($fh, $pos) = map { $stash->{$_}{$name} } qw/capture pos/;
  # _debug( "# slurping captured $name from " . fileno($fh) . " at pos $pos with layers: @{[PerlIO::get_layers($fh)]}\n");
  seek( $fh, $pos, 0 ) or die "Couldn't seek on capture handle for $name\n";
  my $text = do { local $/; scalar readline $fh };
  return defined($text) ? $text : "";
}
 
#--------------------------------------------------------------------------#
# _capture_tee() -- generic main sub for capturing or teeing
#--------------------------------------------------------------------------#
 
sub _capture_tee {
  # _debug( "# starting _capture_tee with (@_)...\n" );
  my ($do_stdout, $do_stderr, $do_merge, $do_tee, $code, @opts) = @_;
  my %do = ($do_stdout ? (stdout => 1) : (),  $do_stderr ? (stderr => 1) : ());
  Carp::confess("Custom capture options must be given as key/value pairs\n")
    unless @opts % 2 == 0;
  my $stash = { capture => { @opts } };

t/lib/Capture/Tiny.pm  view on Meta::CPAN

302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
my %layers = (
  stdin   => [PerlIO::get_layers(\*STDIN) ],
  stdout  => [PerlIO::get_layers(\*STDOUT, output => 1)],
  stderr  => [PerlIO::get_layers(\*STDERR, output => 1)],
);
# _debug( "# existing layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
# get layers from underlying glob of tied filehandles if we can
# (this only works for things that work like Tie::StdHandle)
$layers{stdout} = [PerlIO::get_layers(tied *STDOUT)]
  if tied(*STDOUT) && (reftype tied *STDOUT eq 'GLOB');
$layers{stderr} = [PerlIO::get_layers(tied *STDERR)]
  if tied(*STDERR) && (reftype tied *STDERR eq 'GLOB');
# _debug( "# tied object corrected layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
# bypass scalar filehandles and tied handles
# localize scalar STDIN to get a proxy to pick up FD0, then restore later to CT_ORIG_STDIN
my %localize;
$localize{stdin}++,  local(*STDIN)
  if grep { $_ eq 'scalar' } @{$layers{stdin}};

t/lib/Capture/Tiny.pm  view on Meta::CPAN

325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
  if tied *STDIN && $] >= 5.008;
$localize{stdout}++, local(*STDOUT), _open( \*STDOUT, ">&=1")
  if $do_stdout && tied *STDOUT && $] >= 5.008;
$localize{stderr}++, local(*STDERR), _open( \*STDERR, ">&=2")
  if ($do_stderr || $do_merge) && tied *STDERR && $] >= 5.008;
# _debug( "# localized $_\n" ) for keys %localize;
# proxy any closed/localized handles so we don't use fds 0, 1 or 2
my %proxy_std = _proxy_std();
# _debug( "# proxy std: @{ [%proxy_std] }\n" );
# update layers after any proxying
$layers{stdout} = [PerlIO::get_layers(\*STDOUT, output => 1)] if $proxy_std{stdout};
$layers{stderr} = [PerlIO::get_layers(\*STDERR, output => 1)] if $proxy_std{stderr};
# _debug( "# post-proxy layers for $_\: @{$layers{$_}}\n" ) for qw/stdin stdout stderr/;
# store old handles and setup handles for capture
$stash->{old} = _copy_std();
$stash->{new} = { %{$stash->{old}} }; # default to originals
for ( keys %do ) {
  $stash->{new}{$_} = ($stash->{capture}{$_} ||= File::Temp->new);
  seek( $stash->{capture}{$_}, 0, 2 ) or die "Could not seek on capture handle for $_\n";
  $stash->{pos}{$_} = tell $stash->{capture}{$_};
  # _debug("# will capture $_ on " . fileno($stash->{capture}{$_})."\n" );
  _start_tee( $_ => $stash ) if $do_tee; # tees may change $stash->{new}
}
_wait_for_tees( $stash ) if $do_tee;
# finalize redirection
$stash->{new}{stderr} = $stash->{new}{stdout} if $do_merge;
# _debug( "# redirecting in parent ...\n" );
_open_std( $stash->{new} );
# execute user provided code
my ($exit_code, $inner_error, $outer_error, @result);
{
  local *STDIN = *CT_ORIG_STDIN if $localize{stdin}; # get original, not proxy STDIN
  # _debug( "# finalizing layers ...\n" );
  _relayer(\*STDOUT, $layers{stdout}) if $do_stdout;
  _relayer(\*STDERR, $layers{stderr}) if $do_stderr;
  # _debug( "# running code $code ...\n" );
  local $@;
  eval { @result = $code->(); $inner_error = $@ };
  $exit_code = $?; # save this for later
  $outer_error = $@; # save this for later
}
# restore prior filehandles and shut down tees
# _debug( "# restoring filehandles ...\n" );
_open_std( $stash->{old} );
_close( $_ ) for values %{$stash->{old}}; # don't leak fds
# shouldn't need relayering originals, but see rt.perl.org #114404
_relayer(\*STDOUT, $layers{stdout}) if $do_stdout;
_relayer(\*STDERR, $layers{stderr}) if $do_stderr;
_unproxy( %proxy_std );
# _debug( "# killing tee subprocesses ...\n" ) if $do_tee;
_kill_tees( $stash ) if $do_tee;
# return captured output, but shortcut in void context
# unless we have to echo output to tied/scalar handles;
my %got;
if ( defined wantarray or ($do_tee && keys %localize) ) {
  for ( keys %do ) {
    _relayer($stash->{capture}{$_}, $layers{$_});
    $got{$_} = _slurp($_, $stash);
    # _debug("# slurped " . length($got{$_}) . " bytes from $_\n");
  }
  print CT_ORIG_STDOUT $got{stdout}
    if $do_stdout && $do_tee && $localize{stdout};
  print CT_ORIG_STDERR $got{stderr}
    if $do_stderr && $do_tee && $localize{stderr};
}
$? = $exit_code;
$@ = $inner_error if $inner_error;
die $outer_error if $outer_error;
# _debug( "# ending _capture_tee with (@_)...\n" );
return unless defined wantarray;
my @return;
push @return, $got{stdout} if $do_stdout;
push @return, $got{stderr} if $do_stderr && ! $do_merge;
push @return, @result;

 view release on metacpan or  search on metacpan

t/02_general.t  view on Meta::CPAN

457
458
459
460
461
462
463
464
465
# print 34.3 - 34.0;              # 0.299999999999997
 
#--fails sometimes, dunno why:
#http://www.cpantesters.org/cpan/report/fddd1d18-1b2c-11e7-9d0d-a625a53c07fe ( x 20, others also)
#my($inn,$n,$nn)=(0);
#my $nndebugstr=sub{++$inn;"nicenum$inn $n --> $Acme::Tools::Nicenum --> $nn"};
#$nn=nicenum( $n = 14.3 - 14.0 ); cmp_ok($nn,'==',0.3,   &$nndebugstr);
#$nn=nicenum( $n = 34.3 - 34.0 ); cmp_ok($nn,'==',0.3,   &$nndebugstr);
#$nn=nicenum( $n = 1e8+1 );       cmp_ok($nn,'==',1e8+1, &$nndebugstr);

 view release on metacpan or  search on metacpan

lib/Acme/Types/NonStandard.pm  view on Meta::CPAN

46
47
48
49
50
51
52
53
54
55
56
An attempt to provide totally useless types that L<Types::Standard> does not.
 
=head3 ConfusingDualVar
 
A dualvar (see L<Scalar::Util/dualvar>) whose stringy value must be a floating
point number or integer distinct from the numeric value (to maximize debugging
confusion).
 
=head3 FortyTwo
 
The number 42. Always.

 view release on metacpan or  search on metacpan

lib/Acme/URM.pm  view on Meta::CPAN

9
10
11
12
13
14
15
16
17
18
use constant    MAX_STEPS       => -3;
 
my $DEBUG   = 0;
sub import {
    foreach (@_) {
        if(/^debug$/) {
            $DEBUG  = 1;
        }
    }
}

lib/Acme/URM.pm  view on Meta::CPAN

73
74
75
76
77
78
79
80
81
82
83
        do {
                my $step        = $self->_step();
                return  $step   if MAX_STEPS == $step;
                $run            = (scalar(@{$self->{program}}) > $step) ? 1 : 0;
        } while( $run );
        _debug( "program executed",
                   "registers: " . Dumper([$self->{registers}]),
                   "",
                  );
        $self->register(0)
}

lib/Acme/URM.pm  view on Meta::CPAN

89
90
91
92
93
94
95
96
97
98
99
}
 
sub _step {
        my $self        = shift;
        my $cmd         = $self->{program}[ $self->{instr_num} ];
        _debug( "running instruction $self->{instr_num}: $cmd",
                   "registers: " . Dumper($self->{registers}),
                   "",
                  );
        my $instr_num_save      = $self->{instr_num};
        if( $cmd =~ /^\s*Z\s*\((.*)\)$/i ) {

lib/Acme/URM.pm  view on Meta::CPAN

134
135
136
137
138
139
140
141
142
143
144
        }
        $self->{steps_num}++;
        if( 0 < $self->{max_steps} && $self->{max_steps} < $self->{steps_num} ) {
                return  MAX_STEPS;
        }
        _debug( "after running instruction $instr_num_save: $cmd",
                   "registers: " . Dumper($self->{registers}),
                   "",
                  );
        $self->{instr_num}
}

lib/Acme/URM.pm  view on Meta::CPAN

148
149
150
151
152
153
154
155
156
157
        my $val         = shift;
        $self->{max_steps}   = $val  if defined $val;
        $self->{max_steps}
}
 
sub _debug {
        print join("\n",@_),"\n"        if $DEBUG;
}
 
1;

lib/Acme/URM.pm  view on Meta::CPAN

294
295
296
297
298
299
300
301
302
303
304
305
  $urm->register( 0, 2, 3 );
  $urm->run() == 3;
 
=head1 DEBUG MODE
 
You can use this module in debug mode, like this:
 
  use Acme::URM qw/debug/;
 
Which will produce some output while running the program.
 
=head1 USEFULNESS

 view release on metacpan or  search on metacpan

t/02cool.t  view on Meta::CPAN

4
5
6
7
8
9
use Acme::USIG;
use strict is cool;
 
eval q{ $foo = 1 };
 
ok ($@, "saved ourself some debugging");

 view release on metacpan or  search on metacpan

lib/Acme/YAPC/Okinawa/ppport.h  view on Meta::CPAN

1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
debop||5.005000|
debprofdump||5.005000|
debprof|||
debstackptrs||5.007003|
debstack||5.007003|
debug_start_match|||
deb||5.007003|v
defelem_target|||
del_sv|||
delete_eval_scope|||
delimcpy||5.004000|n

lib/Acme/YAPC/Okinawa/ppport.h  view on Meta::CPAN

1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
get_context||5.006000|n
get_cvn_flags|5.009005||p
get_cvs|5.011000||p
get_cv|5.006000||p
get_db_sub|||
get_debug_opts|||
get_hash_seed|||
get_hv|5.006000||p
get_invlist_iter_addr|||n
get_invlist_offset_addr|||n
get_invlist_previous_index_addr|||n

lib/Acme/YAPC/Okinawa/ppport.h  view on Meta::CPAN

1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
incpush|||
ingroup|||
init_argv_symbols|||
init_constants|||
init_dbargs|||
init_debugger|||
init_global_struct|||
init_i18nl10n||5.006000|
init_i18nl14n||5.006000|
init_ids|||
init_interp|||

lib/Acme/YAPC/Okinawa/ppport.h  view on Meta::CPAN

1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
magic_dump||5.006000|
magic_existspack|||
magic_freearylen_p|||
magic_freeovrld|||
magic_getarylen|||
magic_getdebugvar|||
magic_getdefelem|||
magic_getnkeys|||
magic_getpack|||
magic_getpos|||
magic_getsig|||

lib/Acme/YAPC/Okinawa/ppport.h  view on Meta::CPAN

1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
magic_scalarpack|||
magic_set_all_env|||
magic_setarylen|||
magic_setcollxfrm|||
magic_setdbline|||
magic_setdebugvar|||
magic_setdefelem|||
magic_setenv|||
magic_sethint|||
magic_setisa|||
magic_setlvref|||

lib/Acme/YAPC/Okinawa/ppport.h  view on Meta::CPAN

2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
rsignal_save|||
rsignal_state||5.004000|
rsignal||5.004000|
run_body|||
run_user_filter|||
runops_debug||5.005000|
runops_standard||5.005000|
rv2cv_op_cv||5.013006|
rvpv_dup|||
rxres_free|||
rxres_restore|||

lib/Acme/YAPC/Okinawa/ppport.h  view on Meta::CPAN

2781
2782
2783
2784
2785
2786
2787
2788
2789
2790
2791
unreferenced_to_tmp_stack|||
unshare_hek_or_pvn|||
unshare_hek|||
unsharepvn||5.003070|
unwind_handler_stack|||
update_debugger_info|||
upg_version||5.009005|
usage|||
utf16_textfilter|||
utf16_to_utf8_reversed||5.006001|
utf16_to_utf8||5.006001|

 view release on metacpan or  search on metacpan

landmine.pm  view on Meta::CPAN

54
55
56
57
58
59
60
61
62
63
64
  tie %hash, "Acme::landmine" => "first use of \%hash";
 
=head1 ABSTRACT
 
  variables that "explode", which useful for locating the first
  use of a variable after a checkpoint, while debugging.
 
=head1 DESCRIPTION
 
 a tie interface that C<confess>es.  This is useful
 for creating out-of-bounds markers when modeling data structures,

 view release on metacpan or  search on metacpan

lib/Acme/rafl/Everywhere.pm  view on Meta::CPAN

17
18
19
20
21
22
23
24
25
26
27
q{rafl is so everywhere, you can find Waldo simply by searching for anyone who isn't rafl!},
q{rafl is so everywhere, Jesus owes him a pull request on Github!},
q{rafl is so everywhere, he has the first commit of Javascript on Parrot!},
q{rafl is so everywhere, when you breathe, that's rafl you're breathing!},
q{rafl is so everywhere, he makes a cameo in the video from The Ring!},
q{rafl is so everywhere, he ar in yur Perl debuggr, pointing at yore crappy code!},
q{rafl is so everywhere, he is the default entry in your SSH authorized_keys file!},
q{rafl is so everywhere, he issued the first bug report for Perl, before it existed!},
q{rafl is so everywhere, he participated in the space olympics!},
q{rafl is so everywhere, he can visit all the YAPCs even if they are on the same day!},
q{rafl is so everywhere, every picture is actually photo-bombed by rafl!},