File Coverage

blib/lib/Net/Telnet/Cisco.pm

Criterion	Covered	Total	%
statement	18	390	4.6
branch	0	262	0.0
condition	0	23	0.0
subroutine	6	36	16.6
pod	21	21	100.0
total	45	732	6.1

package Net::Telnet::Cisco;

#-----------------------------------------------------------------
# Net::Telnet::Cisco - interact with a Cisco router
#
# $Id: Cisco.pm,v 1.52 2002/06/18 17:17:03 jkeroes Exp $
#
# Todo: Add error and access logging.
#
# POD documentation at end of file.
#
#-----------------------------------------------------------------

require 5.005;

use strict;
use warnings;
use Net::Telnet 3.02;
use AutoLoader;
use Carp;

use vars qw($AUTOLOAD @ISA $VERSION $DEBUG);

@ISA      = qw(Net::Telnet);
$VERSION  = '1.12';
$^W       = 1;
$DEBUG    = 0;
$|++;

#------------------------------
# Public Methods
#------------------------------

sub new {
    my $class = shift;

    my ($self, $host, %args);


    my %ntparams = (
        prompt => '/(?m:^(?:[\w.\/]+\:)?[\w.-]+\s?(?:\(config[^\)]*\))?\s?[\$#>]\s?(?:\(enable\))?\s*$)/'
    );
    my %params = (
        always_waitfor_prompt => 1,
        autopage              => 1,
        ignore_warnings       => 0,
        last_cmd              => '',
        last_prompt           => '',
        more_prompt           => '/(?m:^\s*--More--)/',
        normalize_cmd         => 1,
        send_wakeup           => 0,
        waitfor_pause         => 0.1,
        warnings              => '/(?mx:^% Unknown VPN
            |^%IP routing table VRF.* does not exist. Create first$
            |^%No CEF interface information
            |^%No matching route to delete$
            |^%Not all config may be removed and may reappear after reactivating
        )/',
    );

    ## Parse the args.
    if (@_ == 1) {  # one positional arg given
        ($ntparams{host}) = @_;
    } else {
        %args = @_;

        ## initial set other named args.
        foreach (keys %args) {
            if (/^-?always_waitfor_prompt$/i) {
                $params{always_waitfor_prompt} = $args{$_};
            }
            elsif (/^-?autopage$/i) {
                $params{autopage} = $args{$_};
            }
            elsif (/^-?ignore_warnings$/i) {
                $params{ignore_warnings} = $args{$_};
            }
            elsif (/^-?more_prompt$/i) {
                $params{more_prompt} = $args{$_};
            }
            elsif (/^-?normalize_cmd$/i) {
                $params{normalize_cmd} = $args{$_};
            }
            elsif (/^-?send_wakeup$/i) {
                $params{send_wakeup} = $args{$_};
            }
            elsif (/^-?waitfor_pause$/i) {
                $params{waitfor_pause} = $args{$_};
            }
            elsif (/^-?warnings$/i) {
                $params{warnings} = $args{$_};
            }
            elsif (/^-?prompt$/i) {
                $ntparams{prompt} = $args{$_};
            }
            else {
                # pass through
                $ntparams{$_} = $args{$_};
            }
        }
    }

    $self = $class->SUPER::new(%ntparams) or return;
    *$self->{net_telnet_cisco} = \%params;

    ## Parse all other named args.
    foreach (keys %params) {
        if (/^-?always_waitfor_prompt$/i) {
            $self->always_waitfor_prompt($args{$_});
        }
        elsif (/^-?autopage$/i) {
            $self->autopage($args{$_});
        }
        elsif (/^-?ignore_warnings$/i) {
            $self->ignore_warnings($args{$_});
        }
        elsif (/^-?more_prompt$/i) {
            $self->more_prompt($args{$_});
        }
        elsif (/^-?normalize_cmd$/i) {
            $self->normalize_cmd($args{$_});
        }
        elsif (/^-?send_wakeup$/i) {
            $self->send_wakeup($args{$_});
        }
        elsif (/^-?waitfor_pause$/i) {
            $self->waitfor_pause($args{$_});
        }
    }

    $self;
} # end sub new

