Subject: | Net/UPnP/GW/WANPPPConnection.pm for dial up router WANPPPConnection |
I made The one corresponding to WANPPPConnection.
It is possible to use it by a usual dial-up router Upnp service
WANPPPConnection.
I made it becacuse my dial up router does not have WANIPConnection service.
WANPPPConnection uses Gateway.pm inheritance.
I think the document to be insufficient though the sample code has been
tested.
Subject: | WANPPPConnection.pm |
package Net::UPnP::GW::WANPPPConnection;
#-----------------------------------------------------------------
# Net::UPnP::GW::WANPPPConnection
#-----------------------------------------------------------------
use strict;
use warnings;
use Net::UPnP::HTTP;
use Net::UPnP::Device;
use Net::UPnP::Service;
use base qw(Net::UPnP::GW::Gateway);
#------------------------------
# new
#------------------------------
sub new {
my($class) = shift;
return bless {
_DEVICE => undef,
WANIPCONNECTION_SERVICE_TYPE => 'urn:schemas-upnp-org:service:WANPPPConnection:1'
}, $class;
}
sub GetStatusInfo {
my($this) = shift;
my $arg_list = $this->sendQuery("GetStatusInfo");
return $arg_list->{"NewUptime"};
}
# optional
sub GetUserName {
my($this) = shift;
my $arg_list = $this->sendQuery("GetUserName");
if($arg_list) {
return $arg_list->{"NewUserName"};
}
}
sub GetUpstreamMaxBitRate {
my($this) = shift;
my $arg_list = $this->sendQuery("GetLinkLayerMaxBitRates");
return $arg_list->{"NewUpstreamMaxBitRate"};
}
sub GetConnectionTypeInfo {
my($this) = shift;
my $arg_list = $this->sendQuery("GetConnectionTypeInfo");
return $arg_list->{"NewConnectionType"};
}
1;
__END__
=head1 NAME
Net::UPnP::GW::WANPPPConnection - Perl extension for UPnP.
=head1 SYNOPSIS
use Net::UPnP::ControlPoint;
use Net::UPnP::GW::WANPPPConnection;
my $obj = Net::UPnP::ControlPoint->new();
@dev_list = ();
while (@dev_list <= 0 || $retry_cnt > 5) {
# @dev_list = $obj->search(st =>'urn:schemas-upnp-org:device:InternetGatewayDevice:1', mx => 10);
@dev_list = $obj->search(st =>'upnp:rootdevice', mx => 3);
$retry_cnt++;
}
$devNum= 0;
foreach $dev (@dev_list) {
my $device_type = $dev->getdevicetype();
if ($device_type ne 'urn:schemas-upnp-org:device:InternetGatewayDevice:1') {
next;
}
print "[$devNum] : " . $dev->getfriendlyname() . "\n";
unless ($dev->getservicebyname('urn:schemas-upnp-org:service:WANPPPConnection:1')) {
next;
}
my $gwdev = Net::UPnP::GW::WANPPPConnection->new();
$gwdev->setdevice($dev);
print "\tExternalIPAddress = " . $gwdev->getexternalipaddress() . "\n";
print "\tPortMappingNumberOfEntries = " . $gwdev->getportmappingnumberofentries() . "\n";
print "\tUpstreamMaxBitRate = " . $gwdev->GetUpstreamMaxBitRate() . "\n";
print "\tConnectionType = " . $gwdev->GetConnectionTypeInfo() . "\n";
print "\tGetStatusInfo = " . $gwdev->GetStatusInfo() . "\n";
print "\tGetUserName = " . $gwdev->GetUserName() . "\n";
@port_mapping = $gwdev->getportmappingentry();
$port_num = 0;
foreach $port_entry (@port_mapping) {
if ($port_entry) {
$port_map_name = $port_entry->{'NewPortMappingDescription'};
if (length($port_map_name) <= 0) {
$port_map_name = "(No name)";
}
print " [$port_num] : $port_map_name\n";
foreach $name ( keys %{$port_entry} ) {
print " $name = $port_entry->{$name}\n";
}
}
else {
print " [$port_num] : Unknown\n";
}
$port_num++;
}
}
=head1 DESCRIPTION
The package is a extention UPnP/GW.
=head1 METHODS
=over 4
=item B<new> - create new Net::UPnP::GW::WANPPPConnection.
$mservier = Net::UPnP::GW::WANPPPConnection();
Creates a new object. Read `perldoc perlboot` if you don't understand that.
The new object is not associated with any UPnP devices. Please use setdevice() to set the device.
It is inheritance of Net::UPnP::GW::Gateway.
=item B<GetStatusInfo> - get status info.
$gw->GetStatusInfo();
Get status info.
=item B<GetUserName> - get username.
$gw->GetUserName();
Get username.
=item B<GetUpstreamMaxBitRate> - get upstream max bit rate.
$gw->GetUpstreamMaxBitRate();
Get upstream max bit rate.
=item B<GetConnectionType> - get connection type.
$gw->GetConnectionType();
Get connection type.
=item B<GetStatusInfo> - get status info.
$gw->GetStatusInfo();
Get status info.
=back
=head1 AUTHOR
MIZUNUMA Yuto
miz999@gmail.com
=head1 COPYRIGHT AND LICENSE
It may be used, redistributed, and/or modified under the terms of BSD License.
=cut