package Gentoo::MirrorList;
 
# ABSTRACT: A programmatic way to access Gentoo.org Mirror Metadata
 
use strict;
use warnings;
use Moose;
use App::Cache;
use namespace::autoclean;
use Gentoo::MirrorList::Mirror;
 
=head1 SYNOPSIS
 
  my @mirrors = Gentoo::MirrorList->region('North America')->country('CA')->ipv4;
  my $mirror = Gentoo::MirrorList->region('North America')->random();
 
=cut
 
has _cache => (
  isa     => 'App::Cache',
  is      => 'ro',
  lazy    => 1,
  default => sub {
    return App::Cache->new( { ttl => 60 * 60, application => __PACKAGE__ } );
  },
);
 
has '_data' => (
  isa        => 'ArrayRef[ Gentoo::MirrorList::Mirror ]',
  is         => 'rw',
  lazy_build => 1,
  traits     => [qw[ Array ]],
  handles    => { filter => 'grep', },
);
 
has '_xml' => (
  isa        => 'Str',
  is         => 'ro',
  lazy_build => 1,
);
 
sub _normalise_mirrorgroup {
  my ( $self, $mirrorgroup ) = @_;
  if ( exists $mirrorgroup->{mirror}->{uri} and exists $mirrorgroup->{mirror}->{name} ) {
    $mirrorgroup->{mirror} = { $mirrorgroup->{mirror}->{name} => { uri => $mirrorgroup->{mirror}->{uri} } };
  }
  for my $name ( keys %{ $mirrorgroup->{mirror} } ) {
    if ( ref $mirrorgroup->{mirror}->{$name}->{uri} eq 'HASH' ) {
      $mirrorgroup->{mirror}->{$name}->{uri} = [ $mirrorgroup->{mirror}->{$name}->{uri} ];
    }
  }
  return $mirrorgroup;
}
 
sub __build_mirrorgroup {
  my ( $self, $mirrorgroup ) = @_;
  $mirrorgroup = $self->_normalise_mirrorgroup($mirrorgroup);
  my @mirrors = ();
  use Data::Dumper;
  print Dumper($mirrorgroup);
  my %data = (
    country     => $mirrorgroup->{country},
    countryname => $mirrorgroup->{countryname},
    region      => $mirrorgroup->{region},
  );
 
  for my $mirrorname ( keys %{ $mirrorgroup->{mirror} } ) {
    for my $uri ( @{ $mirrorgroup->{mirror}->{$mirrorname}->{uri} } ) {
      push @mirrors,
        Gentoo::MirrorList::Mirror->new(
        %data,
        mirrorname => $mirrorname,
        uri        => $uri->{content},
        proto      => $uri->{protocol},
        ipv4       => $uri->{ipv4},
        ipv6       => $uri->{ipv6},
        partial    => $uri->{partial},
        );
 
    }
  }
  return (@mirrors);
}
 
sub _build__data {
  my ($self) = @_;
 
  my $r = $self->_cache->get('data');
  if ($r) {
    return $r;
  }
  my $content = $self->_xml;
  require XML::Simple;
  my $structure = XML::Simple::xml_in($content);
 
  my @rows;
  for ( @{ $structure->{'mirrorgroup'} } ) {
    push @rows, $self->__build_mirrorgroup($_);
  }
 
  $self->_cache->set( 'data', \@rows );
  return \@rows;
}
 
sub _build__xml {
  my ($self) = @_;
  return $self->_cache->get_url('http://www.gentoo.org/main/en/mirrors3.xml');
}
 
sub _filter {
  my ( $self, $property, $param ) = @_;
  $self->_data(
    $self->_data->_filter(
      sub {
        return $_->property_match( $property, $param );
      }
    )
  );
}
 
sub _unfilter {
  my ( $self, $property, $param ) = @_;
  $self->_data(
    $self->_data->_filter(
      sub {
        return not $_->property_match( $property, $param );
      }
    )
  );
}
 
for my $property (qw( country countryname region mirrorname uri proto ipv4 ipv6 partial )) {
  __PACKAGE__->meta->add_method(
    $property => sub {
      my ( $self, $param ) = @_;
      $self = $self->new() unless ref $self;
      $self->_filter( $property, $param );
      return $self;
    }
  );
}
for my $property (qw( country countryname region mirrorname uri proto )) {
  __PACKAGE__->meta->add_method(
    'exclude_' . $property => sub {
      my ( $self, $param ) = @_;
      $self = $self->new() unless ref $self;
      $self->_unfilter( $property, $param );
      return $self;
    }
  );
}
 
for my $property (qw( ipv4 ipv6 partial )) {
  __PACKAGE__->meta->add_method(
    'is_' . $property => sub {
      my ( $self, $param ) = @_;
      $self = $self->new() unless ref $self;
      $self->_filter( $property, 1 );
    }
  );
  __PACKAGE__->meta->add_method(
    'not_' . $property => sub {
      my ( $self, $param ) = @_;
      $self = $self->new() unless ref $self;
      $self->_filter( $property, 1 );
    }
  );
}
 
1;
 
 

package Gentoo::MirrorList::Mirror;
 
# ABSTRACT: An objective representation of a single gentoo mirror
 
use strict;
use warnings;
use Moose;
use namespace::autoclean;
 
my %bools = ();
my %strs  = ();
 
for (qw(  country countryname region mirrorname uri proto )) {
  has $_ => (
    isa      => 'Str',
    is       => 'ro',
    required => 1,
    traits   => [qw( String )],
    handles  => { $_ . '_match' => 'match' }
  );
  $strs{$_} = 1;
}
for (qw( ipv4 ipv6 partial )) {
  has $_ => ( isa => 'Bool', is => 'ro', required => 1 );
  $bools{$_} = 1;
}
 
around BUILDARGS => sub {
  my ( $orig, $class, @args ) = @_;
  for my $argno ( 0 .. $#args ) {
    last if not exists $args[ $argno + 1 ];
    for my $bool ( keys %bools ) {
      if ( $args[$argno] eq $bool ) {
 
        if ( $args[ $argno + 1 ] =~ /^Y$/i ) {
          $args[ $argno + 1 ] = 1;
        }
        if ( $args[ $argno + 1 ] =~ /^N$/i ) {
          $args[ $argno + 1 ] = '';
        }
      }
    }
  }
  return $class->$orig(@args);
};
 
sub property_match {
  my ( $self, $property, $value ) = @_;
  if ( not exists $bools{$property} and not exists $strs{$property} ) {
    require Carp;
    Carp::confess("Cannot match with property `$property`");
  }
  if ( exists $bools{$property} ) {
    my $sub = $self->can($property);
 
    # Xand
    # 0 & 0 ==> 1
    # 1 & 0 ==> 0
    # 0 & 1 ==> 0
    # 1 & 1 ==> 1
    # Xand == !Xor
    return ( not( $value xor $self->$property() ) );
  }
  if ( exists $strs{$property} ) {
    my $sub = $self->can( $property . "_match" );
    return $self->$sub($value);
  }
}
 
1;