view release on metacpan or  search on metacpan

lib/IO/TieCombine.pm  view on Meta::CPAN

use Symbol ();

#pod =head1 SYNOPSIS
#pod
#pod First, we set up a bunch of access points:
#pod
#pod   my $hub = IO::TieCombine->new;
#pod
#pod   my $str_ref  = $hub->scalar_ref('x');
#pod   my $fh       = $hub->fh('x');
#pod   my $callback = $hub->callback('x');
#pod
#pod   tie my $scalar, $hub, 'x';
#pod   tie local *STDOUT, $hub, 'x';
#pod
#pod   tie local *STDERR, $hub, 'err';
#pod
#pod Then we write to things:
#pod
#pod   $$str_ref .= 'And ';
#pod   print $fh "now ";
#pod   $callback->('for ');
#pod   $scalar .= 'something ';
#pod   print "completely ";
#pod   warn "different.\n";
#pod
#pod And then:
#pod
#pod   $hub->combined_contents;    # And now for something completely different.
#pod   $hub->slot_contents('x');   # And now for something completely
#pod   $hub->slot_contents('err'); # different.
#pod
#pod B<ACHTUNG!!>  Because of a serious problem with Perl 5.10.0, output sent to a
#pod tied filehandle using C<say> B<will not have the expected newline>.  5.10.1 or
#pod later is needed.  Since 5.10.0 is broken in so many other ways, you should
#pod really upgrade anyway.
#pod
#pod B<ACHTUNG!!>  Because of a different problem with Perls 5.10.1 - 5.16.3, if you
#pod send output to a tied filehandle using C<say>, and C<$\> is undefined (which is
#pod the default), B<< C<$\> will not be restored to C<undef> after the C<say> >>!
#pod This means that once you've used C<say> to print to I<any> tied filehandle, you
#pod have corrupted the global state of your program.  Either start your program by
#pod setting C<$\> to an empty string, which should be safe, or upgrade to 5.18.0.
#pod
#pod =cut

#pod =method new
#pod
#pod The constructor takes no arguments.
#pod
#pod =cut

sub new {
  my ($class) = @_;

  my $self = {
    combined => \(my $str = ''),
    slots    => { },
  };

  bless $self => $class;
}

#pod =method combined_contents
#pod
#pod This method returns the contents of all collected data.
#pod
#pod =cut

sub combined_contents {
  my ($self) = @_;
  return ${ $self->{combined} };
}

#pod =method slot_contents
#pod
#pod   my $str = $hub->slot_contents( $slot_name );
#pod
#pod This method returns the contents of all collected data for the named slot.
#pod
#pod =cut

sub slot_contents {
  my ($self, $name) = @_;
  Carp::confess("no name provided for slot_contents") unless defined $name;

  Carp::confess("no such output slot exists")
    unless exists $self->{slots}{$name};

  return ${ $self->{slots}{$name} };
}

sub _slot_ref {
  my ($self, $name) = @_;
  Carp::confess("no slot name provided") unless defined $name;

  $self->{slots}{$name} = \(my $str = '') unless $self->{slots}{$name};
  return $self->{slots}{$name};
}

sub _tie_args {
  my ($self, $name) = @_;
  return {
    slot_name    => $name,
    combined_ref => $self->{combined},
    output_ref   => $self->_slot_ref($name),
  };
}

#pod =method clear_slot
#pod
#pod   $hub->clear_slot( $slot_name );
#pod
#pod This sets the slot back to an empty string.
#pod
#pod =cut

sub clear_slot {
  my ($self, $slot_name) = @_;
  ${ $self->_slot_ref($slot_name) } = '';
  return;