rough WebDAV gui

3 files changed, 101 insertions, 2 deletions

diff --git a/perl-install/diskdrake/dav.pm b/perl-install/diskdrake/dav.pm
new file mode 100644
index 000000000..e4d7fd8c1
--- /dev/null
+++ b/perl-install/diskdrake/dav.pm
@@ -0,0 +1,96 @@
+package diskdrake::dav; # $Id$
+
+use diagnostics;
+use strict;
+use diskdrake::interactive;
+use common;
+use fsedit;
+use fs;
+
+sub main {
+    my ($in, $all_hds) = @_;
+    my $davs = $all_hds->{davs};
+    
+    my $quit;
+    do {
+	$in->ask_from_({ ok => '' },
+		       [ 
+			(map { 
+			    my $dav = $_;
+			    { label => $dav->{device}, val => $dav->{mntpoint}, clicked_may_quit => sub { config($in, $dav, $all_hds); 1 } } } @$davs),
+			 { val => _("New"), clicked_may_quit => sub { create($in, $all_hds); 1 } },
+			 { val => _("Quit"), icon => "exit", clicked_may_quit => sub { $quit = 1 } },
+		       ]);
+    } until ($quit);
+
+    diskdrake::interactive::Done($in, $all_hds);
+}
+
+sub create {
+    my ($in, $all_hds) = @_;
+
+    my $dav = { type => 'davfs' };
+    ask_server($in, $dav, $all_hds) or return;
+    push @{$all_hds->{davs}}, $dav;
+    config($in, $dav, $all_hds);
+}
+
+sub config {
+    my ($in, $dav_, $all_hds) = @_;
+
+    my $dav = { %$dav_ }; #- working on a local copy so that "Cancel" works
+
+    my %actions = my @actions = actions();
+    my $action;
+    while ($action ne 'Done') {
+	$action = $in->ask_from_list_('', format_dav_info($dav), 
+					 [ map { $_->[0] } group_by2 @actions ], 'Done') or return;
+	$actions{$action}->($in, $dav, $all_hds);    
+    }
+    %$dav_ = %$dav; #- applying
+}
+
+sub actions {
+    (
+     __("Server") => \&ask_server,
+     __("Mount point") => \&mount_point,
+     __("Options") => \&options,
+     __("Done") => sub {},
+    );
+}
+
+sub ask_server {
+    my ($in, $dav, $all_hds) = @_;
+
+    my $server = $dav->{device};
+    $in->ask_from('', _("Please enter the WebDAV server URL"),
+		  [ { val => \$server } ],
+		  complete => sub {
+		      $server =~ m!https?://! or $in->ask_warn('', _("The URL must begin with http:// or https://")), return 1;
+		      0;
+		  },
+		 ) or return;
+    $dav->{device} = $server;
+}
+
+sub options {
+    my ($in, $dav, $all_hds) = @_;
+    diskdrake::interactive::Options($in, {}, $dav, $all_hds);
+}
+sub mount_point { 
+    my ($in, $dav, $all_hds) = @_;
+    my $proposition = $dav->{device} =~ /(\w+)/ ? "/mnt/$1" : "/mnt/dav";
+    diskdrake::interactive::Mount_point_raw_hd($in, $dav, $all_hds, [$proposition] );
+}
+
+sub format_dav_info {
+    my ($dav) = @_;
+
+    my $info = '';
+    $info .= _("Server: ") . "$dav->{device}\n" if $dav->{device};
+    $info .= _("Mount point: ") . "$dav->{mntpoint}\n" if $dav->{mntpoint};
+    $info .= _("Options: %s", $dav->{options}) if $dav->{options};
+    $info;
+}
+
+1;
diff --git a/perl-install/diskdrake/interactive.pm b/perl-install/diskdrake/interactive.pm
index f7a16567d..3d9425037 100644
--- a/perl-install/diskdrake/interactive.pm
+++ b/perl-install/diskdrake/interactive.pm
@@ -581,7 +581,7 @@ sub Mount_point_raw_hd {
     my $mntpoint = $part->{mntpoint};
     $in->ask_from(
         '',
-        _("Where do you want to mount device %s?", $part->{device}),
+        _("Where do you want to mount %s?", $part->{device}),
 	[ { label => _("Mount point"), val => \$mntpoint, 
 	    list => [ if_($mntpoint, $mntpoint), '', @$propositions ], 
 	    not_edit => 0 } ],
diff --git a/perl-install/standalone/diskdrake b/perl-install/standalone/diskdrake
index 56f175b57..ae07e8ebe 100755
--- a/perl-install/standalone/diskdrake
+++ b/perl-install/standalone/diskdrake
@@ -49,7 +49,7 @@ while (my $e = shift @l) {
 $::expert = defined(delete $options{expert});
 $::testing = defined(delete $options{testing});
 
-my @types = qw(hd nfs smb removable fileshare);
+my @types = qw(hd nfs smb dav removable fileshare);
 my ($type, $para) = ('hd', '');
 foreach (@types) {
     if (exists $options{$_}) {
@@ -108,6 +108,9 @@ if ($type eq 'hd') {
       first(grep { $para eq $_->{device} } @{$all_hds->{raw_hds}}) || die "unknown removable $para\n" :
       $in->ask_from_listf('', '', \&diskdrake::interactive::format_raw_hd_info, $all_hds->{raw_hds}) or $in->exit(0);
     diskdrake::removable::main($in, $all_hds, $raw_hd);
+} elsif ($type eq 'dav') {
+    require diskdrake::dav;
+    diskdrake::dav::main($in, $all_hds);
 } else {
     $in->ask_warn('', "Sorry only a gtk frontend is available") if !$in->isa('interactive::gtk');
     require diskdrake::smbnfs_gtk;