diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/MGA/Mirrors/Controller/Graph.pm | 70 | ||||
| -rw-r--r-- | lib/MGA/Mirrors/Controller/Mirrors.pm | 3 | ||||
| -rw-r--r-- | lib/MGA/Mirrors/Controller/New.pm | 22 | ||||
| -rw-r--r-- | lib/MGA/Mirrors/Controller/Report.pm | 44 | ||||
| -rw-r--r-- | lib/MGA/Mirrors/Controller/Root.pm | 10 | ||||
| -rw-r--r-- | lib/MGA/Mirrors/DB.pm | 62 | ||||
| -rw-r--r-- | lib/MGA/Mirrors/View/GraphViz.pm | 29 |
7 files changed, 218 insertions, 22 deletions
diff --git a/lib/MGA/Mirrors/Controller/Graph.pm b/lib/MGA/Mirrors/Controller/Graph.pm new file mode 100644 index 0000000..5ca93cf --- /dev/null +++ b/lib/MGA/Mirrors/Controller/Graph.pm @@ -0,0 +1,70 @@ +package MGA::Mirrors::Controller::Graph; +use Moose; +use namespace::autoclean; + +BEGIN {extends 'Catalyst::Controller'; } + +=head1 NAME + +MGA::Mirrors::Controller::Graph - Catalyst Controller + +=head1 DESCRIPTION + +Catalyst Controller. + +=head1 METHODS + +=cut + + +=head2 index + +=cut + +sub index :Path :Args(0) { + my ( $self, $c ) = @_; + + my $mirror_list = $c->model('Mirrors')->find_mirrors; + my $graph = GraphViz->new(layout => 'dot', overlap => 'orthoxy', rankdir => 1); + my %node; + my %edge; + foreach (@{$mirror_list || []}) { + $node{$_->{hostname}} = $_; + if ($_->{syncfrom}) { + $edge{$_->{syncfrom}}{$_->{hostname}} = 1; + } + } + my %nodadded; + foreach my $from (keys %edge) { + foreach my $to (keys %{ $edge{$from} ||{}}) { + foreach ($from, $to) { + if (!$nodadded{$_}) { + $graph->add_node($_, shape => 'box', cluster => $node{$_}{country}); + } + } + $graph->add_edge($from, $to); + } + } + $c->stash->{graphviz}->{graph} = $graph; +} + +sub end : Private { + my ($self, $c) = @_; + $c->view('GraphViz')->process($c); + $c->model('Mirrors')->db->rollback; +} + +=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; diff --git a/lib/MGA/Mirrors/Controller/Mirrors.pm b/lib/MGA/Mirrors/Controller/Mirrors.pm index 5d07ca5..73fa5ae 100644 --- a/lib/MGA/Mirrors/Controller/Mirrors.pm +++ b/lib/MGA/Mirrors/Controller/Mirrors.pm @@ -41,6 +41,8 @@ sub mirror :Path :Args(1) { city => $c->req->param('city'), country => $c->req->param('country'), syncfrom=> $c->req->param('syncfrom'), + latitude => $c->req->param('latitude'), + longitude => $c->req->param('longitude'), ); } } @@ -48,6 +50,7 @@ sub mirror :Path :Args(1) { $c->stash->{host} = $c->model('Mirrors')->find_mirrors({ hostname => $host, })->[0]; + $c->model('Mirrors')->db->commit; } =head1 AUTHOR diff --git a/lib/MGA/Mirrors/Controller/New.pm b/lib/MGA/Mirrors/Controller/New.pm index d3ec38c..bf4fa59 100644 --- a/lib/MGA/Mirrors/Controller/New.pm +++ b/lib/MGA/Mirrors/Controller/New.pm @@ -43,7 +43,7 @@ sub index :Path :Args(0) { { protocol => $uri->scheme, hostname => $uri->host, }); if (@{$urls || []}) { - $c->stash->{exists_url} = $urls; + $c->stash->{exists_url} = $urls->[0]; if ($urls->[0]->{valid}) { $c->stash->{subtemplate} = 'new/mirror_exists.tt'; return; @@ -57,6 +57,18 @@ sub index :Path :Args(0) { 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; } @@ -65,17 +77,19 @@ sub index :Path :Args(0) { $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)) { + foreach (qw(city country syncfrom bandwidth latitude longitude)) { $c->session->{hostinfo}{$_} = $c->req->param($_); } } else { - $c->stash->{subtemplate} = 'new/new_host.tt'; + $c->stash->{template} = 'new/new_host.tt'; return; } @@ -99,6 +113,8 @@ sub confirm :Path :Args(1) { 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; diff --git a/lib/MGA/Mirrors/Controller/Report.pm b/lib/MGA/Mirrors/Controller/Report.pm new file mode 100644 index 0000000..b6cf3d3 --- /dev/null +++ b/lib/MGA/Mirrors/Controller/Report.pm @@ -0,0 +1,44 @@ +package MGA::Mirrors::Controller::Report; +use Moose; +use namespace::autoclean; +use URI; + +BEGIN {extends 'Catalyst::Controller'; } + +=head1 NAME + +MGA::Mirrors::Controller::Report - Catalyst Controller + +=head1 DESCRIPTION + +Catalyst Controller. + +=head1 METHODS + +=cut + + +=head2 index + +=cut + +sub index :Path :Args(0) { + my ( $self, $c ) = @_; + +} + + +=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; diff --git a/lib/MGA/Mirrors/Controller/Root.pm b/lib/MGA/Mirrors/Controller/Root.pm index bbc4d4d..416442c 100644 --- a/lib/MGA/Mirrors/Controller/Root.pm +++ b/lib/MGA/Mirrors/Controller/Root.pm @@ -51,7 +51,15 @@ Attempt to render a view, if needed. =cut -sub end : ActionClass('RenderView') {} +sub _end : ActionClass('RenderView') { + my ($self, $c) = @_; +} + +sub end : Private { + my ($self, $c) = @_; + $c->forward('_end'); + $c->model('Mirrors')->db->rollback; +} =head1 AUTHOR diff --git a/lib/MGA/Mirrors/DB.pm b/lib/MGA/Mirrors/DB.pm index 31eb4cc..8f66ac1 100644 --- a/lib/MGA/Mirrors/DB.pm +++ b/lib/MGA/Mirrors/DB.pm @@ -85,6 +85,7 @@ sub protocol_list { sub bandwidth_name { my ($self, $value) = @_; + $value or return; my $select = $self->db->prepare(q{ select name from bandwidth where value = ? }); @@ -103,6 +104,17 @@ sub bandwidth_list { return $list->fetchall_arrayref({}); } +sub country_info { + my ($self, $code) = @_; + my $list = $self->db->prepare(q{ + select * from countries where code = ? + }); + $list->execute($code); + my $res = $list->fetchrow_hashref; + $list->finish; + $res +} + sub country_list { my ($self) = @_; my $list = $self->db->prepare(q{ @@ -151,31 +163,39 @@ sub check_distributions { my ($self) = @_; my $uneeded_check = $self->db->prepare(q{ - select * from mirrors_distributions where + select * from distributions_validity where lastcheck > now() - '6 hours'::interval }); $uneeded_check->execute(); my $uch = $uneeded_check->fetchall_hashref([ qw(urlskey distributionkey) ]); my $listd = $self->db->prepare(q{ - select * from urls, distributions - where urls.valid = true + select * from toplevel_urls, distributions + where toplevel_urls.valid = true }); my $addstatus = $self->db->prepare(q{ - insert into mirrors_distributions (urlskey, distributionkey, exists) + insert into distributions_validity (urlskey, distributionkey, exists) values (?,?,?) }); my $updstatus = $self->db->prepare(q{ - update mirrors_distributions set lastcheck = now(), exists = ? + update distributions_validity set lastcheck = now(), exists = ? + where urlskey = ? and distributionkey = ? + }); + my $upd_lastok = $self->db->prepare(q{ + update distributions_validity set lastok = now() where urlskey = ? and distributionkey = ? }); my %urls_status = (); my $updurl = $self->db->prepare(q{ - update urls set lastcheck = now(), valid = ? + update toplevel_urls set lastcheck = now(), valid = ? + where key = ? + }); + my $upd_url_lastok = $self->db->prepare(q{ + update toplevel_urls set lastok = now() where key = ? }); @@ -184,8 +204,10 @@ sub check_distributions { $uch->{$res->{key}}{$res->{dkey}} and next; my $url = $self->fmt_url($res); if (!exists($urls_status{$res->{key}})) { + $self->update_host_ips($res->{hostname}); my $ok = $self->mirror_validity($url); $updurl->execute($ok ? 1 : 0, $res->{key}); + $upd_url_lastok->execute($res->{key}) if ($ok); $urls_status{$res->{key}} = $ok; } $urls_status{$res->{key}} or next; @@ -194,6 +216,7 @@ sub check_distributions { if ($updstatus->execute($exists, $res->{key}, $res->{dkey}) == 0) { $addstatus->execute($res->{key}, $res->{dkey}, $exists); } + $upd_lastok->execute($res->{key}, $res->{dkey}) if ($exists); $self->db->commit; } } @@ -225,9 +248,12 @@ sub find_mirrors { my ($self, $filters, $key) = @_; my $query = q{ - select * from hosts + select *, + coalesce(hosts.latitude, countries.latitude) as latitude, + coalesce(hosts.longitude, countries.longitude) as longitude + from hosts left join countries on countries.code = hosts.country - where hosts.hostname in (select hostname from urls %s) + where hosts.hostname in (select hostname from toplevel_urls %s) %s }; @@ -266,8 +292,8 @@ sub _find_urls { my ($self, $filters, $key) = @_; my $query = q{ - select urls.* from urls join - hosts on hosts.hostname = urls.hostname + select toplevel_urls.* from toplevel_urls join + hosts on hosts.hostname = toplevel_urls.hostname }; my @vals; if (keys %{ $filters || {} }) { @@ -276,7 +302,7 @@ sub _find_urls { $filters->{$_} or next; my $field = { hostname => 'hosts.hostname', - protocol => 'urls.protocol', + protocol => 'toplevel_urls.protocol', }->{$_} or next; push(@w, sprintf('%s = any(?)', $field)); @@ -301,10 +327,10 @@ sub _find_distributions { my ($self, $filters, $key) = @_; my $query = q{ - select *, urls.path || distributions.relpath as path from hosts - join urls on urls.hostname = hosts.hostname - join mirrors_distributions on urls.key = mirrors_distributions.urlskey - join distributions on distributions.dkey = mirrors_distributions.distributionkey + select *, toplevel_urls.path || distributions.relpath as path from hosts + join toplevel_urls on toplevel_urls.hostname = hosts.hostname + join distributions_validity on toplevel_urls.key = distributions_validity.urlskey + join distributions on distributions.dkey = distributions_validity.distributionkey }; my @vals; @@ -314,7 +340,7 @@ sub _find_distributions { $filters->{$_} or next; my $field = { hostname => 'hosts.hostname', - protocol => 'urls.protocol', + protocol => 'topelvel_urls.protocol', version => 'distributions.version', arch => 'distributions.arch', country => 'mirrors.country', @@ -382,7 +408,7 @@ sub add_or_update_url { } my $update = $self->db->prepare(q{ - update urls set path = ?, port = ?, valid = true + update toplevel_urls set path = ?, port = ?, valid = true where hostname = ? and protocol = ? }); @@ -391,7 +417,7 @@ sub add_or_update_url { $uri->host, $uri->scheme ) == 0) { my $add = $self->db->prepare(q{ - insert into urls (path, port, hostname, protocol) + insert into toplevel_urls (path, port, hostname, protocol) values (?,?,?,?) }); $add->execute($uri->path, $uri->port == $uri->default_port ? undef : $uri->port, diff --git a/lib/MGA/Mirrors/View/GraphViz.pm b/lib/MGA/Mirrors/View/GraphViz.pm new file mode 100644 index 0000000..05811cd --- /dev/null +++ b/lib/MGA/Mirrors/View/GraphViz.pm @@ -0,0 +1,29 @@ +package MGA::Mirrors::View::GraphViz; + +use strict; +use base 'Catalyst::View::GraphViz'; + +=head1 NAME + +MGA::Mirrors::View::GraphViz - Catalyst GraphViz View + +=head1 SYNOPSIS + +See L<MGA::Mirrors> + +=head1 DESCRIPTION + +Catalyst GraphViz View. + +=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 + +1; |