initial release0.01

5 files changed, 271 insertions, 0 deletions

diff --git a/Changes b/Changes
new file mode 100644
index 0000000..77900da
--- /dev/null
+++ b/Changes
@@ -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++;