Cross Reference: Cmd.pm
xref
: /
osnet-11
/
usr
/
src
/
cmd
/
perl
/
5.8.4
/
distrib
/
lib
/
Net
/
Cmd.pm
Home
History
Annotate
Line#
Navigate
Download
Search
only in
./
1
N/A
# Net::
Cmd.pm
$Id: //
depot
/
libnet
/
Net
/
Cmd.pm
#33 $
1
N/A
#
1
N/A
# Copyright (c) 1995-1997 Graham Barr <gbarr@pobox.com>. All rights reserved.
1
N/A
# This program is free software; you can redistribute it
and
/
or
1
N/A
# modify it under the same terms as Perl itself.
1
N/A
1
N/A
package
Net
::
Cmd
;
1
N/A
1
N/A
require
5.001
;
1
N/A
require
Exporter
;
1
N/A
1
N/A
use
strict
;
1
N/A
use
vars
qw
(@
ISA
@
EXPORT
$
VERSION
);
1
N/A
use
Carp
;
1
N/A
use
Symbol
'gensym'
;
1
N/A
1
N/A
BEGIN
{
1
N/A
if
($^O
eq
'os390'
) {
1
N/A
require
Convert
::
EBCDIC
;
1
N/A
# Convert::EBCDIC->import;
1
N/A
}
1
N/A
}
1
N/A
1
N/A
$
VERSION
=
"2.24"
;
1
N/A
@
ISA
=
qw
(
Exporter
);
1
N/A
@
EXPORT
=
qw
(
CMD_INFO
CMD_OK
CMD_MORE
CMD_REJECT
CMD_ERROR
CMD_PENDING
);
1
N/A
1
N/A
sub
CMD_INFO
{
1
}
1
N/A
sub
CMD_OK
{
2
}
1
N/A
sub
CMD_MORE
{
3
}
1
N/A
sub
CMD_REJECT
{
4
}
1
N/A
sub
CMD_ERROR
{
5
}
1
N/A
sub
CMD_PENDING
{
0
}
1
N/A
1
N/A
my
%
debug
= ();
1
N/A
1
N/A
my
$
tr
= $^O
eq
'os390'
?
Convert
::
EBCDIC
->
new
() :
undef
;
1
N/A
1
N/A
sub
toebcdic
1
N/A
{
1
N/A
my
$
cmd
=
shift
;
1
N/A
1
N/A
unless
(
exists
${*$
cmd
}{
'net_cmd_asciipeer'
})
1
N/A
{
1
N/A
my
$
string
= $_[
0
];
1
N/A
my
$
ebcdicstr
= $
tr
->
toebcdic
($
string
);
1
N/A
${*$
cmd
}{
'net_cmd_asciipeer'
} = $
string
!~ /^\d+/ && $
ebcdicstr
=~ /^\d+/;
1
N/A
}
1
N/A
1
N/A
${*$
cmd
}{
'net_cmd_asciipeer'
}
1
N/A
? $
tr
->
toebcdic
($_[
0
])
1
N/A
: $_[
0
];
1
N/A
}
1
N/A
1
N/A
sub
toascii
1
N/A
{
1
N/A
my
$
cmd
=
shift
;
1
N/A
${*$
cmd
}{
'net_cmd_asciipeer'
}
1
N/A
? $
tr
->
toascii
($_[
0
])
1
N/A
: $_[
0
];
1
N/A
}
1
N/A
1
N/A
sub
_print_isa
1
N/A
{
1
N/A
no
strict
qw
(
refs
);
1
N/A
1
N/A
my
$
pkg
=
shift
;
1
N/A
my
$
cmd
= $
pkg
;
1
N/A
1
N/A
$
debug
{$
pkg
} ||=
0
;
1
N/A
1
N/A
my
%
done
= ();
1
N/A
my
@
do
= ($
pkg
);
1
N/A
my
%
spc
= ( $
pkg
,
""
);
1
N/A
1
N/A
while
($
pkg
=
shift
@
do
)
1
N/A
{
1
N/A
next
if
defined
$
done
{$
pkg
};
1
N/A
1
N/A
$
done
{$
pkg
} =
1
;
1
N/A
1
N/A
my
$v =
defined
${
"${pkg}::VERSION"
}
1
N/A
?
"("
. ${
"${pkg}::VERSION"
} .
")"
1
N/A
:
""
;
1
N/A
1
N/A
my
$
spc
= $
spc
{$
pkg
};
1
N/A
$
cmd
->
debug_print
(
1
,
"${spc}${pkg}${v}\n"
);
1
N/A
1
N/A
if
(@{
"${pkg}::ISA"
})
1
N/A
{
1
N/A
@
spc
{@{
"${pkg}::ISA"
}} = (
" "
. $
spc
{$
pkg
}) x @{
"${pkg}::ISA"
};
1
N/A
unshift
(@
do
, @{
"${pkg}::ISA"
});
1
N/A
}
1
N/A
}
1
N/A
}
1
N/A
1
N/A
sub
debug
1
N/A
{
1
N/A
@_ ==
1
or
@_ ==
2
or
croak
'usage: $obj->debug([LEVEL])'
;
1
N/A
1
N/A
my
($
cmd
,$
level
) = @_;
1
N/A
my
$
pkg
=
ref
($
cmd
) || $
cmd
;
1
N/A
my
$
oldval
=
0
;
1
N/A
1
N/A
if
(
ref
($
cmd
))
1
N/A
{
1
N/A
$
oldval
= ${*$
cmd
}{
'net_cmd_debug'
} ||
0
;
1
N/A
}
1
N/A
else
1
N/A
{
1
N/A
$
oldval
= $
debug
{$
pkg
} ||
0
;
1
N/A
}
1
N/A
1
N/A
return
$
oldval
1
N/A
unless
@_ ==
2
;
1
N/A
1
N/A
$
level
= $
debug
{$
pkg
} ||
0
1
N/A
unless
defined
$
level
;
1
N/A
1
N/A
_print_isa
($
pkg
)
1
N/A
if
($
level
&& !
exists
$
debug
{$
pkg
});
1
N/A
1
N/A
if
(
ref
($
cmd
))
1
N/A
{
1
N/A
${*$
cmd
}{
'net_cmd_debug'
} = $
level
;
1
N/A
}
1
N/A
else
1
N/A
{
1
N/A
$
debug
{$
pkg
} = $
level
;
1
N/A
}
1
N/A
1
N/A
$
oldval
;
1
N/A
}
1
N/A
1
N/A
sub
message
1
N/A
{
1
N/A
@_ ==
1
or
croak
'usage: $obj->message()'
;
1
N/A
1
N/A
my
$
cmd
=
shift
;
1
N/A
1
N/A
wantarray
? @{${*$
cmd
}{
'net_cmd_resp'
}}
1
N/A
:
join
(
""
, @{${*$
cmd
}{
'net_cmd_resp'
}});
1
N/A
}
1
N/A
1
N/A
sub
debug_text
{ $_[
2
] }
1
N/A
1
N/A
sub
debug_print
1
N/A
{
1
N/A
my
($
cmd
,$
out
,$
text
) = @_;
1
N/A
print
STDERR
$
cmd
,($
out
?
'>>> '
:
'<<< '
), $
cmd
->
debug_text
($
out
,$
text
);
1
N/A
}
1
N/A
1
N/A
sub
code
1
N/A
{
1
N/A
@_ ==
1
or
croak
'usage: $obj->code()'
;
1
N/A
1
N/A
my
$
cmd
=
shift
;
1
N/A
1
N/A
${*$
cmd
}{
'net_cmd_code'
} =
"000"
1
N/A
unless
exists
${*$
cmd
}{
'net_cmd_code'
};
1
N/A
1
N/A
${*$
cmd
}{
'net_cmd_code'
};
1
N/A
}
1
N/A
1
N/A
sub
status
1
N/A
{
1
N/A
@_ ==
1
or
croak
'usage: $obj->status()'
;
1
N/A
1
N/A
my
$
cmd
=
shift
;
1
N/A
1
N/A
substr
(${*$
cmd
}{
'net_cmd_code'
},
0
,
1
);
1
N/A
}
1
N/A
1
N/A
sub
set_status
1
N/A
{
1
N/A
@_ ==
3
or
croak
'usage: $obj->set_status(CODE, MESSAGE)'
;
1
N/A
1
N/A
my
$
cmd
=
shift
;
1
N/A
my
($
code
,$
resp
) = @_;
1
N/A
1
N/A
$
resp
= [ $
resp
]
1
N/A
unless
ref
($
resp
);
1
N/A
1
N/A
(${*$
cmd
}{
'net_cmd_code'
},${*$
cmd
}{
'net_cmd_resp'
}) = ($
code
, $
resp
);
1
N/A
1
N/A
1
;
1
N/A
}
1
N/A
1
N/A
sub
command
1
N/A
{
1
N/A
my
$
cmd
=
shift
;
1
N/A
1
N/A
unless
(
defined
fileno
($
cmd
))
1
N/A
{
1
N/A
$
cmd
->
set_status
(
"599"
,
"Connection closed"
);
1
N/A
return
$
cmd
;
1
N/A
}
1
N/A
1
N/A
1
N/A
$
cmd
->
dataend
()
1
N/A
if
(
exists
${*$
cmd
}{
'net_cmd_need_crlf'
});
1
N/A
1
N/A
if
(
scalar
(@_))
1
N/A
{
1
N/A
local
$
SIG
{
PIPE
} =
'IGNORE'
unless
$^O
eq
'MacOS'
;
1
N/A
1
N/A
my
$
str
=
join
(
" "
,
map
{ /\n/ ?
do
{
my
$n = $_; $n =~
tr
/\n/ /; $n } : $_; } @_);
1
N/A
$
str
= $
cmd
->
toascii
($
str
)
if
$
tr
;
1
N/A
$
str
.=
"\015\012"
;
1
N/A
1
N/A
my
$
len
=
length
$
str
;
1
N/A
my
$
swlen
;
1
N/A
1
N/A
$
cmd
->
close
1
N/A
unless
(
defined
($
swlen
=
syswrite
($
cmd
,$
str
,$
len
)) && $
swlen
== $
len
);
1
N/A
1
N/A
$
cmd
->
debug_print
(
1
,$
str
)
1
N/A
if
($
cmd
->
debug
);
1
N/A
1
N/A
${*$
cmd
}{
'net_cmd_resp'
} = [];
# the response
1
N/A
${*$
cmd
}{
'net_cmd_code'
} =
"000"
;
# Made this one up :-)
1
N/A
}
1
N/A
1
N/A
$
cmd
;
1
N/A
}
1
N/A
1
N/A
sub
ok
1
N/A
{
1
N/A
@_ ==
1
or
croak
'usage: $obj->ok()'
;
1
N/A
1
N/A
my
$
code
= $_[
0
]->
code
;
1
N/A
0
< $
code
&& $
code
<
400
;
1
N/A
}
1
N/A
1
N/A
sub
unsupported
1
N/A
{
1
N/A
my
$
cmd
=
shift
;
1
N/A
1
N/A
${*$
cmd
}{
'net_cmd_resp'
} = [
'Unsupported command'
];
1
N/A
${*$
cmd
}{
'net_cmd_code'
} =
580
;
1
N/A
0
;
1
N/A
}
1
N/A
1
N/A
sub
getline
1
N/A
{
1
N/A
my
$
cmd
=
shift
;
1
N/A
1
N/A
${*$
cmd
}{
'net_cmd_lines'
} ||= [];
1
N/A
1
N/A
return
shift
@{${*$
cmd
}{
'net_cmd_lines'
}}
1
N/A
if
scalar
(@{${*$
cmd
}{
'net_cmd_lines'
}});
1
N/A
1
N/A
my
$
partial
=
defined
(${*$
cmd
}{
'net_cmd_partial'
})
1
N/A
? ${*$
cmd
}{
'net_cmd_partial'
} :
""
;
1
N/A
my
$
fd
=
fileno
($
cmd
);
1
N/A
1
N/A
return
undef
1
N/A
unless
defined
$
fd
;
1
N/A
1
N/A
my
$
rin
=
""
;
1
N/A
vec
($
rin
,$
fd
,
1
) =
1
;
1
N/A
1
N/A
my
$
buf
;
1
N/A
1
N/A
until
(
scalar
(@{${*$
cmd
}{
'net_cmd_lines'
}}))
1
N/A
{
1
N/A
my
$
timeout
= $
cmd
->
timeout
||
undef
;
1
N/A
my
$
rout
;
1
N/A
if
(
select
($
rout
=$
rin
,
undef
,
undef
, $
timeout
))
1
N/A
{
1
N/A
unless
(
sysread
($
cmd
, $
buf
=
""
,
1024
))
1
N/A
{
1
N/A
carp
(
ref
($
cmd
) .
": Unexpected EOF on command channel"
)
1
N/A
if
$
cmd
->
debug
;
1
N/A
$
cmd
->
close
;
1
N/A
return
undef
;
1
N/A
}
1
N/A
1
N/A
substr
($
buf
,
0
,
0
) = $
partial
;
## prepend from last sysread
1
N/A
1
N/A
my
@
buf
=
split
(/\
015
?\
012
/, $
buf
, -
1
);
## break into lines
1
N/A
1
N/A
$
partial
=
pop
@
buf
;
1
N/A
1
N/A
push
(@{${*$
cmd
}{
'net_cmd_lines'
}},
map
{
"$_\n"
} @
buf
);
1
N/A
1
N/A
}
1
N/A
else
1
N/A
{
1
N/A
carp
(
"$cmd: Timeout"
)
if
($
cmd
->
debug
);
1
N/A
return
undef
;
1
N/A
}
1
N/A
}
1
N/A
1
N/A
${*$
cmd
}{
'net_cmd_partial'
} = $
partial
;
1
N/A
1
N/A
if
($
tr
)
1
N/A
{
1
N/A
foreach
my
$
ln
(@{${*$
cmd
}{
'net_cmd_lines'
}})
1
N/A
{
1
N/A
$
ln
= $
cmd
->
toebcdic
($
ln
);
1
N/A
}
1
N/A
}
1
N/A
1
N/A
shift
@{${*$
cmd
}{
'net_cmd_lines'
}};
1
N/A
}
1
N/A
1
N/A
sub
ungetline
1
N/A
{
1
N/A
my
($
cmd
,$
str
) = @_;
1
N/A
1
N/A
${*$
cmd
}{
'net_cmd_lines'
} ||= [];
1
N/A
unshift
(@{${*$
cmd
}{
'net_cmd_lines'
}}, $
str
);
1
N/A
}
1
N/A
1
N/A
sub
parse_response
1
N/A
{
1
N/A
return
()
1
N/A
unless
$_[
1
] =~ s/^(\d\d\d)(.?)//o;
1
N/A
($
1
, $
2
eq
"-"
);
1
N/A
}
1
N/A
1
N/A
sub
response
1
N/A
{
1
N/A
my
$
cmd
=
shift
;
1
N/A
my
($
code
,$
more
) = (
undef
) x
2
;
1
N/A
1
N/A
${*$
cmd
}{
'net_cmd_resp'
} ||= [];
1
N/A
1
N/A
while
(
1
)
1
N/A
{
1
N/A
my
$
str
= $
cmd
->
getline
();
1
N/A
1
N/A
return
CMD_ERROR
1
N/A
unless
defined
($
str
);
1
N/A
1
N/A
$
cmd
->
debug_print
(
0
,$
str
)
1
N/A
if
($
cmd
->
debug
);
1
N/A
1
N/A
($
code
,$
more
) = $
cmd
->
parse_response
($
str
);
1
N/A
unless
(
defined
$
code
)
1
N/A
{
1
N/A
$
cmd
->
ungetline
($
str
);
1
N/A
last
;
1
N/A
}
1
N/A
1
N/A
${*$
cmd
}{
'net_cmd_code'
} = $
code
;
1
N/A
1
N/A
push
(@{${*$
cmd
}{
'net_cmd_resp'
}},$
str
);
1
N/A
1
N/A
last
unless
($
more
);
1
N/A
}
1
N/A
1
N/A
substr
($
code
,
0
,
1
);
1
N/A
}
1
N/A
1
N/A
sub
read_until_dot
1
N/A
{
1
N/A
my
$
cmd
=
shift
;
1
N/A
my
$
fh
=
shift
;
1
N/A
my
$
arr
= [];
1
N/A
1
N/A
while
(
1
)
1
N/A
{
1
N/A
my
$
str
= $
cmd
->
getline
()
or
return
undef
;
1
N/A
1
N/A
$
cmd
->
debug_print
(
0
,$
str
)
1
N/A
if
($
cmd
->
debug
&
4
);
1
N/A
1
N/A
last
if
($
str
=~ /^\.\r?\n/o);
1
N/A
1
N/A
$
str
=~ s/^\.\././o;
1
N/A
1
N/A
if
(
defined
$
fh
)
1
N/A
{
1
N/A
print
$
fh
$
str
;
1
N/A
}
1
N/A
else
1
N/A
{
1
N/A
push
(@$
arr
,$
str
);
1
N/A
}
1
N/A
}
1
N/A
1
N/A
$
arr
;
1
N/A
}
1
N/A
1
N/A
sub
datasend
1
N/A
{
1
N/A
my
$
cmd
=
shift
;
1
N/A
my
$
arr
= @_ ==
1
&&
ref
($_[
0
]) ? $_[
0
] : \@_;
1
N/A
my
$
line
=
join
(
""
,@$
arr
);
1
N/A
1
N/A
return
0
unless
defined
(
fileno
($
cmd
));
1
N/A
1
N/A
unless
(
length
$
line
) {
1
N/A
# Even though we are not sending anything, the fact we were
1
N/A
# called means that dataend needs to be called before the next
1
N/A
# command, which happens of net_cmd_need_crlf exists
1
N/A
${*$
cmd
}{
'net_cmd_need_crlf'
} ||=
0
;
1
N/A
return
1
;
1
N/A
}
1
N/A
1
N/A
if
($
cmd
->
debug
) {
1
N/A
foreach
my
$b (
split
(/\n/,$
line
)) {
1
N/A
$
cmd
->
debug_print
(
1
,
"$b\n"
);
1
N/A
}
1
N/A
}
1
N/A
1
N/A
$
line
=~ s/\r?\n/\r\n/
sg
;
1
N/A
$
line
=~
tr
/\r\n/\
015
\
012
/
unless
"\r"
eq
"\015"
;
1
N/A
1
N/A
$
line
=~ s/(\
012
\.)/$
1
./
sog
;
1
N/A
$
line
=~ s/^\./../
unless
${*$
cmd
}{
'net_cmd_need_crlf'
};
1
N/A
1
N/A
${*$
cmd
}{
'net_cmd_need_crlf'
} =
substr
($
line
,-
1
,
1
)
ne
"\012"
;
1
N/A
1
N/A
my
$
len
=
length
($
line
);
1
N/A
my
$
offset
=
0
;
1
N/A
my
$
win
=
""
;
1
N/A
vec
($
win
,
fileno
($
cmd
),
1
) =
1
;
1
N/A
my
$
timeout
= $
cmd
->
timeout
||
undef
;
1
N/A
1
N/A
local
$
SIG
{
PIPE
} =
'IGNORE'
unless
$^O
eq
'MacOS'
;
1
N/A
1
N/A
while
($
len
)
1
N/A
{
1
N/A
my
$
wout
;
1
N/A
if
(
select
(
undef
,$
wout
=$
win
,
undef
, $
timeout
) >
0
)
1
N/A
{
1
N/A
my
$w =
syswrite
($
cmd
, $
line
, $
len
, $
offset
);
1
N/A
unless
(
defined
($w))
1
N/A
{
1
N/A
carp
(
"$cmd: $!"
)
if
$
cmd
->
debug
;
1
N/A
return
undef
;
1
N/A
}
1
N/A
$
len
-= $w;
1
N/A
$
offset
+= $w;
1
N/A
}
1
N/A
else
1
N/A
{
1
N/A
carp
(
"$cmd: Timeout"
)
if
($
cmd
->
debug
);
1
N/A
return
undef
;
1
N/A
}
1
N/A
}
1
N/A
1
N/A
1
;
1
N/A
}
1
N/A
1
N/A
sub
rawdatasend
1
N/A
{
1
N/A
my
$
cmd
=
shift
;
1
N/A
my
$
arr
= @_ ==
1
&&
ref
($_[
0
]) ? $_[
0
] : \@_;
1
N/A
my
$
line
=
join
(
""
,@$
arr
);
1
N/A
1
N/A
return
0
unless
defined
(
fileno
($
cmd
));
1
N/A
1
N/A
return
1
1
N/A
unless
length
($
line
);
1
N/A
1
N/A
if
($
cmd
->
debug
)
1
N/A
{
1
N/A
my
$b =
"$cmd>>> "
;
1
N/A
print
STDERR
$b,
join
(
"\n$b"
,
split
(/\n/,$
line
)),
"\n"
;
1
N/A
}
1
N/A
1
N/A
my
$
len
=
length
($
line
);
1
N/A
my
$
offset
=
0
;
1
N/A
my
$
win
=
""
;
1
N/A
vec
($
win
,
fileno
($
cmd
),
1
) =
1
;
1
N/A
my
$
timeout
= $
cmd
->
timeout
||
undef
;
1
N/A
1
N/A
local
$
SIG
{
PIPE
} =
'IGNORE'
unless
$^O
eq
'MacOS'
;
1
N/A
while
($
len
)
1
N/A
{
1
N/A
my
$
wout
;
1
N/A
if
(
select
(
undef
,$
wout
=$
win
,
undef
, $
timeout
) >
0
)
1
N/A
{
1
N/A
my
$w =
syswrite
($
cmd
, $
line
, $
len
, $
offset
);
1
N/A
unless
(
defined
($w))
1
N/A
{
1
N/A
carp
(
"$cmd: $!"
)
if
$
cmd
->
debug
;
1
N/A
return
undef
;
1
N/A
}
1
N/A
$
len
-= $w;
1
N/A
$
offset
+= $w;
1
N/A
}
1
N/A
else
1
N/A
{
1
N/A
carp
(
"$cmd: Timeout"
)
if
($
cmd
->
debug
);
1
N/A
return
undef
;
1
N/A
}
1
N/A
}
1
N/A
1
N/A
1
;
1
N/A
}
1
N/A
1
N/A
sub
dataend
1
N/A
{
1
N/A
my
$
cmd
=
shift
;
1
N/A
1
N/A
return
0
unless
defined
(
fileno
($
cmd
));
1
N/A
1
N/A
return
1
1
N/A
unless
(
exists
${*$
cmd
}{
'net_cmd_need_crlf'
});
1
N/A
1
N/A
local
$
SIG
{
PIPE
} =
'IGNORE'
unless
$^O
eq
'MacOS'
;
1
N/A
syswrite
($
cmd
,
"\015\012"
,
2
)
1
N/A
if
${*$
cmd
}{
'net_cmd_need_crlf'
};
1
N/A
1
N/A
$
cmd
->
debug_print
(
1
,
".\n"
)
1
N/A
if
($
cmd
->
debug
);
1
N/A
1
N/A
syswrite
($
cmd
,
".\015\012"
,
3
);
1
N/A
1
N/A
delete
${*$
cmd
}{
'net_cmd_need_crlf'
};
1
N/A
1
N/A
$
cmd
->
response
() ==
CMD_OK
;
1
N/A
}
1
N/A
1
N/A
# read and write to tied filehandle
1
N/A
sub
tied_fh
{
1
N/A
my
$
cmd
=
shift
;
1
N/A
${*$
cmd
}{
'net_cmd_readbuf'
} =
''
;
1
N/A
my
$
fh
=
gensym
();
1
N/A
tie
*$
fh
,
ref
($
cmd
),$
cmd
;
1
N/A
return
$
fh
;
1
N/A
}
1
N/A
1
N/A
# tie to myself
1
N/A
sub
TIEHANDLE
{
1
N/A
my
$
class
=
shift
;
1
N/A
my
$
cmd
=
shift
;
1
N/A
return
$
cmd
;
1
N/A
}
1
N/A
1
N/A
# Tied filehandle read. Reads requested data length, returning
1
N/A
# end-of-file when the dot is encountered.
1
N/A
sub
READ
{
1
N/A
my
$
cmd
=
shift
;
1
N/A
my
($
len
,$
offset
) = @_[
1
,
2
];
1
N/A
return
unless
exists
${*$
cmd
}{
'net_cmd_readbuf'
};
1
N/A
my
$
done
=
0
;
1
N/A
while
(!$
done
and
length
(${*$
cmd
}{
'net_cmd_readbuf'
}) < $
len
) {
1
N/A
${*$
cmd
}{
'net_cmd_readbuf'
} .= $
cmd
->
getline
()
or
return
;
1
N/A
$
done
++
if
${*$
cmd
}{
'net_cmd_readbuf'
} =~ s/^\.\r?\n\Z//m;
1
N/A
}
1
N/A
1
N/A
$_[
0
] =
''
;
1
N/A
substr
($_[
0
],$
offset
+
0
) =
substr
(${*$
cmd
}{
'net_cmd_readbuf'
},
0
,$
len
);
1
N/A
substr
(${*$
cmd
}{
'net_cmd_readbuf'
},
0
,$
len
) =
''
;
1
N/A
delete
${*$
cmd
}{
'net_cmd_readbuf'
}
if
$
done
;
1
N/A
1
N/A
return
length
$_[
0
];
1
N/A
}
1
N/A
1
N/A
sub
READLINE
{
1
N/A
my
$
cmd
=
shift
;
1
N/A
# in this context, we use the presence of readbuf to
1
N/A
# indicate that we have not yet reached the eof
1
N/A
return
unless
exists
${*$
cmd
}{
'net_cmd_readbuf'
};
1
N/A
my
$
line
= $
cmd
->
getline
;
1
N/A
return
if
$
line
=~ /^\.\r?\n/;
1
N/A
$
line
;
1
N/A
}
1
N/A
1
N/A
sub
PRINT
{
1
N/A
my
$
cmd
=
shift
;
1
N/A
my
($
buf
,$
len
,$
offset
) = @_;
1
N/A
$
len
||=
length
($
buf
);
1
N/A
$
offset
+=
0
;
1
N/A
return
unless
$
cmd
->
datasend
(
substr
($
buf
,$
offset
,$
len
));
1
N/A
${*$
cmd
}{
'net_cmd_sending'
}++;
# flag that we should call dataend()
1
N/A
return
$
len
;
1
N/A
}
1
N/A
1
N/A
sub
CLOSE
{
1
N/A
my
$
cmd
=
shift
;
1
N/A
my
$r =
exists
(${*$
cmd
}{
'net_cmd_sending'
}) ? $
cmd
->
dataend
:
1
;
1
N/A
delete
${*$
cmd
}{
'net_cmd_readbuf'
};
1
N/A
delete
${*$
cmd
}{
'net_cmd_sending'
};
1
N/A
$r;
1
N/A
}
1
N/A
1
N/A
1
;
1
N/A
1
N/A
__END__
1
N/A
1
N/A
1
N/A
=head1 NAME
1
N/A
1
N/A
Net::Cmd - Network Command class (as used by FTP, SMTP etc)
1
N/A
1
N/A
=head1 SYNOPSIS
1
N/A
1
N/A
use Net::Cmd;
1
N/A
1
N/A
@ISA = qw(Net::Cmd);
1
N/A
1
N/A
=head1 DESCRIPTION
1
N/A
1
N/A
C<Net::Cmd> is a collection of methods that can be inherited by a sub class
1
N/A
of C<IO::Handle>. These methods implement the functionality required for a
1
N/A
command based protocol, for example FTP and SMTP.
1
N/A
1
N/A
=head1 USER METHODS
1
N/A
1
N/A
These methods provide a user interface to the C<Net::Cmd> object.
1
N/A
1
N/A
=over 4
1
N/A
1
N/A
=item debug ( VALUE )
1
N/A
1
N/A
Set the level of debug information for this object. If C<VALUE> is not given
1
N/A
then the current state is returned. Otherwise the state is changed to
1
N/A
C<VALUE> and the previous state returned.
1
N/A
1
N/A
Different packages
1
N/A
may implement different levels of debug but a non-zero value results in
1
N/A
copies of all commands and responses also being sent to STDERR.
1
N/A
1
N/A
If C<VALUE> is C<undef> then the debug level will be set to the default
1
N/A
debug level for the class.
1
N/A
1
N/A
This method can also be called as a I<static> method to
set
/
get
the default
1
N/A
debug level for a given class.
1
N/A
1
N/A
=item message ()
1
N/A
1
N/A
Returns the text message returned from the last command
1
N/A
1
N/A
=item code ()
1
N/A
1
N/A
Returns the 3-digit code from the last command. If a command is pending
1
N/A
then the value 0 is returned
1
N/A
1
N/A
=item ok ()
1
N/A
1
N/A
Returns non-zero if the last code value was greater than zero and
1
N/A
less than 400. This holds true for most command servers. Servers
1
N/A
where this does not hold may override this method.
1
N/A
1
N/A
=item status ()
1
N/A
1
N/A
Returns the most significant digit of the current status code. If a command
1
N/A
is pending then C<CMD_PENDING> is returned.
1
N/A
1
N/A
=item datasend ( DATA )
1
N/A
1
N/A
Send data to the remote server, converting LF to CRLF. Any line starting
1
N/A
with a '.' will be prefixed with another '.'.
1
N/A
C<DATA> may be an array or a reference to an array.
1
N/A
1
N/A
=item dataend ()
1
N/A
1
N/A
End the sending of data to the remote server. This is done by ensuring that
1
N/A
the data already sent ends with CRLF then sending '.CRLF' to end the
1
N/A
transmission. Once this data has been sent C<dataend> calls C<response> and
1
N/A
returns true if C<response> returns CMD_OK.
1
N/A
1
N/A
=back
1
N/A
1
N/A
=head1 CLASS METHODS
1
N/A
1
N/A
These methods are not intended to be called by the user, but used or
1
N/A
over-ridden by a sub-class of C<Net::Cmd>
1
N/A
1
N/A
=over 4
1
N/A
1
N/A
=item debug_print ( DIR, TEXT )
1
N/A
1
N/A
Print debugging information. C<DIR> denotes the direction I<true> being
1
N/A
data being sent to the server. Calls C<debug_text> before printing to
1
N/A
STDERR.
1
N/A
1
N/A
=item debug_text ( TEXT )
1
N/A
1
N/A
This method is called to print debugging information. TEXT is
1
N/A
the text being sent. The method should return the text to be printed
1
N/A
1
N/A
This is primarily meant for the use of modules such as FTP where passwords
1
N/A
are sent, but we do not want to display them in the debugging information.
1
N/A
1
N/A
=item command ( CMD [, ARGS, ... ])
1
N/A
1
N/A
Send a command to the command server. All arguments a first joined with
1
N/A
a space character and CRLF is appended, this string is then sent to the
1
N/A
command server.
1
N/A
1
N/A
Returns undef upon failure
1
N/A
1
N/A
=item unsupported ()
1
N/A
1
N/A
Sets the status code to 580 and the response text to 'Unsupported command'.
1
N/A
Returns zero.
1
N/A
1
N/A
=item response ()
1
N/A
1
N/A
Obtain a response from the server. Upon success the most significant digit
1
N/A
of the status code is returned. Upon failure, timeout etc., I<undef> is
1
N/A
returned.
1
N/A
1
N/A
=item parse_response ( TEXT )
1
N/A
1
N/A
This method is called by C<response> as a method with one argument. It should
1
N/A
return an array of 2 values, the 3-digit status code and a flag which is true
1
N/A
when this is part of a multi-line response and this line is not the list.
1
N/A
1
N/A
=item getline ()
1
N/A
1
N/A
Retrieve one line, delimited by CRLF, from the remote server. Returns I<undef>
1
N/A
upon failure.
1
N/A
1
N/A
B<NOTE>: If you do use this method for any reason, please remember to add
1
N/A
some C<debug_print> calls into your method.
1
N/A
1
N/A
=item ungetline ( TEXT )
1
N/A
1
N/A
Unget a line of text from the server.
1
N/A
1
N/A
=item rawdatasend ( DATA )
1
N/A
1
N/A
Send data to the remote server without performing any conversions. C<DATA>
1
N/A
is a scalar.
1
N/A
1
N/A
=item read_until_dot ()
1
N/A
1
N/A
Read data from the remote server until a line consisting of a single '.'.
1
N/A
Any lines starting with '..' will have one of the '.'s removed.
1
N/A
1
N/A
Returns a reference to a list containing the lines, or I<undef> upon failure.
1
N/A
1
N/A
=item tied_fh ()
1
N/A
1
N/A
Returns a filehandle tied to the Net::Cmd object. After issuing a
1
N/A
command, you may read from this filehandle using read() or <>. The
1
N/A
filehandle will return EOF when the final dot is encountered.
1
N/A
Similarly, you may write to the filehandle in order to send data to
1
N/A
the server after issuing a commmand that expects data to be written.
1
N/A
1
N/A
See the Net::POP3 and Net::SMTP modules for examples of this.
1
N/A
1
N/A
=back
1
N/A
1
N/A
=head1 EXPORTS
1
N/A
1
N/A
C<Net::Cmd> exports six subroutines, five of these, C<CMD_INFO>, C<CMD_OK>,
1
N/A
C<CMD_MORE>, C<CMD_REJECT> and C<CMD_ERROR>, correspond to possible results
1
N/A
of C<response> and C<status>. The sixth is C<CMD_PENDING>.
1
N/A
1
N/A
=head1 AUTHOR
1
N/A
1
N/A
Graham Barr <gbarr@pobox.com>
1
N/A
1
N/A
=head1 COPYRIGHT
1
N/A
1
N/A
Copyright (c) 1995-1997 Graham Barr. All rights reserved.
1
N/A
This program is free software; you can redistribute it
and
/
or
modify
1
N/A
it under the same terms as Perl itself.
1
N/A
1
N/A
=for html <hr>
1
N/A
1
N/A
I<$Id: //
depot
/
libnet
/
Net
/
Cmd.pm
#33 $>
1
N/A
1
N/A
=cut