- use google maps for location, improve messages

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;