use
vars
qw($VERSION @ISA)
;
our
$VERSION
=
'0.01'
;
sub
new {
my
$proto
=
shift
;
my
$class
=
ref
(
$proto
) ||
$proto
;
my
$sref
=
shift
;
my
$self
=
bless
\
do
{
local
*FH
},
$class
;
tie
*$self
,
$class
,
$self
;
if
(!
defined
$sref
) {
my
$s
;
$sref
= \
$s
;}
*$self
->{Pos} = 0;
*$self
->{SR} =
$sref
;
$self
;
}
sub
print
{
my
$self
=
shift
;
*$self
->{Pos} =
length
(${
*$self
->{SR}} .=
join
(
''
,
@_
));
1;
}
sub
write
{
my
$self
=
$_
[0];
my
$n
=
$_
[2];
my
$off
=
$_
[3] || 0;
my
$data
=
substr
(
$_
[1],
$off
,
$n
);
$n
=
length
(
$data
);
$self
->
print
(
$data
);
return
$n
;
}
sub
eof
{
my
$self
=
shift
;
(
*$self
->{Pos} >=
length
(${
*$self
->{SR}}));
}
sub
seek
{
my
(
$self
,
$pos
,
$whence
) =
@_
;
my
$eofpos
=
length
(${
*$self
->{SR}});
if
(
$whence
== 0) {
*$self
->{Pos} =
$pos
}
elsif
(
$whence
== 1) {
*$self
->{Pos} +=
$pos
}
elsif
(
$whence
== 2) {
*$self
->{Pos} =
$eofpos
+
$pos
}
if
(
*$self
->{Pos} < 0) {
*$self
->{Pos} = 0 }
if
(
*$self
->{Pos} >
$eofpos
) {
*$self
->{Pos} =
$eofpos
}
1;
}
sub
tell
{ *{
shift
()}->{Pos} }
sub
close
{
my
$self
=
shift
; %{
*$self
} = () ; 1 ;}
sub
syswrite
{
shift
->
write
(
@_
) ;}
sub
sysseek
{
shift
->
seek
(
@_
) ;}
sub
flush {}
sub
autoflush {}
sub
binmode
{}
sub
DESTROY {
shift
->
close
;}
sub
TIEHANDLE {
((
defined
(
$_
[1]) && UNIVERSAL::isa(
$_
[1],
'Mail::SendEasy::IOScalar'
)) ?
$_
[1] :
shift
->new(
@_
)) ;
}
sub
PRINT {
shift
->
print
(
@_
) }
sub
PRINTF {
shift
->
print
(
sprintf
(
shift
,
@_
)) }
sub
WRITE {
shift
->
write
(
@_
); }
sub
CLOSE {
shift
->
close
(
@_
); }
sub
SEEK {
shift
->
seek
(
@_
); }
sub
TELL {
shift
->
tell
(
@_
); }
sub
EOF {
shift
->
eof
(
@_
); }
1;