"Christmas - the time to fix the computers of your loved ones" « Lord Wyrm

[Perl] rfcomm

lama007 13.03.2009 - 20:48 1026 0
Posts

lama007

OC Addicted
Avatar
Registered: Mar 2002
Location: Austria
Posts: 851
Hi!

In einem Perlskript habe ich folgende Zeile
Code:
system( "sudo rfcomm bind 2 $bluetooth_addr $channel{'Dial-Up Networking'}" );

Mein Ziel ist es, diese Zeile mit Hilfe des Moduls Net::Bluetooth rein perlmäßig zu schreiben.
Im Modul wird von Client und Server gesprochen, das irgendwie netzwerkmäßig klingt - leider habe ich davon kaum Ahnung. Kann mir jemand sagen wie oder ob das überhaupt mit dem Modul geht?

use Net::Bluetooth;

#### list all remote devices in the area
my $device_ref = get_remote_devices();
foreach $addr (keys %$device_ref) {
print "Address: $addr Name: $device_ref->{$addr}\n";
}

#### search for a specific service (0x1101) on a remote device
my @sdp_array = sdp_search($addr, "1101", "");

#### foreach service record
foreach $rec_ref (@sdp_array) {
#### Print all available information for service
foreach $attr (keys %$rec_ref) {
print "Attribute: $attr Value: $rec_ref->{$attr}\n";
}
}

#### Create a RFCOMM client
$obj = Net::Bluetooth->newsocket("RFCOMM");
die "socket error $!\n" unless(defined($obj));
if($obj->connect($addr, $port) != 0) {
die "connect error: $!\n";
}

#### create a Perl filehandle for reading and writing
*SERVER = $obj->perlfh();
$amount = read(SERVER, $buf, 256);
close(SERVER);

#### create a RFCOMM server
$obj = Net::Bluetooth->newsocket("RFCOMM");
#### bind to port 1
if($obj->bind(1) != 0) {
die "bind error: $!\n";
}

#### listen with a backlog of 2
if($obj->listen(2) != 0) {
die "listen error: $!\n";
}

#### register a service
#### $obj must be a open and bound socket
my $service_obj = Net::Bluetooth->newservice($obj, "1101", "GPS", "GPS Receiver");
unless(defined($service_obj)) {
#### couldn't register service
}

#### accept a client connection
$client_obj = $obj->accept();
unless(defined($client_obj)) {
die "client accept failed: $!\n";
}

#### get client information
my ($caddr, $port) = $client_obj->getpeername();

#### create a Perl filehandle for reading and writing
*CLIENT = $client_obj->perlfh();
print CLIENT "stuff";

#### close client connection
close(CLIENT);
#### stop advertising service
$service_obj->stopservice();
#### close server connection
$obj->close();
Kontakt | Unser Forum | Über overclockers.at | Impressum | Datenschutz