view release on metacpan or  search on metacpan

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

        elsif (exists $packetinfo{base64})
        {
            $packet = Net::Telnet::Netgear::Packet->from_base64 ($packetinfo{base64});
        }
        # What if the user did not supply a packet at all? Well, that means that the user does not
        # need this module, probably. Who cares? Just do our business.
        # Parse the packet send mode, if specified.
        if (exists $packetinfo{send_mode})
        {
            _sanitize_packet_send_mode ($packetinfo{send_mode}); # Croaks if it's invalid
            $settings->{packet_send_mode} = $packetinfo{send_mode};
        }
        @_ = %args; # Magic? Nope, Perl. (hint: an hash is an unsorted array)
    }
    # If there's a single argument, then it's the hostname. Save it for later.
    elsif (@_ == 1)
    {
        $removed_keys{host} = shift;
    }
    # If there are no arguments, we are all set.
    # Create ourselves. Isn't that touching? :')
    my $self = $class->SUPER::new (@_);
    # Configure Net::Telnet::Netgear, in a Net::Telnet-esque way. (see the source of
    # "new" in Net::Telnet to understand what I'm saying)
    *$self->{net_telnet_netgear} = {
        %$settings,
        packet  => defined $packet && $packet->can ("get_packet") ? $packet->get_packet : undef,
    };
    # Set packet_delay and packet_wait_timeout
    $self->packet_delay (defined $packetinfo{delay} ? $packetinfo{delay} : .3);
    $self->packet_wait_timeout ($packetinfo{wait_timeout} || 1);
    # Restore the keys we previously removed.
    if (exists $removed_keys{fhopen})
    {
        $self->fhopen ($removed_keys{fhopen}) || return;
    }
    elsif (exists $removed_keys{host})
    {
        $self->host ($removed_keys{host});
        $self->open || return;
    }
    # We are done.
    $self;
}

sub DESTROY
{
    my $self = shift;
    # Try to send the 'exit' command before being destroyed, to avoid ghost shells.
    # (Yes, this is an issue in Netgear routers.)
    $self->cmd (string => "exit", errmode => "return") if $self->exit_on_destroy;
}

sub open
{
    my $self = shift;
    # If this method is being called from this package and it has '-callparent' as the first arg,
    # then execute the implementation of the superclass. This is a work-around, because
    # unfortunately $self->SUPER::$method does not work. :(
    return $self->SUPER::open (splice @_, 1)
        if (caller)[0] eq __PACKAGE__ && @_ > 0 && $_[0] eq -callparent;
    # Call our magical method.
    _open_method ($self, "open", @_);
}

sub fhopen
{
    my $self = shift;
    # If this method is being called from this package and it has '-callparent' as the first arg,
    # then execute the implementation of the superclass. This is a work-around, because
    # unfortunately $self->SUPER::$method does not work. :(
    return $self->SUPER::fhopen (splice @_, 1)
        if (caller)[0] eq __PACKAGE__ && @_ > 0 && $_[0] eq -callparent;
    # Call our magical method.
    _open_method ($self, "fhopen", @_);
}

sub apply_netgear_defaults
{
    my $self = shift;
    # Prefer user-provided settings, if available.
    local %NETGEAR_DEFAULTS = (%NETGEAR_DEFAULTS, @_) if @_ > 1;
    foreach my $k (keys %NETGEAR_DEFAULTS)
    {
        $self->$k ($NETGEAR_DEFAULTS{$k}) if defined $NETGEAR_DEFAULTS{$k} and $self->can ($k);
    }
}

# Getters/setters.
sub exit_on_destroy
{
    _mutator (shift, name => "exit_on_destroy", new => shift, sanitizer => sub { !!$_ });
}

sub packet_delay
{
    _mutator (shift, name => "delay", new => shift, sanitizer => sub {
        _sanitize_numeric_val ("packet_delay")
    });
}

sub packet_send_mode
{
    _mutator (shift, name => "packet_send_mode", new => shift,
        sanitizer => \&_sanitize_packet_send_mode);
}

sub packet_wait_timeout
{
    _mutator (shift, name => "timeout", new => shift, sanitizer => sub {
        _sanitize_numeric_val ("packet_wait_timeout")
    });
}

sub packet
{
    _mutator (shift, name => "packet", new => shift);
}

# Internal methods.
# Handles getters and setters. Code partially taken from Net::Telnet.
# %conf = (
#     name        => "xxx", # The name of the mutator
#     new         => "yyy", # The new value. (may be undef)
#     sanitizer   => CODE   # A subroutine which returns a sanitized value of 'new'.
# )
sub _mutator
{
    my ($self, %conf) = @_;
    my $s    = *$self->{net_telnet_netgear};
    my $prev = $s->{$conf{name}};
    if (exists $conf{new} && defined $conf{new})
    {