Net::UPnP::AV::Container(3pm) | User Contributed Perl Documentation | Net::UPnP::AV::Container(3pm) |
Net::UPnP::AV::Container - Perl extension for UPnP.
use Net::UPnP::ControlPoint; use Net::UPnP::AV::MediaServer; my $obj = Net::UPnP::ControlPoint->new(); @dev_list = $obj->search(st =>'upnp:rootdevice', mx => 3); $devNum= 0; foreach $dev (@dev_list) { $device_type = $dev->getdevicetype(); if ($device_type ne 'urn:schemas-upnp-org:device:MediaServer:1') { next; } print "[$devNum] : " . $dev->getfriendlyname() . "\n"; unless ($dev->getservicebyname('urn:schemas-upnp-org:service:ContentDirectory:1')) { next; } $mediaServer = Net::UPnP::AV::MediaServer->new(); $mediaServer->setdevice($dev); @content_list = $mediaServer->getcontentlist(ObjectID => 0); foreach $content (@content_list) { print_content($mediaServer, $content, 1); } $devNum++; } sub print_content { my ($mediaServer, $content, $indent) = @_; my $id = $content->getid(); my $title = $content->gettitle(); for ($n=0; $n<$indent; $n++) { print "\t"; } print "$id = $title"; if ($content->isitem()) { print " (" . $content->geturl(); if (length($content->getdate())) { print " - " . $content->getdate(); } print " - " . $content->getcontenttype() . ")"; } print "\n"; unless ($content->iscontainer()) { return; } @child_content_list = $mediaServer->getcontentlist(ObjectID => $id ); if (@child_content_list <= 0) { return; } $indent++; foreach my $child_content (@child_content_list) { print_content($mediaServer, $child_content, $indent); } }
The package is a extension UPnP/AV media server, and a sub class of Net::UPnP::AV::Content.
$isContainer = $container->iscontainer();
Check if the content is a container.
$id = $item->getid();
Get the content ID.
$title = $item->gettitle();
Get the content title.
$date = $item->getdate();
Get the content date.
Net::UPnP::AV::Content
Net::UPnP::AV::Item
Satoshi Konno skonno@cybergarage.org
CyberGarage http://www.cybergarage.org
Copyright (C) 2005 by Satoshi Konno
It may be used, redistributed, and/or modified under the terms of BSD License.
2018-12-26 | perl v5.28.1 |