home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / lib / perl5 / Net / DBus.pm
Encoding:
Perl POD Document  |  2006-06-03  |  17.4 KB  |  760 lines
  1. # -*- perl -*-
  2. #
  3. # Copyright (C) 2004-2005 Daniel P. Berrange
  4. #
  5. # This program is free software; you can redistribute it and/or modify
  6. # it under the terms of the GNU General Public License as published by
  7. # the Free Software Foundation; either version 2 of the License, or
  8. # (at your option) any later version.
  9. #
  10. # This program is distributed in the hope that it will be useful,
  11. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13. # GNU General Public License for more details.
  14. #
  15. # You should have received a copy of the GNU General Public License
  16. # along with this program; if not, write to the Free Software
  17. # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  18. #
  19. # $Id: DBus.pm,v 1.24 2006/01/27 15:34:22 dan Exp $
  20.  
  21. =pod
  22.  
  23. =head1 NAME
  24.  
  25. Net::DBus - Perl extension for the DBus message system
  26.  
  27. =head1 SYNOPSIS
  28.  
  29.  
  30.   ####### Attaching to the bus ###########
  31.  
  32.   use Net::DBus;
  33.  
  34.   # Find the most appropriate bus
  35.   my $bus = Net::DBus->find;
  36.  
  37.   # ... or explicitly go for the session bus
  38.   my $bus = Net::DBus->session;
  39.  
  40.   # .... or explicitly go for the system bus
  41.   my $bus = Net::DBus->system
  42.  
  43.  
  44.   ######## Accessing remote services #########
  45.  
  46.   # Get a handle to the HAL service
  47.   my $hal = $bus->get_service("org.freedesktop.Hal");
  48.  
  49.   # Get the device manager
  50.   my $manager = $hal->get_object("/org/freedesktop/Hal/Manager", 
  51.                                  "org.freedesktop.Hal.Manager");
  52.  
  53.   # List devices
  54.   foreach my $dev (@{$manager->GetAllDevices}) {
  55.       print $dev, "\n";
  56.   }
  57.  
  58.  
  59.   ######### Providing services ##############
  60.  
  61.   # Register a service known as 'org.example.Jukebox'
  62.   my $service = $bus->export_service("org.example.Jukebox");
  63.  
  64.  
  65. =head1 DESCRIPTION
  66.  
  67. Net::DBus provides a Perl API for the DBus message system.
  68. The DBus Perl interface is currently operating against
  69. the 0.32 development version of DBus, but should work with
  70. later versions too, providing the API changes have not been
  71. too drastic. 
  72.  
  73. Users of this package are either typically, service providers
  74. in which case the L<Net::DBus::Service> and L<Net::DBus::Object>
  75. modules are of most relevance, or are client consumers, in which
  76. case L<Net::DBus::RemoteService> and L<Net::DBus::RemoteObject>
  77. are of most relevance.
  78.  
  79. =head1 METHODS
  80.  
  81. =over 4
  82.  
  83. =cut
  84.  
  85. package Net::DBus;
  86.  
  87. use 5.006;
  88. use strict;
  89. use warnings;
  90. use Carp;
  91.  
  92.  
  93.  
  94. BEGIN {
  95.     our $VERSION = '0.33.2';
  96.     require XSLoader;
  97.     XSLoader::load('Net::DBus', $VERSION);
  98. }
  99.  
  100. use Net::DBus::Binding::Bus;
  101. use Net::DBus::Service;
  102. use Net::DBus::RemoteService;
  103. use Net::DBus::Test::MockConnection;
  104. use Net::DBus::Binding::Value;
  105.  
  106. use vars qw($bus_system $bus_session);
  107.  
  108. use Exporter qw(import);
  109.  
  110. use vars qw(@EXPORT_OK %EXPORT_TAGS);
  111.  
  112. @EXPORT_OK = qw(dbus_int16 dbus_uint16 dbus_int32 dbus_uint32 dbus_int64 dbus_uint64 
  113.         dbus_byte dbus_boolean dbus_string dbus_double
  114.                 dbus_object_path dbus_signature
  115.         dbus_struct dbus_array dbus_dict dbus_variant);
  116.  
  117. %EXPORT_TAGS = (typing => [qw(dbus_int16 dbus_uint16 dbus_int32 dbus_uint32 dbus_int64 dbus_uint64 
  118.                   dbus_byte dbus_boolean dbus_string dbus_double
  119.                               dbus_object_path dbus_signature
  120.                   dbus_struct dbus_array dbus_dict dbus_variant)]);
  121.  
  122. =item my $bus = Net::DBus->find(%params);
  123.  
  124. Search for the most appropriate bus to connect to and 
  125. return a connection to it. The heuristic used for the
  126. search is
  127.  
  128.   - If DBUS_STARTER_BUS_TYPE is set to 'session' attach
  129.     to the session bus
  130.  
  131.   - Else If DBUS_STARTER_BUS_TYPE is set to 'system' attach
  132.     to the system bus
  133.  
  134.   - Else If DBUS_SESSION_BUS_ADDRESS is set attach to the
  135.     session bus
  136.  
  137.   - Else attach to the system bus
  138.  
  139. The optional C<params> hash can contain be used to specify
  140. connection options. The only support option at this time
  141. is C<nomainloop> which prevents the bus from being automatically
  142. attached to the main L<Net::DBus::Reactor> event loop.
  143.  
  144. =cut
  145.  
  146. sub find {
  147.     my $class = shift;
  148.     
  149.     if ($ENV{DBUS_STARTER_BUS_TYPE} &&
  150.     $ENV{DBUS_STARTER_BUS_TYPE} eq "session") {
  151.     return $class->session(@_);
  152.     } elsif ($ENV{DBUS_STARTER_BUS_TYPE} &&
  153.          $ENV{DBUS_STARTER_BUS_TYPE} eq "system") {
  154.     return $class->system(@_);
  155.     } elsif (exists $ENV{DBUS_SESSION_BUS_ADDRESS}) {
  156.     return $class->session(@_);
  157.     } else {
  158.     return $class->system;
  159.     }
  160. }
  161.  
  162. =item my $bus = Net::DBus->system(%params);
  163.  
  164. Return a handle for the system message bus. Note that the
  165. system message bus is locked down by default, so unless appropriate
  166. access control rules are added in /etc/dbus/system.d/, an application
  167. may access services, but won't be able to export services.
  168. The optional C<params> hash can contain be used to specify
  169. connection options. The only support option at this time
  170. is C<nomainloop> which prevents the bus from being automatically
  171. attached to the main L<Net::DBus::Reactor> event loop.
  172.  
  173. =cut
  174.  
  175. sub system {
  176.     my $class = shift;
  177.     unless ($bus_system) {
  178.     $bus_system = $class->_new(Net::DBus::Binding::Bus->new(type => &Net::DBus::Binding::Bus::SYSTEM), @_);
  179.     }
  180.     return $bus_system
  181. }
  182.  
  183. =item my $bus = Net::DBus->session(%params);
  184.  
  185. Return a handle for the session message bus. 
  186. The optional C<params> hash can contain be used to specify
  187. connection options. The only support option at this time
  188. is C<nomainloop> which prevents the bus from being automatically
  189. attached to the main L<Net::DBus::Reactor> event loop.
  190.  
  191. =cut
  192.  
  193. sub session {
  194.     my $class = shift;
  195.     unless ($bus_session) {
  196.     $bus_session = $class->_new(Net::DBus::Binding::Bus->new(type => &Net::DBus::Binding::Bus::SESSION), @_);
  197.     }
  198.     return $bus_session;
  199. }
  200.  
  201.  
  202. =item my $bus = Net::DBus->test(%params);
  203.  
  204. Returns a handle for a virtual bus for use in unit tests. This bus does 
  205. not make any network connections, but rather has an in-memory message
  206. pipeline. Consult L<Net::DBus::Test::MockConnection> for further details 
  207. of how to use this special bus.
  208.  
  209. =cut
  210.  
  211. # NB. explicitly do *NOT* cache, since unit tests
  212. # should always have pristine state
  213. sub test {
  214.     my $class = shift;
  215.     return $class->_new(Net::DBus::Test::MockConnection->new());
  216. }
  217.  
  218. =item my $bus = Net::DBus->new($address, %params);
  219.  
  220. Return a connection to a specific message bus.  The C<$address>
  221. parameter must contain the address of the message bus to connect
  222. to. An example address for a session bus might look like 
  223. C<unix:abstract=/tmp/dbus-PBFyyuUiVb,guid=191e0a43c3efc222e0818be556d67500>,
  224. while one for a system bus would look like C<unix:/var/run/dbus/system_bus_socket>.
  225. The optional C<params> hash can contain be used to specify
  226. connection options. The only support option at this time
  227. is C<nomainloop> which prevents the bus from being automatically
  228. attached to the main L<Net::DBus::Reactor> event loop.
  229.  
  230. =cut
  231.  
  232. sub new {
  233.     my $class = shift;
  234.     my $nomainloop = shift;
  235.     return $class->_new(Net::DBus::Binding::Bus->new(address => shift), @_);
  236. }
  237.  
  238. sub _new {
  239.     my $class = shift;
  240.     my $self = {};
  241.     
  242.     $self->{connection} = shift;
  243.     $self->{signals} = [];
  244.     $self->{services} = {};
  245.     
  246.     my %params = @_;
  247.     
  248.     bless $self, $class;
  249.  
  250.     unless ($params{nomainloop}) {
  251.     if (exists $INC{'Net/DBus/Reactor.pm'}) {
  252.         my $reactor = Net::DBus::Reactor->main;
  253.         $reactor->manage($self->get_connection);
  254.     }
  255.     # ... Add support for GLib and POE
  256.     }
  257.     
  258.     $self->get_connection->add_filter(sub { $self->_signal_func(@_) });
  259.  
  260.     # XXX is it ok to fix '1:0' as the owner of this ?
  261.     $self->{bus} = Net::DBus::RemoteService->new($self, ":1.0", "org.freedesktop.DBus");
  262.     
  263.     return $self;
  264. }
  265.  
  266. =item my $connection = $bus->get_connection;
  267.  
  268. Return a handle to the underlying, low level connection object
  269. associated with this bus. The returned object will be an instance
  270. of the L<Net::DBus::Binding::Bus> class. This method is not intended
  271. for use by (most!) application developers, so if you don't understand
  272. what this is for, then you don't need to be calling it!
  273.  
  274. =cut
  275.  
  276. sub get_connection {
  277.     my $self = shift;
  278.     return $self->{connection};
  279. }
  280.  
  281. =item my $service = $bus->get_service($name);
  282.  
  283. Retrieves a handle for the remote service identified by the
  284. service name C<$name>. The returned object will be an instance
  285. of the L<Net::DBus::RemoteService> class.
  286.  
  287. =cut
  288.  
  289. sub get_service {
  290.     my $self = shift;
  291.     my $name = shift;
  292.     
  293.     if ($name eq "org.freedesktop.DBus") {
  294.     return $self->{bus};
  295.     }
  296.  
  297.     my $owner = $name;
  298.     if ($owner !~ /^:/) {
  299.     $owner = $self->get_service_owner($name);
  300.     if (!$owner) {
  301.         $self->get_bus_object->StartServiceByName($name, 0);
  302.         $owner = $self->get_service_owner($name);
  303.     }
  304.     }
  305.  
  306.     unless (exists $self->{services}->{$owner}) {
  307.     $self->{services}->{$owner} = Net::DBus::RemoteService->new($self, $owner, $name);
  308.     }
  309.     return $self->{services}->{$owner};
  310. }
  311.  
  312. =item my $service = $bus->export_service($name);
  313.  
  314. Registers a service with the bus, returning a handle to
  315. the service. The returned object is an instance of the
  316. L<Net::DBus::Service> class.
  317.  
  318. =cut
  319.  
  320. sub export_service {
  321.     my $self = shift;
  322.     my $name = shift;
  323.     return Net::DBus::Service->new($self, $name);
  324. }
  325.  
  326. =item my $object = $bus->get_bus_object;
  327.  
  328. Retrieves a handle to the bus object, C</org/freedesktop/DBus>,
  329. provided by the service C<org.freedesktop.DBus>. The returned
  330. object is an instance of L<Net::DBus::RemoteObject>
  331.  
  332. =cut
  333.  
  334. sub get_bus_object {
  335.     my $self = shift;
  336.     
  337.     my $service = $self->get_service("org.freedesktop.DBus");
  338.     return $service->get_object('/org/freedesktop/DBus',
  339.                 'org.freedesktop.DBus');
  340. }
  341.  
  342.  
  343. =item my $name = $bus->get_unique_name;
  344.  
  345. Retrieves the unique name of this client's connection to
  346. the bus.
  347.  
  348. =cut
  349.  
  350. sub get_unique_name {
  351.     my $self = shift;
  352.     
  353.     return $self->get_connection->get_unique_name
  354. }
  355.  
  356. =item my $name = $bus->get_service_owner($service);
  357.  
  358. Retrieves the unique name of the client on the bus owning
  359. the service named by the C<$service> parameter.
  360.  
  361. =cut
  362.  
  363. sub get_service_owner {
  364.     my $self = shift;
  365.     my $service = shift;
  366.  
  367.     my $bus = $self->get_bus_object;
  368.     my $owner = eval {
  369.     $bus->GetNameOwner($service);
  370.     };
  371.     if ($@) {
  372.     if (UNIVERSAL::isa($@, "Net::DBus::Error") &&
  373.         $@->{name} eq "org.freedesktop.DBus.Error.NameHasNoOwner") {
  374.         $owner = undef;
  375.     } else {
  376.         die $@;
  377.     }
  378.     }
  379.     return $owner;
  380. }
  381.  
  382.  
  383. sub _add_signal_receiver {
  384.     my $self = shift;
  385.     my $receiver = shift;
  386.     my $signal_name = shift;
  387.     my $interface = shift;
  388.     my $service = shift;
  389.     my $path = shift;
  390.  
  391.     my $rule = $self->_match_rule($signal_name, $interface, $service, $path);
  392.  
  393.     push @{$self->{signals}}, [$receiver, $rule, $signal_name, $interface, $service, $path];    
  394.     $self->{connection}->add_match($rule);
  395. }
  396.  
  397. sub _remove_signal_receiver {
  398.     my $self = shift;
  399.     my $receiver = shift;
  400.     my $signal_name = shift;
  401.     my $interface = shift;
  402.     my $service = shift;
  403.     my $path = shift;
  404.     
  405.     my $rule = $self->_match_rule($signal_name, $interface, $service, $path);
  406.  
  407.     my @signals;
  408.     foreach (@{$self->{signals}}) {
  409.     if ($_->[0] eq $receiver &&
  410.         defined $_->[1] &&
  411.         $_->[1] eq $rule) {
  412.         $self->{connection}->remove_match($rule);
  413.     } else {
  414.         push @signals, $_;
  415.     }
  416.     }
  417.     $self->{signals} = \@signals;
  418. }
  419.  
  420.  
  421. sub _match_rule {
  422.     my $self = shift;
  423.     my $signal_name = shift;
  424.     my $interface = shift;
  425.     my $service = shift;
  426.     my $path = shift;
  427.  
  428.     my $rule = "type='signal'";
  429.     if ($interface) {
  430.     $rule .= ",interface='$interface'";
  431.     }
  432.     if ($service) {
  433.     if ($service !~ /^:/) {
  434.         # Resolve service name to a client id
  435.         $service = $self->get_service_owner($service);
  436.     }
  437.     if ($service) {
  438.         $rule .= ",sender='$service'";
  439.     }
  440.     }
  441.     if ($path) {
  442.     $rule .= ",path='$path'";
  443.     }
  444.     if ($signal_name) {
  445.     $rule .= ",member='$signal_name'";
  446.     }
  447.     return $rule;
  448. }
  449.  
  450.  
  451. sub _rule_matches {
  452.     my $self = shift;
  453.     my $rule = shift;
  454.     my $member = shift;
  455.     my $interface = shift;
  456.     my $sender = shift;
  457.     my $path = shift;
  458.     
  459.     my %bits;
  460.     map { 
  461.     if (/^(\w+)='(.*)'$/) {
  462.         $bits{$1} = $2;
  463.     }
  464.     } split /,/, $rule;
  465.  
  466.     
  467.     if (exists $bits{member} &&
  468.     $bits{member} ne $member) {
  469.     return 0;
  470.     }
  471.     if (exists $bits{interface} &&
  472.     $bits{interface} ne $interface) {
  473.     return 0;
  474.     }
  475.     if (exists $bits{sender} &&
  476.     $bits{sender} ne $sender) {
  477.     return 0;
  478.     }
  479.     if (exists $bits{path} &&
  480.     $bits{path} ne $path) {
  481.     return 0;
  482.     }
  483.     return 1;
  484. }
  485.  
  486. sub _signal_func {
  487.     my $self = shift;
  488.     my $connection = shift;
  489.     my $message = shift;
  490.  
  491.     return 0 unless $message->isa("Net::DBus::Binding::Message::Signal");
  492.  
  493.     my $interface = $message->get_interface;
  494.     my $sender = $message->get_sender;
  495.     my $path = $message->get_path;
  496.     my $member = $message->get_member;
  497.  
  498.     my $handled = 0;
  499.     foreach my $handler (grep { defined $_->[1] && 
  500.                 $self->_rule_matches($_->[1], $member, $interface, $sender, $path) }
  501.              @{$self->{signals}}) {
  502.     my $callback = $handler->[0];
  503.     &$callback($message);
  504.     $handled = 1;
  505.     }
  506.  
  507.     return $handled;
  508. }
  509.  
  510. =back
  511.  
  512. =head1 DATA TYPING METHODS
  513.  
  514. These methods are not usually used, since most services provide introspection
  515. data to inform clients of their data typing requirements. If introspection data
  516. is incomplete, however, it may be neccessary for a client to mark values with
  517. specific data types. In such a case, the following methods can be used. They
  518. are not, however, exported by default so must be requested at import time by
  519. specifying 'use Net::DBus qw(:typing)'
  520.  
  521. =over 4
  522.  
  523. =item $typed_value = dbus_int16($value);
  524.  
  525. Mark a value as being a signed, 16-bit integer.
  526.  
  527. =cut
  528.  
  529. sub dbus_int16 {
  530.     return Net::DBus::Binding::Value->new(&Net::DBus::Binding::Message::TYPE_INT16,
  531.                       $_[0]);
  532.                       
  533. }
  534.  
  535. =item $typed_value = dbus_uint16($value);
  536.  
  537. Mark a value as being an unsigned, 16-bit integer.
  538.  
  539. =cut
  540.  
  541.  
  542. sub dbus_uint16 {
  543.     return Net::DBus::Binding::Value->new(&Net::DBus::Binding::Message::TYPE_UINT16,
  544.                       $_[0]);
  545. }
  546.  
  547. =item $typed_value = dbus_int32($value);
  548.  
  549. Mark a value as being a signed, 32-bit integer.
  550.  
  551. =cut
  552.  
  553. sub dbus_int32 {
  554.     return Net::DBus::Binding::Value->new(&Net::DBus::Binding::Message::TYPE_INT32,
  555.                       $_[0]);
  556.                       
  557. }
  558.  
  559. =item $typed_value = dbus_uint32($value);
  560.  
  561. Mark a value as being an unsigned, 32-bit integer.
  562.  
  563. =cut
  564.  
  565.  
  566. sub dbus_uint32 {
  567.     return Net::DBus::Binding::Value->new(&Net::DBus::Binding::Message::TYPE_UINT32,
  568.                       $_[0]);
  569. }
  570.  
  571. =item $typed_value = dbus_int64($value);
  572.  
  573. Mark a value as being an unsigned, 64-bit integer.
  574.  
  575. =cut
  576.  
  577.  
  578.  
  579. sub dbus_int64 {
  580.     return Net::DBus::Binding::Value->new(&Net::DBus::Binding::Message::TYPE_INT64,
  581.                       $_[0]);
  582.                       
  583. }
  584.  
  585. =item $typed_value = dbus_uint64($value);
  586.  
  587. Mark a value as being an unsigned, 64-bit integer.
  588.  
  589. =cut
  590.  
  591.  
  592.  
  593. sub dbus_uint64 {
  594.     return Net::DBus::Binding::Value->new(&Net::DBus::Binding::Message::TYPE_UINT64,
  595.                       $_[0]);
  596. }
  597.  
  598. =item $typed_value = dbus_double($value);
  599.  
  600. Mark a value as being a double precision IEEE floating point.
  601.  
  602. =cut
  603.  
  604.  
  605.  
  606. sub dbus_double {
  607.     return Net::DBus::Binding::Value->new(&Net::DBus::Binding::Message::TYPE_DOUBLE,
  608.                       $_[0]);
  609. }
  610.  
  611. =item $typed_value = dbus_byte($value);
  612.  
  613. Mark a value as being an unsigned, byte.
  614.  
  615. =cut
  616.  
  617.  
  618.  
  619. sub dbus_byte {
  620.     return Net::DBus::Binding::Value->new(&Net::DBus::Binding::Message::TYPE_BYTE,
  621.                       $_[0]);
  622. }
  623.  
  624. =item $typed_value = dbus_string($value);
  625.  
  626. Mark a value as being a UTF-8 string. This is not usually required
  627. since 'string' is the default data type for any Perl scalar value.
  628.  
  629. =cut
  630.  
  631.  
  632.  
  633. sub dbus_string {
  634.     return Net::DBus::Binding::Value->new(&Net::DBus::Binding::Message::TYPE_STRING,
  635.                       $_[0]);
  636. }
  637.  
  638. =item $typed_value = dbus_signature($value);
  639.  
  640. Mark a value as being a UTF-8 string, whose contents is a valid 
  641. type signature
  642.  
  643. =cut
  644.  
  645.  
  646.  
  647. sub dbus_signature {
  648.     return Net::DBus::Binding::Value->new(&Net::DBus::Binding::Message::TYPE_SIGNATURE,
  649.                       $_[0]);
  650. }
  651.  
  652. =item $typed_value = dbus_object_path($value);
  653.  
  654. Mark a value as being a UTF-8 string, whose contents is a valid
  655. object path.
  656.  
  657. =cut
  658.  
  659. sub dbus_object_path {
  660.     return Net::DBus::Binding::Value->new(&Net::DBus::Binding::Message::TYPE_OBJECT_PATH,
  661.                       $_[0]);
  662. }
  663.  
  664. =item $typed_value = dbus_boolean($value);
  665.  
  666. Mark a value as being an boolean
  667.  
  668. =cut
  669.  
  670.  
  671.  
  672. sub dbus_boolean {
  673.     return Net::DBus::Binding::Value->new(&Net::DBus::Binding::Message::TYPE_BOOLEAN,
  674.                       $_[0]);
  675. }
  676.  
  677. =item $typed_value = dbus_array($value);
  678.  
  679. Mark a value as being an array
  680.  
  681. =cut
  682.  
  683.  
  684. sub dbus_array {
  685.     return Net::DBus::Binding::Value->new([&Net::DBus::Binding::Message::TYPE_ARRAY],
  686.                       $_[0]);
  687. }
  688.  
  689. =item $typed_value = dbus_struct($value);
  690.  
  691. Mark a value as being a structure
  692.  
  693. =cut
  694.  
  695.  
  696. sub dbus_struct {
  697.     return Net::DBus::Binding::Value->new([&Net::DBus::Binding::Message::TYPE_STRUCT],
  698.                       $_[0]);
  699. }
  700.  
  701. =item $typed_value = dbus_dict($value);
  702.  
  703. Mark a value as being a dictionary
  704.  
  705. =cut
  706.  
  707. sub dbus_dict{
  708.     return Net::DBus::Binding::Value->new([&Net::DBus::Binding::Message::TYPE_DICT_ENTRY],
  709.                       $_[0]);
  710. }
  711.  
  712. =item $typed_value = dbus_variant($value);
  713.  
  714. Mark a value as being a variant
  715.  
  716. =cut
  717.  
  718. sub dbus_variant{
  719.     return Net::DBus::Binding::Value->new([&Net::DBus::Binding::Message::TYPE_VARIANT],
  720.                       $_[0]);
  721. }
  722.  
  723. =pod
  724.  
  725. =back
  726.  
  727. =head1 SEE ALSO
  728.  
  729. L<Net::DBus>, L<Net::DBus::RemoteService>, L<Net::DBus::Service>, 
  730. L<Net::DBus::RemoteObject>, L<Net::DBus::Object>, 
  731. L<Net::DBus::Exporter>, L<Net::DBus::Dumper>, L<Net::DBus::Reactor>,
  732. C<dbus-monitor(1)>, C<dbus-daemon-1(1)>, C<dbus-send(1)>, L<http://dbus.freedesktop.org>,
  733.  
  734. =head1 AUTHOR
  735.  
  736. Daniel Berrange <dan@berrange.com>
  737.  
  738. =head1 COPYRIGHT
  739.  
  740. Copyright 2004-2005 by Daniel Berrange
  741.  
  742. =cut
  743.  
  744. 1;
  745.  
  746. package Net::DBus::Error;
  747.  
  748. use overload ('""' => 'stringify');
  749.  
  750. sub stringify {
  751.     my $self = shift;
  752.     
  753.     return $self->{name} . ": " . $self->{message} . ($self->{message} =~ /\n$/ ? "" : "\n");
  754. }
  755.     
  756.  
  757. 1;
  758.  
  759.  
  760.