# The new prompt() stores the last matched prompt for later
# fun 'n amusement. You can access this string via $self->last_prompt.
#
# It also parses out any router errors and stores them in the
# correct place, where they can be acccessed/handled by the
# Net::Telnet error methods.
#
# No POD docs for prompt(); these changes should be transparent to
# the end-user.
sub prompt {
    my( $self, $prompt ) = @_;
    my( $prev, $stream );

    $stream  = $ {*$self}{net_telnet_cisco};
    $prev    = $self->SUPER::prompt;

    ## Parse args.
    if ( @_ == 2 ) {
        defined $prompt or $prompt = '';
        $self->_match_check($prompt);
        $self->SUPER::prompt($prompt);
    } elsif (@_ > 2) {
        return $self->error('usage: $obj->prompt($match_op)');
    }

    return $prev;
} # end sub prompt

# cmd() now parses errors and sticks 'em where they belong.
#
# This is a routerish error:
#   routereast#show asdf
#                     ^
#   % Invalid input detected at '^' marker.
#
# "show async" is valid, so the "d" of "asdf" raised an error.
#
# If an error message is found, the following error message
# is sent to Net::Telnet's error()-handler:
#
#   Last command and router error:
#
#
sub cmd {
    my $self             = shift;
    my $ok               = 1;

    my $normalize = $self->normalize_cmd;
    my $out = [];
    my $output_ref;
    my %ntparams;

    # Parse args
    # pull out N::T::C specific (including -output) and pass
    # rest to N::T in %params
    if (@_ == 1) {
        $ {*$self}{net_telnet_cisco}{last_cmd} = $_[0];
        $ntparams{string} = $_[0];
    } elsif ( @_ >= 2 ) {
        my  %args = @_;
        for (keys(%args)) {
            if (/^-?string$/i) {
                $ {*$self}{net_telnet_cisco}{last_cmd} = $args{$_};
                $ntparams{string} = $args{$_};
            }
            elsif (/^-?normalize_cmd$/i) {
                $normalize = $args{$_};
            }
            elsif (/^-?output$/i) {
                $output_ref = $args{$_};
                if (defined($output_ref) and ref($output_ref) eq "ARRAY") {
                    $out = $output_ref;
                }
            }
            else {
                $ntparams{$_} = $args{$_};
            }
        }
    }

    my $cmd          = $ {*$self}{net_telnet_cisco}{last_cmd};
    my $old_ors      = $self->output_record_separator;
    my $need_more    = 0;

    while(1) {
    # Send a space (with no newline) whenever we see a "More" prompt.
    if ($need_more) {
        $self->output_record_separator('');

        # We saw a more prompt, so put it in the command output.
        my @tmp = $self->last_prompt;

        # Send the , taking care not to
        # discard the top line.
        push @tmp, $self->SUPER::cmd(String => " ", Cmd_remove_mode => 0);

        if ($normalize) {
        push @$out, _normalize(@tmp);
        } else {
        push @$out, @tmp;
        }
    } else {
        $self->output_record_separator($old_ors);
        push @$out, $self->SUPER::cmd(%ntparams);
    }

    # Look for errors in output
    for ( my ($i, $lastline) = (0, '');
          $i <= $#$out;
          $lastline = $out->[$i++] ) {

        # This may have to be a pattern match instead.
        if ( ( substr $out->[$i], 0, 1 ) eq '%' ) {
        if ( $out->[$i] =~ /'\^' marker/ ) { # Typo & bad arg errors
            chomp $lastline;
            $self->error( join "\n",
                  "Last command and router error: ",
                  ( $self->last_prompt . $cmd ),
                  $lastline,
                  $out->[$i],
                );
            splice @$out, $i - 1, 3;
        } else { # All other errors.
            chomp $out->[$i];
            $self->error( join "\n",
                  "Last command and router error: ",
                  ( $self->last_prompt . $cmd ),
                  $out->[$i],
                );
            splice @$out, $i, 2;
        }
        $ok = 0;
        last;
        }
    }

    # Restore old settings
    $self->output_record_separator($old_ors);

    # redo the while loop if we saw a More prompt.
    my $more_re = $self->_re_sans_delims($self->more_prompt);
    if ($self->autopage && $self->last_prompt =~ /$more_re/) {
        $need_more = 1;
    } else {
        last;
    }
    }

    if (defined $output_ref) {
        if (ref($output_ref) eq "SCALAR") {
            $$output_ref = join "", @$out;
        } elsif (ref($output_ref) eq "HASH") {
            %$output_ref = @$out;
        }
    }

    return wantarray ? @$out : $ok;
}


