blob: fbb1fbee8f370c38402bac874d224e4421ef4799 (
plain)
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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
package MGA::Mirrors::Controller::New;
use Moose;
use namespace::autoclean;
use URI;
BEGIN {extends 'Catalyst::Controller'; }
=head1 NAME
MGA::Mirrors::Controller::New - Catalyst Controller
=head1 DESCRIPTION
Catalyst Controller.
=head1 METHODS
=cut
=head2 index
=cut
sub index :Path :Args(0) {
my ( $self, $c ) = @_;
if ($c->req->param('url')) {
my $uri = URI->new($c->req->param('url'));
$c->stash->{uri} = $uri;
if (!($uri->can('host') && $uri->can('scheme'))) {
$c->stash->{subtemplate} = 'new/invalid_uri.tt';
return;
}
if (!$c->model('Mirrors')->get_protocol_info($uri->scheme)) {
$c->stash->{subtemplate} = 'new/unsupported_protocol.tt';
return;
}
my $urls = $c->model('Mirrors')->find_urls(
{ protocol => $uri->scheme,
hostname => $uri->host, });
if (@{$urls || []}) {
$c->stash->{exists_url} = $urls;
$c->stash->{subtemplate} = 'new/mirror_exists.tt';
return;
}
if (!$c->model('Mirrors')->mirror_validity($uri)) {
$c->stash->{subtemplate} = 'new/invalid_mirror.tt';
return;
}
if (my @overlap_hosts = $c->model('Mirrors')->find_host_ip_overlap($uri->host)) {
$c->stash->{overlap_hosts} = \@overlap_hosts;
$c->stash->{subtemplate} = 'new/overlap_hosts.tt';
return;
}
my @ips = $c->model('Mirrors')->host_ips($uri->host);
$c->stash->{location} = $c->model('Mirrors')->locate_ips(@ips);
my $mirror = $c->model('Mirrors')->find_mirrors(
{ hostname => $uri->host, });
if (@{ $mirror || []}) {
$c->stash->{mirror} = $mirror->[0];
} elsif ($c->req->param('hostinfo')) {
foreach (qw(city country)) {
$c->session->{hostinfo}{$_} = $c->req->param($_);
}
} else {
$c->stash->{subtemplate} = 'new/host_information.tt';
return;
}
$c->session->{new_uri} = $uri;
$c->stash->{template} = 'new/confirm.tt';
}
}
sub confirm :Path :Args(1) {
my ( $self, $c ) = @_;
$c->stash->{current_view} = 'TTBlock';
if ($c->session->{new_uri} && $c->req->param('confirm')) {
my $uri = URI->new($c->session->{new_uri});
my $mirror = $c->model('Mirrors')->find_mirrors(
{ hostname => $uri->host, });
if (!@{$mirror || []}) {
if ($c->session->{hostinfo}) {
$c->model->add_or_update_host(
$uri->host,
city => $c->session->{hostinfo}{city},
country => $c->session->{hostinfo}{country},
);
} else {
return;
}
}
if ($c->model('Mirrors')->add_or_update_url($uri)) {
$c->session->{hostinfo} = undef;
$c->session->{new_uri} = undef;
$c->stash->{template} = 'new/success.tt';
$c->model('Mirrors')->db->commit;
return;
}
}
}
=head1 AUTHOR
Olivier Thauvin
=head1 LICENSE
This library is free software. You can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
__PACKAGE__->meta->make_immutable;
1;
|
