aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
authorOlivier Thauvin <nanardon@mageia.org>2010-10-03 15:36:00 +0000
committerOlivier Thauvin <nanardon@mageia.org>2010-10-03 15:36:00 +0000
commitddcf19029c7b58b2ea236bd14e6c1456949f0fc0 (patch)
tree725f066cac991b43163f1e08a5954b6071634f3d /lib
parent114b46067622cc0c68d007711cf58f74e25411b8 (diff)
downloadmgamirrors-ddcf19029c7b58b2ea236bd14e6c1456949f0fc0.tar
mgamirrors-ddcf19029c7b58b2ea236bd14e6c1456949f0fc0.tar.gz
mgamirrors-ddcf19029c7b58b2ea236bd14e6c1456949f0fc0.tar.bz2
mgamirrors-ddcf19029c7b58b2ea236bd14e6c1456949f0fc0.tar.xz
mgamirrors-ddcf19029c7b58b2ea236bd14e6c1456949f0fc0.zip
- use google maps for location, improve messages
Diffstat (limited to 'lib')
-rw-r--r--lib/MGA/Mirrors/Controller/Graph.pm70
-rw-r--r--lib/MGA/Mirrors/Controller/Mirrors.pm3
-rw-r--r--lib/MGA/Mirrors/Controller/New.pm22
-rw-r--r--lib/MGA/Mirrors/Controller/Report.pm44
-rw-r--r--lib/MGA/Mirrors/Controller/Root.pm10
-rw-r--r--lib/MGA/Mirrors/DB.pm62
-rw-r--r--lib/MGA/Mirrors/View/GraphViz.pm29
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;