diff options
Diffstat (limited to 'perl-install')
| -rw-r--r-- | perl-install/diskdrake/dav.pm | 96 | ||||
| -rw-r--r-- | perl-install/diskdrake/interactive.pm | 2 | ||||
| -rwxr-xr-x | perl-install/standalone/diskdrake | 5 |
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; |