# waitfor now stores prompts to $obj->last_prompt()
sub waitfor {
    my $self = shift;

    return unless @_;

    # $all_prompts will be built into a regex that matches all currently
    # valid prompts.
    #
    # -Match args will be added to this regex. The current prompt will
    # be appended when all -Matches have been exhausted.
    my $all_prompts = '';

    # Literal string matches, passed in with -String.
    my @literals = ();

    # Parse the -Match => '/prompt \$' type options
    # waitfor can accept more than one -Match argument, so we can't just
    # hashify the args.
    if (@_ >= 2) {
    my @args = @_;
    while ( my ($k, $v) = splice @args, 0, 2 ) {
        if ($k =~ /^-?[Ss]tring$/) {
        push @literals, $v;
        } elsif ($k =~ /^-?[Mm]atch$/) {
        $all_prompts = $self->_prompt_append($all_prompts, $v);
        }
    }
    } elsif (@_ == 1) {
    # A single argument is always a -match.
    $all_prompts = $self->_prompt_append($all_prompts, $_[0]);
    }

    my $all_re     = $self->_re_sans_delims($all_prompts);
    my $prompt_re  = $self->_re_sans_delims($self->prompt);
    my $more_re    = $self->_re_sans_delims($self->more_prompt);


    # Add the current prompt if it's not already there. You can turn this behavior
    # off by setting always_waitfor_prompt to a false value.
    if ($self->always_waitfor_prompt && index($all_re, $prompt_re) == -1) {
    unshift @_, "-Match" if @_ == 1;
    push @_, (-Match => $self->prompt);

    $all_prompts  = $self->_prompt_append($all_prompts, $self->prompt);
    $all_re       = $self->_re_sans_delims($all_prompts);
    }

    # Add the more prompt if it's not present. See the autopage() docs
    # to turn this behaviour off.
    if ($self->autopage && index($all_re, $more_re) == -1) {
    unshift @_, "-Match" if @_ == 1;
    push @_, (-Match => $self->more_prompt);

    $all_prompts  = $self->_prompt_append($all_prompts, $self->more_prompt);
    $all_re       = $self->_re_sans_delims($all_prompts);
    }

    return $self->error("Godot ain't home - waitfor() isn't waiting for anything.")
    unless $all_prompts || @literals;

    # There's a timing issue that I can't quite figure out.
    # Adding a small pause here seems to make it go away.
    select undef, undef, undef, $self->waitfor_pause;

    my ($prematch, $match) = $self->SUPER::waitfor(@_);

    # If waitfor saw a prompt then store it.
    if ($match) {
    for (@literals) {
        if (index $match, $_) {
        return wantarray ? ($prematch, $match) : 1;
        }
    }

    if ($match =~ /($all_re)/m ) {
        $ {*$self}{net_telnet_cisco}{last_prompt} = $1;
        return wantarray ? ($prematch, $match) : 1;
    }
    }
    return wantarray ? ( $prematch, $match ) : 1;
}


