Skip Menu |

This queue is for tickets about the Net-UPnP CPAN distribution.

Report information
The Basics
Id: 60372
Status: new
Priority: 0/
Queue: Net-UPnP

People
Owner: Nobody in particular
Requestors: miz999 [...] gmail.com
Cc:
AdminCc:

Bug Information
Severity: (no value)
Broken in: (no value)
Fixed in: (no value)



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