view release on metacpan or  search on metacpan

lib/Net/Telnet.pm  view on Meta::CPAN

        $s,
        );

    $s = *$self->{net_telnet};
    $prev = $s->{time_out};

    if (@_ >= 2) {
        $s->{time_out} = &_parse_timeout($self, $timeout);
    }

    $prev;
} # end sub timeout


sub waitfor {
    my ($self, @args) = @_;
    my (
        $arg,
        $binmode,
        $endtime,
        $errmode,
        $len,
        $match,
        $match_op,
        $pos,
        $prematch,
        $s,
        $search,
        $search_cond,
        $telnetmode,
        $timeout,
        @match_cond,
        @match_ops,
        @search_cond,
        @string_cond,
        @warns,
        );
    local $@;
    local $_;

    ## Init.
    $s = *$self->{net_telnet};
    $s->{timedout} = '';
    return if $s->{eofile};
    return unless @args;
    $timeout = $s->{time_out};

    ## Code template used to build string match conditional.
    ## Values between array elements must be supplied later.
    @string_cond =
        ('if (($pos = index $s->{buf}, ', ') > -1) {
            $len = ', ';
            $prematch = substr $s->{buf}, 0, $pos;
            $match = substr $s->{buf}, $pos, $len;
            substr($s->{buf}, 0, $pos + $len) = "";
            last;
        }');

    ## Code template used to build pattern match conditional.
    ## Values between array elements must be supplied later.
    if ($] ge '5.006') {  # perl5.6.0+ has performance alternative to $` and $&
        @match_cond =
            ('if ($s->{buf} =~ ', ') {
                $prematch = substr($s->{buf}, 0, $-[0]);
                $match = substr($s->{buf}, $-[0], $+[0] - $-[0]);
                substr($s->{buf}, 0, length($prematch) + length($match)) = "";
                last;
            }');
    }
    else {
        @match_cond =
            ('if ($s->{buf} =~ ', ') {
                $prematch = $`;
                $match = $&;
                substr($s->{buf}, 0, length($`) + length($&)) = "";
                last;
            }');
    }

    ## Parse args.
    if (@_ == 2) {  # one positional arg given
        $arg = $_[1];

        ## Fill in the blanks in the code template.
        push @match_ops, $arg;
        push @search_cond, join("", $match_cond[0], $arg, $match_cond[1]);
    }
    elsif (@_ > 2) {  # named args given
        ## Parse the named args.
        while (($_, $arg) = splice @args, 0, 2) {
            if (/^-?binmode$/i) {
                $binmode = $arg;
                unless (defined $binmode) {
                    $binmode = 0;
                }
            }
            elsif (/^-?errmode$/i) {
                $errmode = &_parse_errmode($self, $arg);
            }
            elsif (/^-?match$/i) {
                ## Fill in the blanks in the code template.
                push @match_ops, $arg;
                push @search_cond, join("",
                                        $match_cond[0], $arg, $match_cond[1]);
            }
            elsif (/^-?string$/i) {
                ## Fill in the blanks in the code template.
                $arg =~ s/'/\\'/g;  # quote ticks
                push @search_cond, join("",
                                        $string_cond[0], "'$arg'",
                                        $string_cond[1], length($arg),
                                        $string_cond[2]);
            }
            elsif (/^-?telnetmode$/i) {
                $telnetmode = $arg;
                unless (defined $telnetmode) {
                    $telnetmode = 0;
                }
            }
            elsif (/^-?timeout$/i) {
                $timeout = &_parse_timeout($self, $arg);