package TieInput;
use Data::Dumper;
use strict;
use warnings;
# TieInput subs {
my @In;
sub CLOSE {
my $self_O=shift;
my $fh=$In[$self_O->{fhno}];
close($fh);
}; # CLOSE:
sub DESTROY {
}; # DESTROY:
sub OPEN {
}; # OPEN:
sub READLINE {
my $self_O=shift;
my $fh=$In[$self_O->{fhno}];
if (wantarray()) {
my @_a=<$fh>;
warn __PACKAGE__,": ",Data::Dumper->Dump([\@_a],[qw(*_a)]);
return @_a;
} else {
my $_s=<$fh>;
warn __PACKAGE__,": ",Data::Dumper->Dump([\$_s],[qw(*_s)]);
return $_s;
};
}; # READLINE:
sub TIEHANDLE {
my $Class_C=shift;
# Point $fh to the real thingie ...
open(my $In,"<&",$_[0]);
push(@In,$In);
return bless { fhno=>$#In };
}; # TIEHANDLE:
sub UNTIE { #say __PACKAGE__."::UNTIE<>\n";
my ($self_O,$count_S)=@_;
return;
}; # UNTIE:
# }; # Internal (tie) Subs:
BEGIN { # Thanks to Eliya
# Currently not checking to insure the file will be opened readonly
*CORE::GLOBAL::open=sub (*;$@) {
#use Symbol();
#my $handle=Symbol::qualify_to_ref($_[0], scalar caller);
#
#$_[0]=$handle
# unless defined $_[0]; # pass up to caller
my $handle;
if (@_ == 1) {
CORE::open $handle
or warn $! and return 0;
}
elsif (@_ == 2) {
CORE::open $handle, $_[1]
or warn $! and return 0;
}
elsif (@_ == 3) {
if (defined $_[2]) {
CORE::open $handle, $_[1], $_[2]
or warn $! and return 0;
}
else {
CORE::open $handle, $_[1], undef # special case
or warn $! and return 0;
};
}
else {
CORE::open $handle, $_[1], $_[2], @_[3..$#_]
or warn $! and return 0;
};
tie *$handle,"TieInput",*$handle;
}; # CORE::GLOBAL::open
};
__PACKAGE__
__END__
####
#!
use Data::Dumper;
use strict;
use warnings;
{ # open one input - works with TieInput
warn "opening in1.txt:\n";
open my $in1,"<","in1.txt" or die $!;
my $s=<$in1>;
warn Data::Dumper->Dump([\$s],[qw(*s)]).' ';
my @a=<$in1>;
warn Data::Dumper->Dump([\@a],[qw(*a)]).' ';
close $in1;
};
{ # open two inputs - fails with TieInput
warn "opening in1.txt and in2.txt:\n";
open my $in1,"<","in1.txt" or die $!;
open my $in2,"<","in2.txt" or die $!;
my $s=<$in1>;
warn Data::Dumper->Dump([\$s],[qw(*s)]).' ';
$s=<$in2>;
warn Data::Dumper->Dump([\$s],[qw(*s)]).' ';
my @a=<$in1>;
warn Data::Dumper->Dump([\@a],[qw(*a)]).' ';
@a=<$in2>;
warn Data::Dumper->Dump([\@a],[qw(*a)]).' ';
close $in1;
close $in2;
};
exit;
##
##
in1 A
in1 B
in1 C
##
##
in2 A
in2 B
in2 C