File Coverage

blib/lib/Paths/Graph.pm

Criterion	Covered	Total	%
statement	55	94	58.5
branch	11	36	30.5
condition	7	21	33.3
subroutine	6	8	75.0
pod	4	7	57.1
total	83	166	50.0

package Paths::Graph;

@ISA = qw(Exporter);
@EXPORT_OK = qw/shortest_path() free_path_event() debug()/;

require 5.005_62;
our $VERSION = '0.03';

use strict;

# New Object
sub new {
        my ($class , %vals)  = @_;
	my $self;
        bless $self = {
			graph   => $vals{-graph},
			origin  => $vals{-origin},
			destiny => $vals{-destiny},
			sub	=> $vals{-sub},
	} , $class;
	return $self;
}

# Push array of array to analisys the graph's shortest cost.
sub push_paths {
        my ($self,@nodes) = @_;
	push @{$self->{paths}} , \@nodes;
}

# Return the result of nodes in recursive path
sub get_path_cost {
        my ($self,@nodes) = @_;
        return unless @nodes;
	my $ant_node = shift @nodes;
	my $cur_node = shift @nodes;
	return 0 if (!$cur_node) ||
		    ($ant_node eq $cur_node) ||
		    (!$self->{graph}{$ant_node}{$cur_node});
	return  $self->{graph}{$ant_node}{$cur_node} + $self->get_path_cost($cur_node,@nodes);
}

# Famous algorithm to get all possibles paths into the graph.
sub shortest_path {
	my ($self,$father) = @_;
	$father = 'zero' if $father eq '0';
	my $tmp = $self->{sub} if $self->{sub};
	$self->{sub} = \&push_paths;
	$self->free_path_event($father);
	$self->{sub} = $tmp;
	my ($minor_cost,$pass,%paths_minor_cost) = (0,0,());
	for my $path (@{$self->{paths}}) {
		my $cost = $self->get_path_cost(@{$path});
		if ( ($cost <= $minor_cost) || ($minor_cost == 0) ) {
			push @{$paths_minor_cost{$cost}} , $path;
			$minor_cost = $cost;
		}
		$pass=1;
	}
	return @{$paths_minor_cost{$minor_cost}} if $pass;
	return [0] unless $pass;
}

#Execution time for feedback of the graph's paths.
sub free_path_event {
	my ($self , $father ) = @_;
	$father = 'zero' if $father eq '0';
	$father = $self->{origin} unless $father;
	$self->{fathers}{$father}=1;
	push @{$self->{path}} , $father;
	foreach my $node (keys %{$self->{graph}{$father}}) {
		my $pass=0;
		$pass=1 if $node eq $self->{origin} || $node eq $self->{destiny};
		if ($node eq $self->{destiny}) {
			push @{$self->{path}} , $self->{destiny};
			$self->{sub}->($self,@{$self->{path}});
			pop @{$self->{path}};
		}
		$self->free_path_event($node) if (!$self->{fathers}{$node}) && (!$pass);
	}
	$self->{fathers}{$father}=0;
	pop @{$self->{path}};
}

#Educational method to undertand the steps to trace the graph.
sub debug {
	my ($self , $father ,$level) = @_;
	$father = 'zero' if $father eq '0';
	$level = 1 unless $level;
	$father = $self->{origin} unless $father;
	$self->debug_msg($level,"Node:[$father] Save node into path hash\n");
	$self->{fathers}{$father}=1;
	push @{$self->{path}} , $father;
	$self->debug_msg($level,"Node:[$father] Finding path into graph hash\n");
	foreach my $node (keys %{$self->{graph}{$father}}) {
		my $pass=0;
		$self->debug_msg($level,"_Node:[$node] Checking if is not origin or detiny Node\n");
		if ($node eq $self->{origin} || $node eq $self->{destiny}) {
			$self->debug_msg($level,"__Node:[$node] Is equal\n");
			$pass=1
		} else {
			$self->debug_msg($level,"__Node:[$node] Is not equal\n");
		}
		$self->debug_msg($level,"_Node:[$node] Checking is Node equal destiny Node\n");
		if ($node eq $self->{destiny}) {
			$self->debug_msg($level,"__Node:[$node] Is equal\n");
			$self->debug_msg($level,"__Got Current Path :" . join("->",@{$self->{path}}) . "\n") ;
			push @{$self->{path}} , $self->{destiny};
			#$self->{sub}->($self, @{$self->{path}});
			pop @{$self->{path}};
		} else {
			$self->debug_msg($level,"__Node:[$node] Is not equal\n");
		}
		$self->debug_msg($level,"_Node:[$node] Calling method self recurcive\n");
		$self->debug($node,$level + 1) if (!$self->{fathers}{$node}) && (!$pass);
	}
	$level--;
	$self->{fathers}{$father}=0;
	my $tmp = pop @{$self->{path}};
	$self->debug_msg($level,"Node[$father] Exiting Node\n");
}

# Show messages sended from education method debug
sub debug_msg {
	my ($self, $level , $msg ) = @_;
	print "|_" for 1 .. $level;
	print $msg;
	sleep 1;
}


1;
__END__