File Coverage

blib/lib/Algorithm/Dependency/Weight.pm

Criterion	Covered	Total	%
statement	40	44	90.9
branch	8	20	40.0
condition			n/a
subroutine	11	12	91.6
pod	6	6	100.0
total	65	82	79.2

package Algorithm::Dependency::Weight;
# ABSTRACT: Calculate dependency 'weights'

#pod =pod
#pod
#pod =head1 SYNOPSIS
#pod
#pod   # Create a source from a file
#pod   my $Source = Algorithm::Dependency::Source->new( 'file.txt' );
#pod
#pod   # Create a Weight algorithm object
#pod   my $alg = Algorithm::Dependency::Weight->new( source => $Source );
#pod
#pod   # Find the weight for a single item
#pod   my $weight = $alg->weight('foo');
#pod   print "The weight of 'foo' is $weight\n";
#pod
#pod   # Or a group
#pod   my $hash = $alg->weight_hash('foo', 'bar', 'baz');
#pod   print "The weight of 'foo', 'bar', and 'bar' are $hash->{foo},"
#pod       . " $hash->{bar} and $hash->{baz} respectively\n";
#pod
#pod   # Or all of the items
#pod   my $all = $alg->weight_all;
#pod   print "The following is a list from heaviest to lightest:\n";
#pod   foreach ( sort { $all->{$b} <=> $all->{$a} } keys %$all ) {
#pod       print "$_: $all->{$_}\n";
#pod   }
#pod
#pod =head1 DESCRIPTION
#pod
#pod In dependency systems, it can often be very useful to calculate
#pod an aggregate or sum for one or all items. For example, to find
#pod the "naive install weight" of a Perl distribution (where "naive"
#pod means you treat each distribution equally), you would want the
#pod distribution (1) + all its dependencies (n) + all B
#pod dependencies (n2) recursively downwards.
#pod
#pod If calculated using a normal L object, the
#pod result would be (in a simple systems) equal to:
#pod
#pod   # Create your normal (non-ordered alg:dep)
#pod   my $dependency = Algorithm::Dependency->new( ... );
#pod
#pod   # Find the naive weight for an item
#pod   my $weight = scalar($dependency->schedule('itemname'));
#pod
#pod C provides a way of doing this
#pod with a little more sophistication, and in a way that should work
#pod reasonable well across all the L family.
#pod
#pod Please note that the this might be a little (or more than a little)
#pod slower than it could be for the limited case of generating weights
#pod for all of the items at once in a dependency system with no selected
#pod items and no circular dependencies. BUT you can at least rely on
#pod this class to do the job properly regardless of the particulars of
#pod the situation, which is probably more important.
#pod
#pod =head2 METHODS
#pod
#pod =cut

use 5.005;
use strict;
use List::Util            ();
use Algorithm::Dependency ();
use Params::Util qw{_INSTANCE _STRING};

our $VERSION = '1.111';


#####################################################################
# Constructor and Accessors

#pod =pod
#pod
#pod =head2 new @params
#pod
#pod The C constructor creates a new C
#pod object. It takes a number of key/value pairs as parameters (although
#pod at the present time only one).
#pod
#pod =over 4
#pod
#pod =item source => $Source
#pod
#pod The C param is mostly the same as for L.
#pod The one addition is that as a source you can provide an
#pod L object, and the L
#pod for that will be used.
#pod
#pod =back
#pod
#pod Returns a new C object, or C on error.
#pod
#pod =cut

sub new {
	my $class = shift;
	my %args  = @_;

	# Get the source object, or derive it from an existing alg-dep
	my $source = _INSTANCE($args{source}, 'Algorithm::Dependency')
		? $args{source}->source
		: _INSTANCE($args{source}, 'Algorithm::Dependency::Source')
		or return undef;

	# Build the alg-dep object we use
	my $algdep = Algorithm::Dependency->new(
		source         => $source,
		ignore_orphans => 1,
		) or return undef;

	# Create the basic object
	my $self = bless {
		source => $source,
		algdep => $algdep,
		weight => {},
		}, $class;

	$self;
}

#pod =pod
#pod
#pod =head2 source
#pod
#pod The C accessor returns the source used for the weight calculations.
#pod
#pod This will be either the one passed to the constructor, or the source from
#pod inside the C object passed as the C param
#pod (B the object itself, B source).
#pod
#pod =cut

sub source {
	$_[0]->{source}
}





#####################################################################
# Algorithm::Dependency::Weight Methods

#pod =pod
#pod
#pod =head2 weight $name
#pod
#pod The C method takes the name of a single item and calculates its
#pod weight based on the configuration of the C
#pod object.
#pod
#pod Returns the weight as a scalar (which in the naive case will be an
#pod integer, but in more complex uses may be any real number), or C
#pod on error.
#pod
#pod =cut

sub weight {
	my $self = shift;
	my $id   = defined(_STRING($_[0])) ? shift : return undef;
	$self->{weight}->{$id} or
	$self->{weight}->{$id} = $self->_weight($id);
}

sub _weight {
	my $self  = shift;
	my $items = $self->{algdep}->schedule($_[0]) or return undef;
	scalar(@$items);
}

#pod =pod
#pod
#pod =head2 weight_merged @names
#pod
#pod The C method takes the name of a set of items and
#pod calculates an aggregated weight for the whole set.
#pod
#pod Returns the weight as a scalar, or C on error.
#pod
#pod =cut

sub weight_merged {
	my $self  = shift;
	my $items = $self->{algdep}->schedule(@_) or return undef;
	scalar(@$items);
}

#pod =pod
#pod
#pod =head2 weight_hash @names
#pod
#pod The C method takes a list of item names, and calculates
#pod their weights.
#pod
#pod Returns a reference to a C with the item names as keys and weights
#pod as values, or C on error.
#pod
#pod =cut

sub weight_hash {
	my $self  = shift;
	my @names = @_;

	# Iterate over the list
	my %hash = ();
	foreach my $name ( @names ) {
		if ( $self->{weight}->{$name} ) {
			$hash{$name} = $self->{weight}->{$name};
			next;
		}
		$hash{$name} = $self->weight($name) or return undef;
	}

	\%hash;
}

#pod =pod
#pod
#pod =head2 weight_all
#pod
#pod The C method provides the one-shot method for getting the
#pod weights of all items at once. Please note that this does not do
#pod anything different or special, but is slightly faster than iterating
#pod yourself.
#pod
#pod Returns a reference to a C with the item names as keys and weights
#pod as values, or C on error.
#pod
#pod =cut

sub weight_all {
	my $self  = shift;
	my @items = $self->source->items;
	defined $items[0] or return undef;
	$self->weight_hash( map { $_->id } @items );
}

1;

__END__