view release on metacpan or  search on metacpan

lib/Buffalo/G54.pm  view on Meta::CPAN

        LOGDIE "Unauthorized" if $resp->code() == 401;
    }

    LOGDIE "Out of retries for ", $url;
}

###########################################
package Buffalo::G54;
###########################################
use strict;
use warnings;
use Log::Log4perl qw(:easy);

our $VERSION = "0.03";

###########################################
sub new {
###########################################
    my($class) = @_;

    my $self = { 
        defaults    => { user => "root",
                         ip   => "192.168.0.1",
                       },
        realm       => "BUFFALO WBR2-G54",
        nof_retries => 5,
        sleep_between_retries => 2,
    };

    bless $self, $class;
}

###########################################
sub connect {
###########################################
    my($self, %options) = @_;

    if($ENV{BUFFALO}) {
          # For regression tests only
        my ($ip, $user, $password) = split /:/, $ENV{BUFFALO};
        $self->{ip}       = $ip;
        $self->{user}     = $user;
        $self->{password} = $password;
    } else {
        for(qw(user ip)) {
            $self->{$_} = def_or($options{$_}, 
                                 $self->{$_},
                                 $self->{defaults}->{$_}
                                );
        }
        $self->{password} = def_or($options{password}, 
                                   $self->{password},
                                   ""
                                  );
    }

    $self->{agent} = WWW::Mechanize::Retry->new(
        map { $_ => $self->{$_} } qw(nof_retries sleep_between_retries)
    );

    DEBUG "Setting credentials for $self->{ip}:80 $self->{user} $self->{realm}";

    $self->{agent}->credentials(
        "$self->{ip}:80", 
        $self->{realm},
        $self->{user},
        $self->{password}
    );

    $self->{url} = "http://$self->{ip}";

    $self->geturl("/");
}

###########################################
sub geturl {
###########################################
    my($self, $relurl) = @_;

    my $resp = $self->{agent}->get($self->{url} . $relurl);
    LOGDIE "Failed for fetch $relurl" if $resp->is_error();
    my $content = $resp->content();
    return $content;
}

###########################################
sub version {
###########################################
    my($self) = @_;

    my $content = $self->geturl("/advance/ad-admin-system.htm");
    if($content =~ /WBR2-G54 Ver.([0-9.]+)/) {
        DEBUG "Found Buffalo Version $1";
        return $1;
    }

    ERROR "Version not found ($content)";
    return undef;
}

###########################################
sub def_or {
###########################################
    my($def, @alts) = @_;

      # Still waiting for //= ...

    for my $alt ($def, @alts) {
        if(defined $alt) {
            return $alt;
        }
    }
    
    return undef;
}

###########################################
sub wireless {
###########################################
    my($self, $action) = @_;

    if(!defined $action) {
        return $self->is_wireless_on();