summaryrefslogtreecommitdiffstats
path: root/perl-install
diff options
context:
space:
mode:
Diffstat (limited to 'perl-install')
-rw-r--r--perl-install/diskdrake/dav.pm96
-rw-r--r--perl-install/diskdrake/interactive.pm2
-rwxr-xr-xperl-install/standalone/diskdrake5
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;