diff options
| -rw-r--r-- | Changes | 2 | ||||
| -rw-r--r-- | MANIFEST | 5 | ||||
| -rw-r--r-- | Makefile.PL | 8 | ||||
| -rw-r--r-- | lib/Hal/Cdroms.pm | 251 | ||||
| -rw-r--r-- | t/00basic.t | 5 |
5 files changed, 271 insertions, 0 deletions
@@ -0,0 +1,2 @@ +0.01 Thu Feb 28 22:14:25 CET 2008 + - initial release diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..17fbe7e --- /dev/null +++ b/MANIFEST @@ -0,0 +1,5 @@ +Changes +lib/Hal/Cdroms.pm +Makefile.PL +MANIFEST +t/00basic.t diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..7b2393b --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,8 @@ +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => 'Hal::Cdroms', + VERSION_FROM => 'lib/Hal/Cdroms.pm', + ABSTRACT_FROM => 'lib/Hal/Cdroms.pm', + AUTHOR => 'Pixel <pixel@rigaux.org>', +); diff --git a/lib/Hal/Cdroms.pm b/lib/Hal/Cdroms.pm new file mode 100644 index 0000000..77983f5 --- /dev/null +++ b/lib/Hal/Cdroms.pm @@ -0,0 +1,251 @@ +package Hal::Cdroms; + +our $VERSION = 0.01; + +# Copyright (C) 2008 Mandriva +# +# This program is free software; You can redistribute it and/or modify +# it under the same terms as Perl itself. Either: +# +# a) the GNU General Public License as published by the Free +# Software Foundation; either version 2, or (at your option) any +# later version, +# +# or +# +# b) the "Artistic License" +# +# The file "COPYING" distributed along with this file provides full +# details of the terms and conditions of the two licenses. + +=head1 NAME + +Hal::Cdroms - access cdroms through HAL and D-Bus + +=head1 SYNOPSIS + + use Hal::Cdroms; + + my $hal_cdroms = Hal::Cdroms->new; + + foreach my $hal_path ($hal_cdroms->list) { + my $m = $hal_cdroms->get_mount_point($hal_path); + print "$hal_path ", $m ? "is mounted in $m" : "is not mounted", "\n"; + } + + my $hal_path = $hal_cdroms->wait_for_insert; + my $m = $hal_cdroms->mount($hal_path); + print "$hal_path is now mounted in $m\n"; + +=head1 DESCRIPTION + +Access cdroms through HAL and D-Bus. + +=cut + +# internal constant +my $hal_dn = 'org.freedesktop.Hal'; + + +=head2 Hal::Cdroms->new + +Creates the object + +=cut + +sub new { + my ($class) = @_; + + require Net::DBus; + require Net::DBus::Reactor; # must be done before line below: + my $dbus = Net::DBus->system; + my $hal = $dbus->get_service($hal_dn); + + bless { dbus => $dbus, hal => $hal }, $class; +} + +=head2 $hal_cdroms->list + +Returns the list of C<hal_path> of the cdroms (mounted or not). + +=cut + +sub list { + my ($o) = @_; + + my $manager = $o->{hal}->get_object("/org/freedesktop/Hal/Manager", + "$hal_dn.Manager"); + + @{$manager->FindDeviceByCapability('volume.disc')}; +} + +=head2 $hal_cdroms->get_mount_point($hal_path) + +Return the mount point associated to the C<hal_path>, or undef it is not mounted. + +=cut + +sub _get_device { + my ($o, $hal_path) = @_; + $o->{hal}->get_object($hal_path, "$hal_dn.Device"); +} +sub _get_volume { + my ($o, $hal_path) = @_; + $o->{hal}->get_object($hal_path, "$hal_dn.Device.Volume"); +} +sub get_mount_point { + my ($o, $hal_path) = @_; + + my $device = _get_device($o, $hal_path); + eval { $device->GetProperty('volume.is_mounted') + && $device->GetProperty('volume.mount_point') }; +} + +=head2 $hal_cdroms->ensure_mounted($hal_path) + +Mount the C<hal_path> if not already mounted. +Return the mount point associated to the C<hal_path>, or undef it cannot be mounted successfully. + +=cut + +sub ensure_mounted { + my ($o, $hal_path) = @_; + + $o->get_mount_point($hal_path) # check if it is already mounted + || $o->mount($hal_path) # otherwise try to mount + || $o->get_mount_point($hal_path); # checking wether a volume manager did it for us +} + + +=head2 $hal_cdroms->mount($hal_path) + +Mount the C<hal_path>. +Return the mount point associated to the C<hal_path>, or undef it cannot be mounted successfully. + +=cut + +sub mount { + my ($o, $hal_path) = @_; + + my $device = _get_device($o, $hal_path); + my $volume = _get_volume($o, $hal_path); + + my $mntpoint = $device->GetProperty('volume.label') || 'cdrom'; + my $fstype = $device->GetProperty('volume.fstype'); + + eval { + $volume->Mount($mntpoint, $fstype, []); + $device->GetProperty('volume.mount_point'); + }; +} + +=head2 $hal_cdroms->unmount($hal_path) + +Unmount the C<hal_path>. Return true on success. + +=cut + +sub unmount { + my ($o, $hal_path) = @_; + + my $volume = _get_volume($o, $hal_path); + eval { $volume->Unmount([]); 1 }; +} + +=head2 $hal_cdroms->eject($hal_path) + +Ejects the C<hal_path>. Return true on success. + +=cut + +sub eject { + my ($o, $hal_path) = @_; + + my $volume = _get_volume($o, $hal_path); + eval { $volume->Eject([]); 1 }; +} + +=head2 $hal_cdroms->wait_for_insert([$timeout]) + +Waits until a cdrom is inserted. +Returns the inserted C<hal_path> on success. Otherwise returns undef. + +You can give an optional timeout in milliseconds. + +=cut + +sub wait_for_insert { + my ($o, $o_timeout) = @_; + + _reactor_wait($o->{dbus}, "$hal_dn.Manager", $o_timeout, sub { + my ($msg) = @_; + $msg->get_member eq 'DeviceAdded' && ($msg->get_args_list)[0]; + }); +} + +=head2 $hal_cdroms->wait_for_mounted([$timeout]) + +Waits until a cdrom is inserted and mounted by a volume manager (eg: gnome-volume-manager). +Returns the mounted C<hal_path> on success. Otherwise returns undef. + +You can give an optional timeout in milliseconds. + +=cut + +sub wait_for_mounted { + my ($o, $o_timeout) = @_; + + _reactor_wait($o->{dbus}, "$hal_dn.Device", $o_timeout, sub { + my ($msg) = @_; + $msg->get_member eq 'PropertyModified' or return; + + my (undef, $modified_properties) = $msg->get_args_list; + grep { $_->[0] eq 'volume.is_mounted' } @$modified_properties or return; + + my $hal_path = $msg->get_path; + my $device = _get_device($o, $hal_path); + + eval { $device->QueryCapability('volume.disc') && + $device->GetProperty('volume.is_mounted') } && $hal_path; + }); +} + +sub _reactor_wait { + my ($dbus, $interface, $timeout, $check_found) = @_; + + my $val; + my $reactor = Net::DBus::Reactor->main; + + my $con = $dbus->get_connection; + $con->add_match("type='signal',interface='$interface'"); + $con->add_filter(sub { + my ($_con, $msg) = @_; + + if ($val = $check_found->($msg)) { + _reactor_shutdown($reactor); + } + }); + if ($timeout) { + $reactor->add_timeout($timeout, Net::DBus::Callback->new(method => sub { + _reactor_shutdown($reactor); + })); + } + $reactor->run; + + $val; +} + +sub _reactor_shutdown { + my ($reactor) = @_; + + $reactor->shutdown; + + # ugly, but needed for shutdown to work... + $reactor->add_timeout(1, Net::DBus::Callback->new(method => sub {})); +} + +=head1 AUTHOR + +Pascal Rigaux <pixel@mandriva.com> + +=cut diff --git a/t/00basic.t b/t/00basic.t new file mode 100644 index 0000000..94803cc --- /dev/null +++ b/t/00basic.t @@ -0,0 +1,5 @@ +use Test; +BEGIN { plan tests => 1 } +END { ok($loaded) } +use Hal::Cdroms; +$loaded++; |