sub login {
    my($self) = @_;
    my(
       $cmd_prompt,
       $endtime,
       $error,
       $lastline,
       $match,
       $orig_errmode,
       $orig_timeout,
       $prematch,
       $reset,
       $timeout,
       $usage,
       $sent_wakeup,
       );
    my ($username, $password, $tacpass, $passcode ) = ('','','','');
    my (%args, %seen);

    local $_;

    ## Init vars.
    $timeout = $self->timeout;
    $self->timed_out('');
    return if $self->eof;
    $cmd_prompt = $self->prompt;
    $sent_wakeup = 0;

    print "login:\t[orig: $cmd_prompt]\n" if $DEBUG;

    $usage = 'usage: $obj->login([Name => $name,] [Password => $password,] '
       . '[Passcode => $passcode,] [Prompt => $matchop,] [Timeout => $secs,])';

    if (@_ == 3) {  # just username and passwd given
    ($username, $password) = (@_[1,2]);
    }
    else {  # named args given
    ## Get the named args.
    (undef, %args) = @_;

    ## Parse the named args.
    foreach (keys %args) {
        if (/^-?name$/i) {
        $username    = $args{$_};
        } elsif (/^-?passw/i) {
        $password    = $args{$_};
        } elsif (/^-?passcode/i) {
        $passcode    = $args{$_};
        } elsif (/^-?prompt$/i) {
        # login() always looks for a cmd_prompt. This is not
        # controllable via always_waitfor_prompt().
        $cmd_prompt = $self->_prompt_append($cmd_prompt, $args{$_});
        } elsif (/^-?timeout$/i) {
        $timeout = _parse_timeout($args{$_});
        } else {
        return $self->error($usage);
        }
    }
    }

    print "login:\t[after args: $cmd_prompt]\n" if $DEBUG;

    ## Override these user set-able values.
    $endtime      = _endtime($timeout);
    $orig_timeout = $self->timeout($endtime);
    $orig_errmode = $self->errmode;

    ## Create a subroutine to reset to original values.
    $reset
    = sub {
        $self->errmode($orig_errmode);
        $self->timeout($orig_timeout);
        1;
    };

    ## Create a subroutine to generate an error for user.
    $error
    = sub {
        my($errmsg) = @_;

        &$reset;
        if ($self->timed_out) {
        return $self->error($errmsg);
        } elsif ($self->eof) {
        ($lastline = $self->lastline) =~ s/\n+//;
        return $self->error($errmsg, ": ", $lastline);
        } else {
        return $self->error($self->errmsg);
        }
    };


    # Send a newline as the wakeup-call
    if ($self->send_wakeup eq 'connect') {

    $sent_wakeup = 1;

    my $old_sep = $self->output_record_separator;

    $self->output_record_separator("\n");
    $self->print('');
    $self->output_record_separator($old_sep);
    }


    while (1) {
    (undef, $_) = $self->waitfor(
        -match => '/(?:[Ll]ogin|[Uu]sername|[Pp]assw(?:or)?d)[:\s]*$/',
        -match => '/(?i:Passcode)[:\s]*$/',
        -match => $cmd_prompt,
    );

    unless ($_) {
        return &$error("read eof waiting for login or password prompt")
        if $self->eof;

        # We timed-out. Send a newline as the wakeup-call.
        if ($sent_wakeup == 0 && $self->send_wakeup eq 'timeout') {

        $sent_wakeup = 1;

        my $old_sep = $self->output_record_separator;

        $self->output_record_separator("\n");
        $self->print('');
        $self->output_record_separator($old_sep);

        next;
        }

        return &$error("timed-out during login process");
    }

    my $cmd_prompt_re = $self->_re_sans_delims($cmd_prompt);

    if (not defined) {
        return $self->error("login failed: access denied or bad name, passwd, etc");
    } elsif (/sername|ogin/) {
        $self->print($username) or return &$error("login disconnected");
        $seen{login}++ && $self->error("login failed: access denied or bad username");
    } elsif (/[Pp]assw/) {
        $self->print($password) or return &$error("login disconnected");
        $seen{passwd}++ && $self->error("login failed: access denied or bad password");
    } elsif (/(?i:Passcode)/) {
        $self->print($passcode) or return &$error("login disconnected");
        $seen{passcode}++ && $self->error("login failed: access denied or bad passcode");
    } elsif (/($cmd_prompt_re)/) {
        &$reset; # Success. Reset obj to default vals before continuing.
        last;
    } else {
        $self->error("login received unexpected prompt. Aborting.");
    }
    }

    1;
} # end sub login


# Overridden to support ignore_warnings()
sub error {
    my $self = shift;

    # Ignore warnings
    if ($self->ignore_warnings) {
    my $errmsg = join '', @_;
    my $warnings_re = $self->_re_sans_delims($self->warnings);
    return if $errmsg =~ /$warnings_re/;
    }

    return $self->SUPER::error(@_);
}


