?????????? ????????? - ??????????????? - /home/agenciai/public_html/cd38d8/examples.tar
???????
uplevel-demo.pl 0000644 00000001032 15125143222 0007470 0 ustar 00 use strict; use warnings; use Sub::Uplevel; # subroutine A calls subroutine B with uplevel(), so when # subroutine B queries caller(), it gets main as the caller (just # like subroutine A) instead of getting subroutine A sub sub_a { print "Entering Subroutine A\n"; print "caller() says: ", join( ", ", (caller())[0 .. 2] ), "\n"; print "Calling B with uplevel\n"; uplevel 1, \&sub_b; } sub sub_b { print "Entering Subroutine B\n"; print "caller() says: ", join( ", ", (caller())[0 .. 2] ), "\n"; } sub_a(); tee.pl 0000644 00000000621 15125143343 0005656 0 ustar 00 use strict; use warnings; use Capture::Tiny qw/capture tee/; print "Type some text. Type 'exit' to quit\n"; my ($out, $err) = tee { while (<>) { last if /^exit$/; print "Echoing to STDOUT: $_"; print STDERR "Echoing to STDERR: $_"; } }; print "\nCaptured STDOUT was:\n" . ( defined $out ? $out : 'undef' ); print "\nCaptured STDERR was:\n" . ( defined $err ? $err : 'undef' ); rt-58208.pl 0000644 00000000556 15125143343 0006221 0 ustar 00 use Capture::Tiny qw[ capture ]; my ( $out, $err ) = eval { capture { print STDERR "hello\n"; print STDOUT "there\n"; die("foo\n" ) } }; print STDERR "STDERR:\nout=$out\nerr=$err\n\$@=$@"; print STDOUT "STDOUT:\nout=$out\nerr=$err\n\$@=$@"; open FILE, '>ttt.log' or die( "error opening logfile\n" ); print FILE "FILE:\nout=$out\nerr=$err\n\$@=$@\n"; close FILE; README 0000644 00000000105 15125143364 0005424 0 ustar 00 See the tests in the t/ directory for examples until I add some more. exception_like.t 0000644 00000000750 15125143422 0007734 0 ustar 00 use strict; use warnings FATAL => 'all'; use Test::More; use Test::Fatal; use Carp 'confess'; sub exception_like(&$;$) { my ($code, $pattern, $name) = @_; like( &exception($code), $pattern, $name ); } exception_like(sub { confess 'blah blah' }, qr/foo/, 'foo seems to appear in the exception'); # the test only passes when we invert it unlike( ( exception { confess 'blah blah' } || '' ), qr/foo/, 'foo does NOT ACTUALLY appear in the exception', ); done_testing; convert-to-test-fatal 0000755 00000005503 15125143422 0010636 0 ustar 00 #!/usr/bin/perl use strict; use warnings; use Path::Tiny; use PPI; rewrite_doc($_) for grep { -w } @ARGV; sub rewrite_doc { my $file = shift; my $doc = PPI::Document->new($file); return unless $doc =~ /Test::Exception/; print $file, "\n"; my $pattern = sub { my $elt = $_[1]; return 1 if $elt->isa('PPI::Statement') && $elt->content() =~ /^\s*(?:::)?(?:lives_|throws_|dies_)(?:ok|and)/; return 0; }; for my $elt ( @{ $doc->find($pattern) || [] } ) { transform_statement($elt); } my $content = $doc->content(); $content =~ s/Test::Exception/Test::Fatal/g; path( $file )->spew( $content ); } sub transform_statement { my $stmt = shift; my @children = $stmt->schildren; my $func = shift @children; my $colons = $func =~ /^::/ ? '::' : q{}; my $code; if ( $func =~ /lives_/ ) { $code = function( $colons . 'is', $children[0], 'undef', $children[1] ); } elsif ( $func =~ /dies_/ ) { $code = function( $colons . 'isnt', $children[0], 'undef', $children[1] ); } elsif ( $func =~ /throws_/ ) { # $children[2] is always a comma if it exists if ( $children[1]->isa('PPI::Token::QuoteLike::Regexp') ) { $code = function( $colons . 'like', $children[0], $children[1], $children[3] ); } else { $code = function( $colons . 'is', $children[0], $children[1], $children[3] ); } } $stmt->insert_before($code); $stmt->remove; } sub function { my $func = shift; my $exception = shift; my $expect = shift; my $desc = shift; my $exc_func = $func =~ /^::/ ? '::exception' : 'exception'; my @code; push @code, PPI::Token::Word->new($func), PPI::Token::Structure->new('('), PPI::Token::Whitespace->new(q{ }), PPI::Token::Word->new($exc_func), PPI::Token::Whitespace->new(q{ }), $exception->clone, PPI::Token::Operator->new(','), PPI::Token::Whitespace->new(q{ }), ( ref $expect ? $expect->clone : PPI::Token::Word->new($expect) ); if ( $desc && $desc->isa('PPI::Token::Quote') ) { push @code, PPI::Token::Operator->new(','), PPI::Token::Whitespace->new(q{ }), $desc->clone; } push @code, PPI::Token::Whitespace->new(q{ }), PPI::Token::Structure->new(')'), PPI::Token::Structure->new(';'); my $stmt = PPI::Statement->new; $stmt->add_element($_) for @code; return $stmt; }
| ver. 1.6 |
Github
|
.
| PHP 8.2.30 | ??????????? ?????????: 0 |
proxy
|
phpinfo
|
???????????