Acme-Throw

 view release on metacpan or  search on metacpan

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

our $MSG;

sub import {
  my ($class, %args) = @_;

  $MSG = $args{-msg} || "WHY WON'T THIS CODE WORK??!?";
  my $orig_handler = $SIG{__DIE__};

  $SIG{__DIE__} = sub {
    binmode(STDERR, ":utf8");
    print STDERR "(╯°□°）╯︵ ┻━┻  $MSG\n";
    $SIG{__DIE__} = $orig_handler;
    die @_;
  };
}

sub _msg { $MSG }

1 && q{ THIS IS MY RAGE FACE }; # truth
__END__

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

#--------------------------------------------------------------------------#
# 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;
  no strict 'refs'; ## no critic
  return *{$glob}{NAME};
}

sub _open {
  open $_[0], $_[1] or Carp::confess "Error from open(" . join(q{, }, @_) . "): $!";

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

    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" );

t/lib/IO/String.pm  view on Meta::CPAN

    undef *$self if $] eq "5.008";  # workaround for some bug
    return 1;
}

sub opened
{
    my $self = shift;
    return defined *$self->{buf};
}

sub binmode
{
    my $self = shift;
    return 1 unless @_;
    # XXX don't know much about layers yet :-(
    return 0;
}

sub getc
{
    my $self = shift;

t/lib/IO/String.pm  view on Meta::CPAN

*GETC   = \&getc;
*PRINT  = \&print;
*PRINTF = \&printf;
*READ   = \&read;
*WRITE  = \&write;
*SEEK   = \&seek;
*TELL   = \&getpos;
*EOF    = \&eof;
*CLOSE  = \&close;
*BINMODE = \&binmode;


sub string_ref
{
    my $self = shift;
    return *$self->{buf};
}
*sref = \&string_ref;

1;

t/lib/IO/String.pm  view on Meta::CPAN

methods in that seek() extends the string (with the specified
padding) if you go to a location past the end, whereas setpos()
just snaps back to the end.  If truncate() is used to extend the string,
then it works as seek().

=back

=head1 BUGS

In Perl versions < 5.6, the TIEHANDLE interface was incomplete.
If you use such a Perl, then seek(), tell(), eof(), fileno(), binmode() will
not do anything on an C<IO::String> handle.  See L<perltie> for
details.

=head1 SEE ALSO

L<IO::File>, L<IO::Stringy>, L<perlfunc/open>

=head1 COPYRIGHT

Copyright 1998-2005 Gisle Aas.

t/simple.t  view on Meta::CPAN

use utf8;

use Test::More;

use IO::Handle;
use FindBin qw/ $Bin /;
use lib "$Bin/lib";
use Capture::Tiny qw/ capture_stderr /; # bundled under t/lib

# make sure all test output supports utf
binmode( \$_, ":utf8" ) for *STDERR, *STDOUT;
$_->autoflush(1) for *STDERR, *STDOUT;

our $CLASS = "Acme::Throw";
use_ok $CLASS;
$CLASS->import;

# throw and catch an exception
my $die_msg = "your mom";
my ($got_val, $got_err);
my $stderr = capture_stderr {