view release on metacpan or  search on metacpan

lib/Device/CableModem/Motorola/SB4200.pm  view on Meta::CPAN

    };

    HTML::TableParser->new(
        [
            { id => 1.4, row  => $cb_row                                },
            { id => 1  , cols => qr/(?:Time|Priority|Code|Message)/xmsi },
        ],
        { Decode => 1, Trim => 1, Chomp => 1 },
    )->parse( $raw );

    return @logs;
}

sub versions {
    my $self = shift;
    my $raw  = $self->_get( $self->{page_help} );
    my $v;
    if ( $raw =~ m{<td.+?>(.+?version.+?)</td>}xmsi ) {
       ($v = $1) =~ s{<br>}{}xmsig;
    }
    else {
       croak "Can not get version from $self->{page_help} output: $raw"
    };
    my %rv;
    foreach my $vs ( split m/ \r? \n /xms, $self->_trim( $v ) ) {
        my($name, $value) = split m/ : \s+ /xms, $vs;
          ($name, undef)  = split m/   \s+ /xms, $name;
        $rv{ lc $name }   = $value;
    }
    my @soft = split m/ \- /xms, $rv{software};
    $rv{software} = {
        model   => shift @soft,
        version => shift @soft,
        string  => join( q{-}, @soft ),
    };
    return %rv;
}

sub _trim {
    my $self = shift;
    my $s = shift;
    $s =~ s{ \A \s+    }{}xmsg;
    $s =~ s{    \s+ \z }{}xmsg;
    return $s;
}

sub agent {
    my $self = shift;
    my $ua   = LWP::UserAgent->new;
    $ua->agent($AGENT);
    $ua->timeout( UA_TIMEOUT );
    return $ua;
}

sub _get {
    my $self = shift;
    my $url  = shift;
    my $r    = $self->agent->get($url);

    if ( $r->is_success ) {
        my $raw = $r->decoded_content;
        HTTP::Error::NotFound->throw(
            "The address $url is invalid. Server returned a 404 error"
        ) if $raw =~ RE_404;
        return $raw;
    }

    return  HTTP::Error::Connection->throw(
                'GET request failed: ' . $r->as_string
            );
}

sub _req {
    my $self = shift;
    my $req  = shift;
    my $r    = $self->agent->request($req);

    if ( $r->is_success ) {
        my $raw = $r->decoded_content;
        HTTP::Error::NotFound->throw(
            'The request is invalid. Server returned a 404 error'
        ) if $raw =~ RE_404;
        return $raw;
    }

    return  HTTP::Error::Connection->throw(
                'HTTP::Request failed: ' . $r->as_string
            );
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Device::CableModem::Motorola::SB4200

=head1 VERSION

version 0.14

=head1 SYNOPSIS

   use Device::CableModem::Motorola::SB4200;
   
   my $m = Device::CableModem::Motorola::SB4200->new(%opts);
   
   my %version = $m->versions;
   my %status  = $m->status;
   my %signal  = $m->signal;
   my %addr    = $m->addresses;
   my %config  = $m->config;
   my @logs    = $m->logs;
   
   $m->restart;
   $m->reset;
   
   my $fw = $version{software};
   printf "Firmware version is %s-%s\n", $fw->{version}, $fw->{string};
   die "Unknown device disguised as SB4200" if $fw->{model} ne 'SB4200';

=head1 DESCRIPTION

This module can be used to manage/fetch every setting available via the modem's
web interface. It is also possible to restart/reset the modem.

All methods will die upon failure.

=head1 NAME

Device::CableModem::Motorola::SB4200 - Interface to Motorola SurfBoard 4200 Cable Modem

=head1 GENERAL METHODS