File Coverage

blib/lib/Safe/World/stdoutsimple.pm

Criterion	Covered	Total	%
statement	12	62	19.3
branch	0	14	0.0
condition			n/a
subroutine	4	26	15.3
pod	0	10	0.0
total	16	112	14.2

#############################################################################
## Name:        stdoutsimple.pm
## Purpose:     Safe::World::stdoutsimple
## Author:      Graciliano M. P.
## Modified by:
## Created:     08/09/2003
## RCS-ID:
## Copyright:   (c) 2003 Graciliano M. P.
## Licence:     This program is free software; you can redistribute it and/or
##              modify it under the same terms as Perl itself
#############################################################################

package Safe::World::stdoutsimple ;

use strict qw(vars);

use vars qw($VERSION @ISA) ;
$VERSION = '0.02' ;

no warnings ;

##########
# SCOPES #
##########

  use vars qw($Safe_World_NOW) ;

  *Safe_World_NOW = \$Safe::World::NOW ;

#########
# DUMMY #
#########

sub headers {}
sub stdout_data {}
sub buffer_data {}

sub flush {}

#########
# BLOCK #
#########

sub block {
  my $this = shift ;
  $this->{BLOCKED} = 1 ;
}

###########
# UNBLOCK #
###########

sub unblock {
  my $this = shift ;
  $this->{BLOCKED} = undef ;
}

#########
# PRINT #
#########

sub print { &PRINT ;}

################
# PRINT_STDOUT #
################

sub print_stdout {
  my $this = shift ;
  my $stdout = $this->{STDOUT} ;

  return if $this->{BLOCKED} ;

  if ( ref($stdout) eq 'SCALAR' ) { $$stdout .= $_[0] ;}
  elsif ( ref($stdout) eq 'CODE' ) {
    my $sel = $Safe_World_NOW->{SELECT}{PREVSTDOUT} ? &Safe::World::SELECT( $Safe_World_NOW->{SELECT}{PREVSTDOUT} ) : undef ;
    &$stdout($Safe_World_NOW , $_[0]) ;
    &Safe::World::SELECT($sel) if $sel ;
  }
  else { print $stdout $_[0] ;}

  return 1 ;
}

#################
# PRINT_HEADOUT #
#################

sub print_headout {}

#################
# CLOSE_HEADERS #
#################

sub close_headers {
  my $this = shift ;
  $this->{HEADER_CLOSED} = 1 ;
  return 1 ;
}

#############
# TIEHANDLE #
#############

sub TIEHANDLE {
  my $class = shift ;
  my ($root , $stdout) = @_ ;

  my $this = {
  ROOT => $root ,
  STDOUT => $stdout ,
  } ;

  bless($this , $class) ;
  return( $this ) ;
}

sub PRINT {
  my $this = shift ;

  if ( $this->{REDIRECT} ) {
    ${$this->{REDIRECT}} .= join("", (@_[0..$#_])) ;
  }
  else {
    $this->print_stdout( join("", (@_[0..$#_])) ) ;
  }

  return 1 ;
}

sub PRINTF { &PRINT($_[0],sprintf($_[1],@_[2..$#_])) ;}

sub READ {}
sub READLINE {}
sub GETC {}
sub WRITE {}

sub FILENO {}

sub CLOSE {}

sub STORE {
  my $this = shift ;
  my $stdout = shift ;
  if ( !ref($stdout) ) {
    $stdout =~ s/^\*// ;
    $stdout = \*{$stdout} ;
  }
  $this->{STDOUT} = $stdout ;
}

sub FETCH {}

sub DESTROY {}

#######
# END #
#######

1;