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->[0]; if ($urls->[0]->{valid}) { $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; if (@overlap_hosts == 1) { my $maybeurl = $c->model('Mirrors')->find_urls({ protocol => $uri->scheme, hostname => $overlap_hosts[0] }); if (!@{$maybeurl || []}) { my $totryurl = $uri->clone; $totryurl->host($overlap_hosts[0]); $c->stash->{urlmaybe} = $totryurl; $c->req->params->{url} = $totryurl; } } $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); $c->stash->{host}{country} = $c->stash->{location}{code}; $c->stash->{host}{latitude} = $c->stash->{location}{latitude}; $c->stash->{host}{longitude} = $c->stash->{location}{longitude}; 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 syncfrom bandwidth latitude longitude)) { $c->session->{hostinfo}{$_} = $c->req->param($_); } } else { $c->stash->{template} = 'new/new_host.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}, bandwidth => $c->session->{hostinfo}{bandwidth}, syncfrom => $c->session->{hostinfo}{syncfrom}, latitude => $c->session->{hostinfo}{latitude}, longitude => $c->session->{hostinfo}{longitude}, ); } 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;