File Coverage

blib/lib/Gentoo/Overlay/Group.pm

Criterion	Covered	Total	%
statement	8	10	80.0
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	12	14	85.7

use strict;
use warnings;

package Gentoo::Overlay::Group;
BEGIN {
  $Gentoo::Overlay::Group::AUTHORITY = 'cpan:KENTNL';
}
{
  $Gentoo::Overlay::Group::VERSION = '0.2.0';
}

# ABSTRACT: A collection of Gentoo::Overlay objects.

use Moose;

use MooseX::Has::Sugar;
use MooseX::Types::Moose qw( :all );
use MooseX::Types::Path::Tiny qw( Dir );
use namespace::autoclean;

use Gentoo::Overlay v1.0.3;
use Gentoo::Overlay::Types qw( :all );
use Gentoo::Overlay::Exceptions qw( :all );
use Scalar::Util qw( blessed );



has '_overlays' => (
  ro, lazy,
  isa => HashRef [Gentoo__Overlay_Overlay],
  traits  => [qw( Hash )],
  default => sub { return {} },
  handles => {
    _has_overlay  => exists   =>,
    overlay_names => keys     =>,
    overlays      => elements =>,
    get_overlay   => get      =>,
    _set_overlay  => set      =>,
  },
);

my $_str = Str();


sub _type_print {
  return
      ref $_     ? ref $_
    : defined $_ ? 'scalar<' . $_ . '>'
    : 'scalar=undef'

}


sub add_overlay {
  my ( $self, @args ) = @_;
  if ( @args == 1 and blessed $args[0] ) {
    goto $self->can('_add_overlay_object');
  }
  if ( $_str->check( $args[0] ) ) {
    goto $self->can('_add_overlay_string_path');
  }
  return exception(
    ident   => 'bad overlay type',
    message => qq{Unrecognised parameter types passed to add_overlay. Expected: \n%{signatures}s. Got: [%{type}s]},
    payload => {
      signatures => ( join q{},  map { qq{    \$group->add_overlay( $_ );\n} } qw( Str Path::Tiny Gentoo::Overlay ) ),
      type       => ( join q{,}, map { _type_print } @args ),
    }
  );
}


sub iterate {
  my ( $self, $what, $callback ) = @_;
  my %method_map = (
    ebuilds    => _iterate_ebuilds    =>,
    categories => _iterate_categories =>,
    packages   => _iterate_packages   =>,
    overlays   => _iterate_overlays   =>,
  );
  if ( exists $method_map{$what} ) {
    goto $self->can( $method_map{$what} );
  }
  return exception(
    ident   => 'bad iteration method',
    message => 'The iteration method %{what_method}s is not a known way to iterate.',
    payload => { what_method => $what, },
  );
}


sub _iterate_ebuilds {
  my ( $self, $what, $callback ) = @_;
  my $real_callback = sub {
    my (%package_config) = %{ $_[1] };
    my $inner_callback = sub {
      my (%ebuild_config) = %{ $_[1] };
      $self->$callback( { ( %package_config, %ebuild_config ) } );
    };
    $package_config{package}->_iterate_ebuilds( ebuilds => $inner_callback );
  };
  $self->_iterate_packages( packages => $real_callback );
  return;
}


# categories = { /overlays/categories

sub _iterate_categories {
  my ( $self, $what, $callback ) = @_;
  my $real_callback = sub {
    my (%overlay_config) = %{ $_[1] };
    my $inner_callback = sub {
      my (%category_config) = %{ $_[1] };
      $self->$callback( { ( %overlay_config, %category_config ) } );
    };
    $overlay_config{overlay}->_iterate_categories( categories => $inner_callback );
  };
  $self->_iterate_overlays( overlays => $real_callback );
  return;
}


sub _iterate_packages {
  my ( $self, $what, $callback ) = @_;
  my $real_callback = sub {
    my (%category_config) = %{ $_[1] };
    my $inner_callback = sub {
      my (%package_config) = %{ $_[1] };
      $self->$callback( { ( %category_config, %package_config ) } );
    };
    $category_config{category}->_iterate_packages( packages => $inner_callback );
  };
  $self->_iterate_categories( categories => $real_callback );
  return;
}


# overlays = { /overlays }
sub _iterate_overlays {
  my ( $self, $what, $callback ) = @_;
  my %overlays     = $self->overlays;
  my $num_overlays = scalar keys %overlays;
  my $last_overlay = $num_overlays - 1;
  my $offset       = 0;
  for my $overlay_name ( sort keys %overlays ) {
    local $_ = $overlays{$overlay_name};
    $self->$callback(
      {
        overlay_name => $overlay_name,
        overlay      => $overlays{$overlay_name},
        num_overlays => $num_overlays,
        last_overlay => $last_overlay,
        overlay_num  => $offset,
      }
    );
    $offset++;
  }
  return;
}

my $_gentoo_overlay = Gentoo__Overlay_Overlay();
my $_path_class_dir = Dir();

# This would be better in M:M:TypeCoercion


sub __can_corce {
  my ( $to_type, $from_thing ) = @_;
  if ( not defined $to_type->{_compiled_can_coerce} ) {
    my @coercion_map = @{ $to_type->type_coercion_map };
    my @coercions;
    while (@coercion_map) {
      my ( $constraint_name, $action ) = ( splice @coercion_map, 0, 2 );
      my $type_constraint =
        ref $constraint_name ? $constraint_name : Moose::Util::TypeConstraints::find_or_parse_type_constraint($constraint_name);

      if ( not defined $type_constraint ) {
        require Moose;
        Moose->throw_error("Could not find the type constraint ($constraint_name) to coerce from");
      }

      push @coercions => [ $type_constraint->_compiled_type_constraint, $action ];
    }
    $to_type->{_compiled_can_coerce} = sub {
      my $thing = shift;
      foreach my $coercion (@coercions) {
        my ( $constraint, $converter ) = @{$coercion};
        if ( $constraint->($thing) ) {
          return 1;
        }
      }
      return;
    };
  }
  return $to_type->{_compiled_can_coerce}->($from_thing);
}