# Tries to enter enabled mode with the password arg.
sub enable {
    my $self = shift;
    my $usage = 'usage: $obj->enable([Name => $name,] [Password => $password,] '
          . '[Passcode => $passcode,] [Level => $level] )';
    my ($en_username, $en_password, $en_passcode, $en_level) = ('','','','');
    my ($error, $lastline, $orig_errmode, $reset, %args, %seen);

    if (@_ == 1) {  # just passwd given
    ($en_password) = shift;
    } else {  # named args given
    %args = @_;

    foreach (keys %args) {
        if (/^-?name$|^-?login$|^-?user/i) {
        $en_username = $args{$_};
        } elsif (/^-?passw/i) {
        $en_password = $args{$_};
        } elsif (/^-?passc/i) {
        $en_passcode = $args{$_};
        } elsif (/^-?level$/i) {
        $en_level    = $args{$_};
        } else {
        return $self->error($usage);
        }
    }
    }

    ## Create a subroutine to generate an error for user.
    $error = sub {
        my($errmsg) = @_;

        if ($self->timed_out) {
        return $self->error($errmsg);
        } elsif ($self->eof) {
        ($lastline = $self->lastline) =~ s/\n+//;
        return $self->error($errmsg, ": ", $lastline);
        } else {
        return $self->error($errmsg);
        }
    };

    # Store the old prompt without the //s around it.
    my ($old_prompt) = $self->_re_sans_delims($self->prompt);

    # We need to expect either a Password prompt or a
    # typical prompt. If the user doesn't have enough
    # access to run the 'enable' command, the device
    # won't even query for a password, it will just
    # ignore the command and display another [boring] prompt.
    $self->print("enable $en_level");

    {
    my ($prematch, $match) = $self->waitfor(
        -match => '/[Ll]ogin[:\s]*$/',
        -match => '/[Uu]sername[:\s]*$/',
        -match => '/[Pp]assw(?:or)?d[:\s]*$/',
        -match => '/(?i:Passcode)[:\s]*$/',
        -match => "/$old_prompt/",
        ) or do {
        return &$error("read eof waiting for enable login or password prompt")
            if $self->eof;
        return &$error("timed-out waiting for enable login or password prompt");
    };

    if (not defined $match) {
        return &$error("enable failed: access denied or bad name, passwd, etc");
    } elsif ($match =~ /sername|ogin/) {
        $self->print($en_username) or return &$error("enable failed");
        $seen{login}++
        && return &$error("enable failed: access denied or bad username");
        redo;
        } elsif ($match =~ /[Pp]assw/ ) {
        $self->print($en_password) or return &$error("enable failed");
        $seen{passwd}++
         && return &$error("enable failed: access denied or bad password");
        redo;
    } elsif ($match =~ /(?i:Passcode)/ ) {
        $self->print($en_passcode) or return &$error("enable failed");
        $seen{passcode}++
         && return &$error("enable failed: access denied or bad passcode");
        redo;
    } elsif ($match =~ /$old_prompt/) {
        ## Success! Exit the block.
        last;
    } else {
        return &$error("enable received unexpected prompt. Aborting.");
    }
    }

    if (($en_level eq '') or ($en_level =~ /^[1-9]/)) {
    # Prompts and levels over 1 give a #/(enable) prompt.
    return $self->is_enabled ? 1 : &$error('Failed to enter enable mode');
    } else {
    # Assume success
        return 1;
    }
}

# Leave enabled mode.
sub disable {
    my $self = shift;
    $self->cmd('disable');
    return $self->is_enabled ? $self->error('Failed to exit enabled mode') : 1;
}

sub fhopen {
    my $self = shift;
    my $stream = $ {*$self}{net_telnet_cisco};
    $self->SUPER::fhopen(@_);
    *$self->{net_telnet_cisco} = $stream;

    1;
}

# Send control-^ (without newline)
sub ios_break {
    my $self = shift;

    my $old_ors = $self->output_record_separator;
    $self->output_record_separator('');
    my $ret = $self->print("\c^");
    $self->output_record_separator($old_ors);

    return $ret;
}

# Displays the last prompt.
sub last_prompt {
    my $self = shift;
    my $stream = $ {*$self}{net_telnet_cisco};
    exists $stream->{last_prompt} ? $stream->{last_prompt} : undef;
}

# Displays the last command.
sub last_cmd {
    my $self = shift;
    my $stream = $ {*$self}{net_telnet_cisco};
    exists $stream->{last_cmd} ? $stream->{last_cmd} : undef;
}

