summaryrefslogtreecommitdiffstats
path: root/perl-install/diskdrake
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install/diskdrake')
-rw-r--r--perl-install/diskdrake/dav.pm96
-rw-r--r--perl-install/diskdrake/interactive.pm2
2 files changed, 97 insertions, 1 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 } ],