sub _add_overlay_object {
  my ( $self, $object, @rest ) = @_;

  if ( $_gentoo_overlay->check($object) ) {
    goto $self->can('_add_overlay_gentoo_object');
  }
  if ( $_path_class_dir->check($object) ) {
    goto $self->can('_add_overlay_path_class');
  }
  return exception(
    ident   => 'bad overlay object type',
    message => qq{Unrecognised parameter object types passed to add_overlay. Expected: \n%{signatures}s. Got: [%{type}s]},
    payload => {
      signatures => ( join q{}, map { qq{    \$group->add_overlay( $_ );\n} } qw( Str Path::Tiny Gentoo::Overlay ) ),
      type => ( join q{,}, blessed $object, map { _type_print } @rest ),
    },
  );
}


sub _add_overlay_gentoo_object {
  my ( $self, $object, @rest ) = @_;
  $_gentoo_overlay->assert_valid($object);
  if ( $self->_has_overlay( $object->name ) ) {
    return exception(
      ident   => 'overlay exists',
      message => 'The overlay named %{overlay_name}s is already added to this group.',
      payload => { overlay_name => $object->name },
    );
  }
  $self->_set_overlay( $object->name, $object );
  return;
}


sub _add_overlay_path_class {    ## no critic ( RequireArgUnpacking )
  my ( $self, $path, @rest ) = @_;
  $_path_class_dir->assert_valid($path);
  my $go = Gentoo::Overlay->new( path => $path, );
  @_ = ( $self, $go );
  goto $self->can('_add_overlay_gentoo_object');
}


sub _add_overlay_string_path {    ## no critic ( RequireArgUnpacking )
  my ( $self, $path_str, @rest ) = @_;
  $_str->assert_valid($path_str);
  my $path = $_path_class_dir->coerce($path_str);
  @_ = ( $self, $path );
  goto $self->can('_add_overlay_path_class');
}

__PACKAGE__->meta->make_immutable;
no Moose;

1;

__END__

=pod

=head1 NAME

Gentoo::Overlay::Group - A collection of Gentoo::Overlay objects.

=head1 VERSION

version 0.2.0

=head1 SYNOPSIS

This is a wrapper around L<< C<Gentoo::Overlay>|Gentoo::Overlay >> that makes it easier to perform actions on a group of overlays.

  my $group = Gentoo::Overlay::Group->new();
  $group->add_overlay('/usr/portage');
  $group->add_overlay('/usr/local/portage/');
  $group->iterate( packages => sub {
    my ( $self, $context ) = @_;
    # Traverse-Order:
    # ::gentoo
    #   category_a
    #     package_a
    #     package_b
    #   category_b
    #     package_a
    #     package_b
    # ::hentoo
    #   category_a
    #     package_a
    #     package_b
    #   category_b
    #     package_a
    #     package_b
  });

=head1 METHODS

=head2 add_overlay

  $object->add_overlay( '/path/to/overlay' );
  $object->add_overlay( Path::Tiny::path( '/path/to/overlay' ) );
  $object->add_overlay( Gentoo::Overlay->new( path => '/path/to/overlay' ) );

=head2 iterate

  $object->iterate( ebuilds => sub {


  });

=head1 ATTRIBUTE ACCESSORS

=head2 overlay_names

  my @names = $object->overlay_names

=head2 overlays

  my @overlays = $object->overlays;

=head2 get_overlay

  my $overlay = $object->get_overlay('gentoo');

=head1 PRIVATE ATTRIBUTES

=head2 _overlays

  isa => HashRef[ Gentoo__Overlay_Overlay ], ro, lazy

=head1 PRIVATE ATTRIBUTE ACCESSORS

=head2 _has_overlay

  if( $object->_has_overlay('gentoo') ){
    Carp::croak('waah');
  }

=head2 _set_overlay

  $object->_set_overlay( 'gentoo' => $overlay_object );

=head1 PRIVATE FUNCTIONS

=head2 _type_print

Lightweight flat dumper optimized for displaying user parameters in a format similar to a method signature.

  printf '[%s]', join q{,} , map { _type_print } @array

=head2 __can_coerce

  if( __can_coerce( MX::Type Object , $thing_to_coerce ) ) {

  }

=head1 PRIVATE METHODS

=head2 _iterate_ebuilds

  $object->_iterate_ebuilds( ignored => sub { } );

=head2 _iterate_categories

  $object->_iterate_categories( ignored => sub { } );

=head2 _iterate_packages

  $object->_iterate_packages( ignored => sub { } );

=head2 _iterate_overlays

  $object->_iterate_overlays( ignored => sub { } );

=head2 _add_overlay_object

  $groupobject->_add_overlay_object( $object );

=head2 _add_overlay_gentoo_object

  $groupobject->_add_overlay_gentoo_object( $gentoo_object );

=head2 _add_overlay_path_class

  $groupobject->_add_overlay_path_class( $path_class_object );

=head2 _add_overlay_string_path

  $groupobject->_add_overlay_string_path( $path_string );

=head1 AUTHOR

Kent Fredric <[e-mail]>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2013 by Kent Fredric <[e-mail]>.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut