1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
package URI::URL::mailto;
require URI::URL;
@ISA = qw(URI::URL);
use URI::Escape;
sub new {
my($class, $init, $base) = @_;
my $self = bless { }, $class;
$self->{'scheme'} = lc($1) if $init =~ s/^\s*([\w\+\.\-]+)://;
$self->{'address'} = uri_unescape($init);
$self->base($base) if $base;
$self;
}
sub address { shift->_elem('address', @_); }
# can use these as aliases
*encoded822addr = \&address; # URI::URL v3 compatibility
*netloc = \&address;
sub user {
my $self = shift;
$old = $self->{'address'};
if (@_) {
my $new = $old;
$new =~ s/.*\@?/$_[0]\@/;
$self->{'address'} = $new;
}
$old =~ s/\@.*//;
$old;
}
sub host {
my $self = shift;
$old = $self->{'address'};
if (@_) {
my $new = $old;
$new =~ s/\@.*/\@$_[0]/;
$self->{'address'} = $new;
}
$old =~ s/.*\@//;
$old;
}
sub crack
{
my $self = shift;
('mailto', # scheme
$self->user, # user
undef, # passwd
$self->host, # host
undef, # port
$self->{'address'}, # path
undef, # params
undef, # query
undef # fragment
)
}
sub as_string {
my $self = shift;
my $str = ($self->{'scheme'} || "mailto") . ":";
$str .= uri_escape($self->{'address'}) if defined $self->{'address'};
$str;
}
sub eq {
my($self, $other) = @_;
$other = URI::URL->new($other) unless ref $other;
# Mail adresses are case-insensitive
$self->scheme eq $other->scheme &&
lc($self->{'address'}) eq lc($other->{'address'});
}
1;
|