# Examines the last prompt to determine the current mode.
# Some prompts may be hard set to #, so this won't always return a valid answer.
# Call 'show priv' instead.
# 1     => enabled.
# undef => not enabled.
sub is_enabled { $_[0]->last_prompt =~ /\#|enable|config/ ? 1 : undef }

# Typical get/set method.
sub always_waitfor_prompt {
    my ($self, $arg) = @_;
    my $stream = $ {*$self}{net_telnet_cisco};
    $stream->{always_waitfor_prompt} = $arg if defined $arg;
    return $stream->{always_waitfor_prompt};
}

# Typical get/set method.
sub waitfor_pause {
    my ($self, $arg) = @_;
    my $stream = $ {*$self}{net_telnet_cisco};
    $stream->{waitfor_pause} = $arg if defined $arg;
    return $stream->{waitfor_pause};
}

# Typical get/set method.
sub autopage {
    my ($self, $arg) = @_;
    my $stream = $ {*$self}{net_telnet_cisco};
    $stream->{autopage} = $arg if defined $arg;
    return $stream->{autopage};
}

# Typical get/set method.
sub normalize_cmd {
    my ($self, $arg) = @_;
    my $stream = $ {*$self}{net_telnet_cisco};
    $stream->{normalize_cmd} = $arg if defined $arg;
    return $stream->{normalize_cmd};
}

# Typical get/set method.
sub send_wakeup {
    my ($self, $arg) = @_;
    my $stream = $ {*$self}{net_telnet_cisco};
    $stream->{send_wakeup} = $arg if defined $arg;
    return $stream->{send_wakeup};
}

# Typical get/set method.
sub ignore_warnings {
    my ($self, $arg) = @_;
    my $stream = $ {*$self}{net_telnet_cisco};
    $stream->{ignore_warnings} = $arg if defined $arg;
    return $stream->{ignore_warnings};
}

# Get/set the More prompt
sub more_prompt {
    my ($self, $arg) = @_;
    my $stream = $ {*$self}{net_telnet_cisco};
    if (defined $arg) {
    $self->_match_check($arg);
        $stream->{more_prompt} = $arg;
    }
    return $stream->{more_prompt};
}

sub warnings {
    my ($self, $arg) = @_;
    my $stream = $ {*$self}{net_telnet_cisco};
    if (defined $arg) {
    $self->_match_check($arg);
        $stream->{warnings} = $arg;
    }
    return $stream->{warnings};
}

#------------------------------
# Private methods
#------------------------------

# Join two or more regexen into one on "|".
sub _prompt_append {
    my $self = shift;
    my $orig = shift || '';
    return $self->error("usage: \$obj->_prompt_append(orig, new, [new...])")
    unless @_;

    print "_prompt_append:\t[original: $orig]\n" if $DEBUG;

    if ($orig) {
    if ($self->_match_check($orig)) {
        $orig = $self->_re_sans_delims($orig);
        return $self->error("Can't parse prompt: '$orig'") unless $orig;
    }
    }

    for (@_) {
    print "_prompt_append:\t[append: $_]\n" if $DEBUG;
    if ($self->_match_check($_)) {
        my $re = $self->_re_sans_delims($_);

        unless ($re) {
        $self->error("Can't parse prompt: '$_'");
        next;
        }

        $orig .= $orig ? "|$re" : $re;
    }
    }

    print "_prompt_append:\t[return: /$orig/]\n\n" if $DEBUG;
    return "/$orig/";
}

# Return a Net::Telnet regular expression without the delimiters.
sub _re_sans_delims {
    my ($self, $str) = @_;

    return $self->error("usage: \$obj->_re_sans_delims(\$matchop)")
    unless $str;

    $self->_match_check($str);
    my ($delim, $re) = $str =~  /^\s*m?\s*(\W)(.*)\1\s*$/;
    return $re;
}

# strip backspaces, deletes, kills, and the character they
# pertain to, from an array.
sub _normalize {
    $_ = join "", @_;

    1 while s/[^\cH\c?][\cH\c?]//mg; # ^H ^?
    s/^.*\cU//mg;            # ^U

    return wantarray ? split /^/, $_ : $_; # ORS instead?
}

# Lifted from Net::Telnet en toto
sub _match_check {
    my ($self, $code) = @_;
    return unless $code;

    my $error;
    my @warns = ();

    print "_match_check:\t[Checking: $code]\n" if $DEBUG;

    ## Use eval to check for syntax errors or warnings.
    {
    local $SIG{'__DIE__'} = 'DEFAULT';
    local $SIG{'__WARN__'} = sub { push @warns, @_ };
    local $^W = 1;
    local $_ = '';
    eval "\$_ =~ $code;";
    }
    if ($@) {
    ## Remove useless lines numbers from message.
    ($error = $@) =~ s/ at \(eval \d+\) line \d+.?//;
    chomp $error;
    return $self->error("bad match operator: $error");
    }
    elsif (@warns) {
    ## Remove useless lines numbers from message.
    ($error = shift @warns) =~ s/ at \(eval \d+\) line \d+.?//;
    $error =~ s/ while "strict subs" in use//;
    chomp $error;
    return $self->error("bad match operator: $error");
    }

    1;
} # end sub _match_check

#------------------------------
# Class methods
#------------------------------

# Look for subroutines in Net::Telnet if we can't find them here.
sub AUTOLOAD {
    my ($self) = @_;
    croak "$self is an [unexpected] object, aborting" if ref $self;
    $AUTOLOAD =~ s/.*::/Net::Telnet::/;
    goto &$AUTOLOAD;
}

1;

__END__