1# Copyrights 2001-2020 by [Mark Overmeer]. 2# For other contributors see ChangeLog. 3# See the manual pages for details on the licensing terms. 4# Pod stripped from pm file by OODoc 2.02. 5# This code is part of distribution Mail-Box. Meta-POD processed with 6# OODoc into POD and HTML manual-pages. See README.md 7# Copyright Mark Overmeer. Licensed under the same terms as Perl itself. 8 9package Mail::Box::Net; 10use vars '$VERSION'; 11$VERSION = '3.009'; 12 13 14use strict; 15use warnings; 16 17use base 'Mail::Box'; 18 19use Mail::Box::Net::Message; 20 21use Mail::Message::Body::Lines; 22use Mail::Message::Body::File; 23use Mail::Message::Body::Delayed; 24use Mail::Message::Body::Multipart; 25 26use Mail::Message::Head; 27use Mail::Message::Head::Delayed; 28 29use Carp; 30use File::Copy; 31use File::Spec; 32use File::Basename; 33 34 35sub init($) 36{ my ($self, $args) = @_; 37 38 $args->{lock_type} ||= 'NONE'; 39 $args->{body_type} ||= 'Mail::Message::Body::Lines'; 40 $args->{trusted} ||= 0; 41 42 my ($scheme, $s, $port, $u, $pwd, $f); 43 if(my $d = $args->{folderdir}) 44 { # cannot use URI, because some scheme's are fake 45 ($scheme, $u, $pwd, $s, $port, $f) = $d =~ 46 m! ^ (\w+) \:// # scheme 47 (?: ( [^:\@/]+ ) # username 48 (?: \: ( [^\@/]+ ))? # password 49 \@ )? 50 ( [a-zA-Z0-9.-]+ )? # hostname 51 (?: \: ([0-9]+) )? # port 52 ( / .* )? # path 53 !x; 54 $args->{folderdir} =~ s!/$!!; 55 } 56 57 $args->{folder} ||= $f || '/'; 58 59 $self->SUPER::init($args); 60 61 $self->{MBN_hostname} = $args->{server_name} || $s; 62 $self->{MBN_port} = $args->{server_port} || $port; 63 $self->{MBN_username} = $args->{username} || $u; 64 $self->{MBN_password} = $args->{password} || $pwd; 65 66 $self->log(WARNING => "The term 'hostname' is confusing wrt folder. You probably need 'server_name'") 67 if exists $args->{hostname}; 68 69 $self; 70} 71 72 73sub create(@) {shift->notImplemented} 74sub organization() { 'REMOTE' } 75 76sub url() 77{ my $self = shift; 78 79 my ($user, $pass, $host, $port) 80 = @$self{ qw/MBN_username MBN_password MBN_hostname MBN_port/ }; 81 82 my $perm = ''; 83 $perm = $user if defined $user; 84 if(defined $pass) 85 { $pass =~ s/(\W)/sprintf "%%%02X", ord $1/ge; 86 $perm .= ':'.$pass; 87 } 88 89 $perm .= '@' if length $perm; 90 91 my $loc = $host; 92 $loc .= ':'.$port if length $port; 93 94 my $name = $self->name; 95 $loc .= '/'.$name if $name ne '/'; 96 97 $self->type . '://' . $perm . $loc; 98} 99 1001; 101