File Coverage

blib/lib/Device/Audiotron.pm

Criterion	Covered	Total	%
statement	31	110	28.1
branch	1	30	3.3
condition	0	3	0.0
subroutine	7	14	50.0
pod	0	9	0.0
total	39	166	23.4

package Device::Audiotron;

require 5.6.0;
require Exporter;
our @ISA = qw(Exporter);

$VERSION = '1.02';

use strict;
use Carp;
use vars qw($VERSION @ISA);
use LWP 5.64 qw(UserAgent);


#Copyright (c) 2002 Dave Crawford. All rights reserved.
#This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

sub new
	{
	my $class = shift;
	my $self = {};
	($self->{ip},$self->{user},$self->{pass}) = @_;
	bless $self,$class;
	return($self);
	}

sub GetInfo
	{
        my ($self,$type, $count, $criteria) = @_;
        my ($url, $fetched, @array);

        $url = "http://$self->{ip}/apigetinfo.asp?type=$type";
        if($count){$url .= "&count=$count";}
        if($criteria){$url .= "&this=" . $criteria;}

	$fetched = $self->_FetchURL($url);
	return($fetched);
        }

sub Qfile
	{
        my ($self, $type, $criteria) = @_;
        my ($url, $fetched);

        $url = "http://$self->{ip}/apiqfile.asp?type=$type&file=$criteria";

	$fetched = $self->_FetchURL($url);
	return($fetched);
	}

sub AddFile
	{
	my ($self, $file) = @_;
        my ($url, $fetched);

	$url = "http://$self->{ip}/apiaddfile.asp?type=file&file=$file";

	$fetched = $self->_FetchURL($url);
	return($fetched);
	}

sub Cmd
	{
	my ($self, $cmd, $arg) = @_;
        my ($url, $fetched);

	$url = "http://$self->{ip}/apicmd.asp?cmd=$cmd";
	if($arg){$url .= "&arg=$arg";}

	$fetched = $self->_FetchURL($url);
	return($fetched);
	}

sub GetStatus
        {
        my $self = shift;
        my ($url, $fetched, $h_name, $h_value, %status);

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

	$fetched = $self->_FetchURL($url);
	my @array = split /\n/,$fetched;
	foreach(@array)
		{
		if((/^\[(End )?Status\]/) || !(/=/)){next;}
		chomp();
		($h_name, $h_value) = split(/\s*=\s*/,$_,2);
		$status{$h_name} = $h_value;
		}
	return(%status);
        }

sub GlobalInfo
        {
        my $self = shift;
        my ($url, $fetched, $h_name, $h_value, %tmp_hst, %status, @shares, @hosts);
        my ($hst_cnt, $shr_flag, $hst_flag) = 0;

        $url = "http://$self->{ip}/apigetinfo.asp?type=global";

	$fetched = $self->_FetchURL($url);

	my @array = split /\n/,$fetched;
	foreach(@array)
		{
		if(/^\[(End )?Global\]/){next;}
		if(/^\[Share List\]/){$shr_flag=1;next;}
		if(/^\[End Share List\]/){$shr_flag=0;next;}
		if(/^\[Host List\]/){$hst_flag=1;next;}
		if(/^\[End Host List\]/){$hst_flag=0;next;}
		if(/^\[End Host\]/){push(@hosts,{%tmp_hst});next;}
		if(!(/=/)){next;}

		chomp();

		($h_name, $h_value) = split(/\s*=\s*/,$_,2);

		if($shr_flag)
			{
			push(@shares, $h_value);
			}
		elsif($hst_flag)
			{
			$tmp_hst{$h_name} = $h_value;
			}
		else
			{
			$status{$h_name} = $h_value;
			}
		}
	return(\%status, \@shares, \@hosts);
        }

sub Msg
	{
	my ($self, $line1, $line2, $tmout) = @_;
        my ($url, $fetched);

	$url = "http://$self->{ip}/apimsg.asp?line1=$line1&line2=$line2";
	if($tmout){$url .= "&timeout=$tmout";}


	$fetched = $self->_FetchURL($url);
	return($fetched);
	}

sub DumpToc
	{
	my ($self, $share) = @_;
        my ($url, $fetched);

	$url = "http://$self->{ip}/apidumptoc.asp?share=$share";

	$fetched = $self->_FetchURL($url);
	return($fetched);
	}



## internal "helper" routines ##

sub _FetchURL
	{
	my ($self, $url) = @_;
	my ($ua, $request, $response);

        $ua = LWP::UserAgent->new();
        $ua->agent("Device::Audiotron 1.01");
        $request = HTTP::Request->new('GET', $url);
        $request->authorization_basic($self->{user}, $self->{pass});

        $response = $ua->request($request);

        if($response->is_success)
                {
		return($response->content());
		}
        else
                {
                croak("[HTTP " .  $response->code() . " Error] ");
                }
	}

1;

__END__