initial import

lib/IO/TieCombine.pm

@@ -0,0 +1,78 @@
+use strict;
+use warnings;
+package IO::TieCombine;
+
+use Carp ();
+use IO::TieCombine::Handle;
+use IO::TieCombine::Scalar;
+use Symbol ();
+
+sub new {
+  my ($class) = @_;
+
+  my $self = {
+    combined => \(my $str = ''),
+    slots    => { },
+  };
+
+  bless $self => $class;
+}
+
+sub combined_contents {
+  my ($self) = @_;
+  return ${ $self->{combined} };
+}
+
+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),
+  };
+}
+
+sub fh {
+  my ($self, $name) = @_;
+  my $sym = Symbol::gensym;
+  tie *$sym, 'IO::TieCombine::Handle', $self->_tie_args($name);
+  return $sym;
+}
+
+sub scalar_ref {
+  my ($self, $name) = @_;
+  tie my $tie, 'IO::TieCombine::Scalar', $self->_tie_args($name);
+  return \$tie;
+}
+
+sub callback {
+  my ($self, $name) = @_;
+  my $slot = $self->_slot_ref($name);
+  return sub {
+    warn ">>@_<<";
+    my ($value) = @_;
+
+    ${ $slot             } .= $value;
+    ${ $self->{combined} } .= $value;
+  }
+}
+
+1;

lib/IO/TieCombine/Handle.pm

@@ -0,0 +1,40 @@
+use strict;
+use warnings;
+package IO::TieCombine::Handle;
+
+use Carp ();
+
+sub TIEHANDLE {
+  my ($class, $arg) = @_;
+
+  my $self = {
+    slot_name    => $arg->{slot_name},
+    combined_ref => $arg->{combined_ref},
+    output_ref   => $arg->{output_ref},
+  };
+
+  return bless $self => $class;
+}
+
+sub PRINT {
+  my ($self, @output) = @_;
+
+  my $joined = join((defined $, ? $, : ''), @output);
+
+  ${ $self->{output_ref}   } .= $joined;
+  ${ $self->{combined_ref} } .= $joined;
+
+  return 1;
+}
+
+sub PRINTF {
+  my $self = shift;
+  my $fmt  = shift;
+  $self->PRINT(sprintf($fmt, @_));
+}
+
+sub OPEN     { return $_[0] }
+sub BINMODE  { return 1; }
+sub FILENO   { return 0 + $_[0] }
+
+1;

lib/IO/TieCombine/Scalar.pm

@@ -0,0 +1,39 @@
+use strict;
+use warnings;
+package IO::TieCombine::Scalar;
+
+use Carp ();
+
+sub TIESCALAR {
+  my ($class, $arg) = @_;
+
+  my $self = {
+    slot_name    => $arg->{slot_name},
+    combined_ref => $arg->{combined_ref},
+    output_ref   => $arg->{output_ref},
+  };
+
+  bless $self => $class;
+}
+
+sub FETCH {
+  return ${ $_[0]->{output_ref} }
+}
+
+sub STORE {
+  my ($self, $value) = @_;
+  my $class = ref $self;
+  my $output_ref = $self->{output_ref};
+
+  Carp::croak "you may only append, not reassign, a $class tie"
+    unless index($value, $$output_ref) == 0;
+
+  my $extra = substr $value, length $$output_ref, length $value;
+
+  printf "appending <%s> to <%s>\n", $extra, $self->{slot_name};
+
+  ${ $self->{combined_ref} } .= $extra;
+  return ${ $self->{output_ref} } = $value;
+}
+
+1;

t/basic.t

@@ -0,0 +1,41 @@
+#!perl
+use strict;
+use warnings;
+
+use IO::TieCombine;
+use Test::More 'no_plan';
+
+my $hub = IO::TieCombine->new;
+
+my $scalar_A = $hub->scalar_ref('Alpha');
+my $fh_A     = $hub->fh('Alpha');
+
+my $scalar_B = $hub->scalar_ref('Beta');
+my $fh_B     = $hub->fh('Beta');
+
+sub append_bar {
+  $_[0] .= 'bar';
+}
+
+$$scalar_A .= 'foo';
+print $fh_B "beta1";
+$$scalar_B .= 'embargo';
+append_bar($$scalar_A);
+
+eval { $$scalar_B = 'DIE!'; };
+like($@, qr{append, not reassign}, "you can't assign to a slot fh");
+
+print $fh_A "hot pants";
+$$scalar_B .= 'ooga';
+print $fh_B "beta2";
+
+use Data::Dumper;
+print Dumper($hub);
+
+is($hub->slot_contents('Alpha'), 'foobarhot pants', 'Alpha slot');
+is($hub->slot_contents('Beta'),  'beta1embargooogabeta2', 'Beta slot');
+is(
+  $hub->combined_contents,
+  'foobeta1embargobarhot pantsoogabeta2',
+  'combined',
+);