IO-TieCombine
view release on metacpan - search on metacpan
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;
view all matches for this distributionview release on metacpan - search on metacpan
( run in 0.821 second using v1.00-cache-2.02-grep-82fe00e-cpan-1925d2aa809 )