view release on metacpan or  search on metacpan

lib/Devel/Ditto.pm  view on Meta::CPAN

}

sub TIEHANDLE {
  my ( $class, %params ) = @_;
  bless \%params, $class;
}

sub _caller {
  my $self  = shift;
  my $depth = 0;
  while () {
    my ( $pkg, $file, $line ) = caller $depth;
    return unless defined $pkg;
    return ( $pkg, $file, $line )
     unless $pkg->isa( __PACKAGE__ );
    $depth++;
  }
}

sub _logbit {
  my $self = shift;
  my ( $pkg, $file, $line ) = $self->_caller();
  $file = File::Spec->canonpath($file);
  return "[$pkg, $file, $line] ";
}

sub PRINT {
  my $self = shift;
  $self->{realout}->( sub { print $self->_logbit, @_ }, @_ );
}

sub PRINTF {
  my $self = shift;
  $self->PRINT( sprintf $_[0], @_[ 1 .. $#_ ] );
}

sub WRITE {
  my $self = shift;
  $self->{realout}->(
    sub {
      my ( $buf, $len, $offset ) = @_;
      syswrite STDOUT, $buf, $len, defined $offset ? $offset : 0;
    },
    @_
  );
}

sub CLOSE {
  my $self = shift;
  if ( $self->{is_err} ) {
    close REALSTDERR;
  }
  else {
    close REALSTDOUT;
  }
}

1;
__END__

=head1 BUGS AND LIMITATIONS

No bugs have been reported.

Please report any bugs or feature requests to
C<bug-devel-Ditto@rt.cpan.org>, or through the web interface at
L<http://rt.cpan.org>.

=head1 AUTHOR

Andy Armstrong  C<< <andy@hexten.net> >>

=head1 LICENCE AND COPYRIGHT

Copyright (c) 2009, Andy Armstrong C<< <andy@hexten.net> >>.

This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlartistic>.