Ticket #8094: perl.localhost.patch

File perl.localhost.patch, 6.7 KB (added by rhpot1991@…, 14 years ago)

patch for perl bindings

  • bindings/perl/MythTV.pm

    Description: Try to fetch database info from localhost first.
    If the backend is bound to localhost, UPnP won't be activated, so this is
    an alternative way to discover the backend connectivity information.
    	
    Origin: John Baab <rhpot1991@ubuntu.com>
    Bug: http://svn.mythtv.org/trac/ticket/8094
    Bug-Ubuntu: http://bugs.debian.org/<bugnumber>
    Last-Update: 2010-02-20
    
    old new package MythTV; 
    165165        unless (-d $conf) {
    166166            mkdir $conf or die "Can't create config directory $conf:  $!\n";
    167167        }
    168     # @todo:  prompt for a security pin
    169         my $pin = '';
    170     # Try to detect things via upnp
    171         my (%seen, @devices);
    172         my $obj = Net::UPnP::ControlPoint->new();
    173         my @dev_list = $obj->search(
    174             st => 'urn:schemas-mythtv-org:device:MasterMediaServer:1',
    175             mx => 2
    176             );
    177         foreach $dev (@dev_list) {
    178             $device_type = $dev->getdevicetype();
    179             if  ($device_type ne 'urn:schemas-upnp-org:device:MediaServer:1') {
    180                 next;
    181             }
    182         # Skip non-mythtv
    183             my $mfg = $dev->getdescription(name=>'manufacturer');
    184             next unless ($mfg eq 'MythTV');
    185         # Skip duplicate scan entries
    186             my $urlbase = $dev->getdescription(name=>'URLBase');
    187             my $hash = join(';',
    188                 $dev->getudn(),
    189                 $urlbase,
    190                 );
    191             next if ($seen{$hash});
    192             $seen{$hash} = 1;
    193         # Try to connect to the host to get
    194             my $req = HTTP::Request->new('GET', "${urlbase}Myth/GetConnectionInfo?Pin=$pin");
    195             my $ua  = LWP::UserAgent->new(keep_alive => 1);
    196             my $response = $ua->request($req);
    197         # Return the results
    198             next unless ($response->is_success);
    199             next unless ($response->content =~ m#<Database>(.+?)</Database>#s);
    200             my $info = $1;
    201             ($dev->{db_host}) = ($info =~ m#<Host>(.+?)</Host>#);
    202             ($dev->{db_port}) = ($info =~ m#<Port>(\d*?)</Port>#);
    203             ($dev->{db_user}) = ($info =~ m#<UserName>(.+?)</UserName>#);
    204             ($dev->{db_pass}) = ($info =~ m#<Password>(.+?)</Password>#);
    205             ($dev->{db_name}) = ($info =~ m#<Name>(.+?)</Name>#);
    206             $dev->{db_port} ||= 3306;
    207         # Skip duplicate db connections, too
    208             $hash = "mysql:$dev->{db_user}:$dev->{db_pass}\@$dev->{db_host}:$dev->{db_port}::$dev->{db_name}";
    209             next if ($seen{$hash});
    210             $seen{$hash} = 1;
    211         # Add some more data to the device, while we're here
    212             $dev->{udn} = $dev->getudn();
    213             $dev->{usn} = join('::',
    214                 $dev->{udn},
    215                 $dev->getdevicetype(),
    216                 );
    217         # Success
    218             push @devices, $dev;
     168
     169    # Prompt for a security pin
     170        print "Please enter your sercurity pin, if you did not set one then leave blank:\n" if (-t STDIN);
     171        chop(my $pin = <STDIN>);
     172        my (%seen, @devices, $dev, $hash);
     173
     174        # Try to connect to localhost first
     175        my $req = HTTP::Request->new('GET', "http://127.0.0.1:6544/Myth/GetConnectionInfo?Pin=$pin");
     176        my $ua  = LWP::UserAgent->new(keep_alive => 1);
     177        my $response = $ua->request($req);
     178    # Return the results
     179        if($response->is_success){
     180            if($response->content =~ m#<Database>(.+?)</Database>#s){
     181                my $info = $1;
     182                ($dev->{db_host}) = ($info =~ m#<Host>(.+?)</Host>#);
     183                ($dev->{db_port}) = ($info =~ m#<Port>(\d*?)</Port>#);
     184                ($dev->{db_user}) = ($info =~ m#<UserName>(.+?)</UserName>#);
     185                ($dev->{db_pass}) = ($info =~ m#<Password>(.+?)</Password>#);
     186                ($dev->{db_name}) = ($info =~ m#<Name>(.+?)</Name>#);
     187                $dev->{db_port} ||= 3306;
     188            # Skip duplicate db connections, too
     189                $hash = "mysql:$dev->{db_user}:$dev->{db_pass}\@$dev->{db_host}:$dev->{db_port}::$dev->{db_name}";
     190                $seen{$hash} = 1;
     191            # Success
     192                push @devices, $dev;
     193            }
    219194        }
     195
     196    # Try to detect things via upnp if localhost didn't work
     197        if(@devices == 0){ 
     198            my $obj = Net::UPnP::ControlPoint->new();
     199            my @dev_list = $obj->search(
     200                st => 'urn:schemas-mythtv-org:device:MasterMediaServer:1',
     201                mx => 2
     202                );
     203            foreach $dev (@dev_list) {
     204                $device_type = $dev->getdevicetype();
     205                if  ($device_type ne 'urn:schemas-upnp-org:device:MediaServer:1') {
     206                    next;
     207                }
     208            # Skip non-mythtv
     209                my $mfg = $dev->getdescription(name=>'manufacturer');
     210                next unless ($mfg eq 'MythTV');
     211            # Skip duplicate scan entries
     212                my $urlbase = $dev->getdescription(name=>'URLBase');
     213                my $hash = join(';',
     214                    $dev->getudn(),
     215                    $urlbase,
     216                    );
     217                next if ($seen{$hash});
     218                $seen{$hash} = 1;
     219            # Try to connect to the host to get
     220                $req = HTTP::Request->new('GET', "${urlbase}Myth/GetConnectionInfo?Pin=$pin");
     221                $ua  = LWP::UserAgent->new(keep_alive => 1);
     222                $response = $ua->request($req);
     223            # Return the results
     224                next unless ($response->is_success);
     225                next unless ($response->content =~ m#<Database>(.+?)</Database>#s);
     226                my $info = $1;
     227                ($dev->{db_host}) = ($info =~ m#<Host>(.+?)</Host>#);
     228                ($dev->{db_port}) = ($info =~ m#<Port>(\d*?)</Port>#);
     229                ($dev->{db_user}) = ($info =~ m#<UserName>(.+?)</UserName>#);
     230                ($dev->{db_pass}) = ($info =~ m#<Password>(.+?)</Password>#);
     231                ($dev->{db_name}) = ($info =~ m#<Name>(.+?)</Name>#);
     232                $dev->{db_port} ||= 3306;
     233            # Skip duplicate db connections, too
     234                $hash = "mysql:$dev->{db_user}:$dev->{db_pass}\@$dev->{db_host}:$dev->{db_port}::$dev->{db_name}";
     235                next if ($seen{$hash});
     236                $seen{$hash} = 1;
     237            # Add some more data to the device, while we're here
     238                $dev->{udn} = $dev->getudn();
     239                $dev->{usn} = join('::',
     240                    $dev->{udn},
     241                    $dev->getdevicetype(),
     242                    );
     243            # Success
     244                push @devices, $dev;
     245            }
     246            }
     247
    220248        if (@devices < 1) {
    221249            die "No backends found.  Please copy config.xml from a "
    222250               ."working MythTV installation to $conf.\n";