diff options
Diffstat (limited to 'lib/MGA/Mirrors/DB.pm')
-rw-r--r-- | lib/MGA/Mirrors/DB.pm | 102 |
1 files changed, 98 insertions, 4 deletions
diff --git a/lib/MGA/Mirrors/DB.pm b/lib/MGA/Mirrors/DB.pm index 5ff0649..31eb4cc 100644 --- a/lib/MGA/Mirrors/DB.pm +++ b/lib/MGA/Mirrors/DB.pm @@ -74,6 +74,35 @@ sub locate_ips { return; } +sub protocol_list { + my ($self) = @_; + my $select = $self->db->prepare(q{ + select name from protocol order by name + }); + $select->execute; + return keys %{ $select->fetchall_hashref([ 'name' ]) } +} + +sub bandwidth_name { + my ($self, $value) = @_; + my $select = $self->db->prepare(q{ + select name from bandwidth where value = ? + }); + $select->execute($value); + my $res = $select->fetchrow_hashref; + $select->finish; + $res->{name} +} + +sub bandwidth_list { + my ($self) = @_; + my $list = $self->db->prepare(q{ + select * from bandwidth order by value + }); + $list->execute; + return $list->fetchall_arrayref({}); +} + sub country_list { my ($self) = @_; my $list = $self->db->prepare(q{ @@ -83,6 +112,27 @@ sub country_list { return $list->fetchall_arrayref({}); } +sub version_list { + my ($self) = @_; + my $list = $self->db->prepare(q{ + select * from distributions + }); + $list->execute; + return $list->fetchall_hashref([qw(version)]); +} + +sub arch_list { + my ($self, $version) = @_; + my $list = $self->db->prepare(q{ + select * from distributions + } . ($version + ? q{ where version = ? } + : q{}) + ); + $list->execute($version ? $version : ()); + return $list->fetchall_hashref([qw(arch)]); +} + sub mirror_validity { my ($self, $uri) = @_; my $listf = $self->db->prepare(q{ @@ -153,7 +203,7 @@ sub _check_url { my ($fh, $filename) = tempfile(); close($fh); my $cmd = - $furi->scheme =~ /^http|ftp$/ ? "wget -nv -t 1 -T 4 -O $filename " . $furi->as_string : + $furi->scheme =~ /^http|ftp$/ ? "wget --no-check-certificate -nv -t 1 -T 4 -O $filename " . $furi->as_string : $furi->scheme eq 'rsync' ? "rsync --timeout 4 -q " . $furi->as_string . " $filename" : ''; my $ok = (system($cmd) == 0); unlink($filename); @@ -196,6 +246,7 @@ sub find_mirrors { } if (my $field = { protocol => 'protocol', + valid => 'url.valid', }->{$_}) { push(@uw, sprintf('%s = any(?)', $field)); push(@uvals, ref $filters->{$_} ? $filters->{$_} : [ $filters->{$_} ]); @@ -220,17 +271,59 @@ sub _find_urls { }; my @vals; if (keys %{ $filters || {} }) { - $query .= ' where '; my @w; foreach (keys %$filters) { + $filters->{$_} or next; + my $field = { + hostname => 'hosts.hostname', + protocol => 'urls.protocol', + }->{$_} or next; + + push(@w, sprintf('%s = any(?)', $field)); + push(@vals, ref $filters->{$_} ? $filters->{$_} : [ $filters->{$_} ]); + } + $query .= ' where ' if (@w); + $query .= join(' and ', @w); + } + my $list = $self->db->prepare($query); + $list->execute(@vals); + return $list->fetchall_arrayref({}); +} + +sub find_distributions { + my ($self, $filters, $key) = @_; + return [ + map { $_->{url} = $self->fmt_url($_); $_ } + @{ $self->_find_distributions($filters) || []}] +} + +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 + }; + + my @vals; + if (keys %{ $filters || {} }) { + my @w; + foreach (keys %$filters) { + $filters->{$_} or next; my $field = { hostname => 'hosts.hostname', protocol => 'urls.protocol', + version => 'distributions.version', + arch => 'distributions.arch', + country => 'mirrors.country', }->{$_} or next; push(@w, sprintf('%s = any(?)', $field)); push(@vals, ref $filters->{$_} ? $filters->{$_} : [ $filters->{$_} ]); } + $query .= ' where ' if (@w); $query .= join(' and ', @w); } my $list = $self->db->prepare($query); @@ -258,7 +351,7 @@ sub add_or_update_host { my (@fields, @vals); while (my ($field, $val) = each(%info)) { push(@fields, $field); - push(@vals, $val); + push(@vals, $val || undef); } if (keys %info) { my $upd = $self->db->prepare(sprintf(q{ @@ -289,7 +382,7 @@ sub add_or_update_url { } my $update = $self->db->prepare(q{ - update urls set path = ?, port = ? + update urls set path = ?, port = ?, valid = true where hostname = ? and protocol = ? }); @@ -349,6 +442,7 @@ sub find_urls { sub fmt_url { my ($self, $dburl) = @_; + $dburl->{path} =~ s:/+:/:g; my $uri = URI->new( sprintf('%s://%s%s', $dburl->{protocol}, |