Ticket #10589: y.sh

use Net::UPnP::ControlPoint;
use Net::UPnP::Device;
use URI::URL;
require LWP::UserAgent;
require XML::LibXML;

    my $obj = Net::UPnP::ControlPoint->new();

    @dev_list = $obj->search(st =>'upnp:rootdevice', mx => 3);

    $devNum= 0;
    foreach $dev (@dev_list) {
        print "\n### Device ###";
        $device_type = $dev->getdevicetype();
        print "\n $device_type\n\n ";
   #     if  ($device_type ne 'urn:schemas-upnp-org:device:MediaServer:1') {
   #         next;
   #     }
        print "[$devNum] : " . $dev->getfriendlyname() . "\n";
        print "\n Manufactor ".$dev->getmanufacturer();
        print "\n manufacturer_url ".$dev->getmanufacturerurl();
        print "\n model_description ".$dev->getmodeldescription();
        print "\n model_name ".$dev->getmodelname();
        print "\n model_number ".$dev->getmodelnumber();
        print "\n model_url ".$dev->getmodelurl();
        print "\n serialnumber ".$dev->getserialnumber();
        print "\n udn ".$dev->getudn();
        print "\n upc ".$dev->getupc();

        my $url = URI->new( $dev->getlocation() );
        print "\n service_list ".$dev->getservicelist();
        @service_list =$dev->getservicelist();  

        print "\n##############################\n";

        foreach my $service (@service_list) {
          $serviceID=$service->getserviceid();
          $servDesc=$service->getdevicedescription(name=>'SCPDURL' );
#         print "\n ID=".$serviceID."\nDesc ".$servDesc." type ".$service->getservicetype()."\n";
        
#       $url->path( $servDesc );

        my $ua = LWP::UserAgent->new;
        $ua->timeout(10);
        $ua->env_proxy;

        my $response = $ua->get($url);

        if ($response->is_success) {
                print "\n ####################";
                print $response->decoded_content;
                print "\n #####################";
                my $parser = XML::LibXML->new();
 
                my $doc = $parser->parse_string( $response->decoded_content );
                my $root = $doc->firstChild();
 
                my $xpc = XML::LibXML::XPathContext->new( $root );
                $xpc->registerNs('x', 'urn:schemas-upnp-org:service-1-0');
                my @xactions = $xpc->findnodes('//x:actionList/x:action/x:name' );
                foreach my $action (@xactions) {
                @result=(@result, $action->textContent());
                }

        print "\n UPNP decode";
        foreach my $action ( @actions ) {
        $_ = $action;
        print "\nActions =".$actions;

      # post all 'Get' actions
      if ( /^Get/ ) {
        my %action_in_arg = ();
        my $action_res = $service->postaction( $action, \%action_in_arg);
        if ($action_res->getstatuscode() == 200) {
          my $arg_ref = $action_res->getargumentlist();
          my %args = %$arg_ref;
          foreach my $k ( keys %args ) {
            print "" . $serviceID . "::" . $action . ":" . $k . " = " . $args{$k} . "\n";
          }
        }
      }
    }



      }


else {
     die $response->status_line;
 }


        }



    }