view release on metacpan or  search on metacpan

lib/Log/Shiras/Switchboard.pm  view on Meta::CPAN

		init_arg  => undef,
		builder   => '_build_data_walker',
		#~ lazy => 1,
	);

has _can_communicate_cash =>(
		isa		=> HashRef,
		traits	=> ['Hash'],
		clearer	=> '_clear_can_communicate_cash',
		handles	=>{
			_has_can_com_cash	=> 'exists',
			_set_can_com_cash	=> 'set',
			_get_can_com_cash	=> 'get',
		},
		init_arg => undef,
		default	=> sub{ {} },
	);

has _test_buffer =>(
		isa		=> HashRef[ArrayRef],
		clearer	=> '_clear_all_test_buffers',
		traits	=> ['Hash'],
		handles	=>{
			_has_test_buffer	=> 'exists',
			_set_test_buffer	=> 'set',
			_get_test_buffer	=> 'get',
		},
		default	=> sub{ {} },
	);

#########1 Private Methods    3#########4#########5#########6#########7#########8#########9

sub _can_communicate{
	my ( $self, $report, $level, $name_string ) = @_;
	###InternalSwitchboarD	$self->master_talk( { report => 'log_file', level => 2,
	###InternalSwitchboarD		name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate',
	###InternalSwitchboarD		message =>[ "Arrived at _can_communicate to see if report: $report",
	###InternalSwitchboarD					"- will accept a call at the urgency of: $level",
	###InternalSwitchboarD					"- from the name_space: $name_string" ], } );
	my $cash_string = $name_string . $report . $level;
	my $pass = 0;
	my $x = "Report -$report- is NOT UNBLOCKed for the name-space: $name_string";
	if( $self->_has_can_com_cash( $cash_string ) ){
		( $pass, $x ) = @{$self->_get_can_com_cash( $cash_string )};
		###InternalSwitchboarD	$self->master_talk( { report => 'log_file', level => 1,
		###InternalSwitchboarD		name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate',
		###InternalSwitchboarD		message =>[ "Found the permissions cached: $pass" ], } );
	}else{
		my	$source_space = $self->get_name_space;
		return $pass if !keys %$source_space;
		my 	@telephone_name_space = ( split /::/, $name_string );
		###InternalSwitchboarD	$self->master_talk( { report => 'log_file', level => 1,
		###InternalSwitchboarD		name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate',
		###InternalSwitchboarD		message =>[ 'Consolidating permissions for the name space:', @telephone_name_space ,
		###InternalSwitchboarD					'against the source space:', $source_space ], } );
		my 	$level_ref = {};
		$level_ref = $self->_get_block_unblock_levels( $level_ref, $source_space );
		###InternalSwitchboarD	$self->master_talk( { report => 'log_file', level => 1,
		###InternalSwitchboarD		name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate',
		###InternalSwitchboarD		message =>[ '_get_block_unblock_levels returned returned the level ref:', $level_ref ], } );
		SPACETEST: for my $next_level ( @telephone_name_space ){
			###InternalSwitchboarD	$self->master_talk( { report => 'log_file', level => 1,
			###InternalSwitchboarD		name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate',
			###InternalSwitchboarD		message =>[ "Checking for additional adjustments at: $next_level" ], } );
			if( exists $source_space->{$next_level} ){
				$source_space = clone( $source_space->{$next_level} );
				###InternalSwitchboarD	$self->master_talk( { report => 'log_file', level => 1,
				###InternalSwitchboarD		name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate',
				###InternalSwitchboarD		message =>[ "The next level -$next_level- exists", $source_space ], } );
				$level_ref = $self->_get_block_unblock_levels( $level_ref, $source_space );
				###InternalSwitchboarD	$self->master_talk( { report => 'log_file', level => 1,
				###InternalSwitchboarD		name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate',
				###InternalSwitchboarD		message =>[ '_get_block_unblock_levels returned the level ref:', $level_ref ], } );
			}else{
				###InternalSwitchboarD	$self->master_talk( { report => 'log_file', level => 1,
				###InternalSwitchboarD		name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate',
				###InternalSwitchboarD		message =>[ "Didn't find the next level -$next_level-" ], } );
				last SPACETEST;
			}
		}
		###InternalSwitchboarD	$self->master_talk( { report => 'log_file', level => 1,
		###InternalSwitchboarD		name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate',
		###InternalSwitchboarD		message =>[ 'Final level collection is:', $level_ref,
		###InternalSwitchboarD					"Checking for the report name in the consolidated level ref"], } );
		REPORTTEST: for my $key ( keys %$level_ref ){
			###InternalSwitchboarD	$self->master_talk( { report => 'log_file', level => 0,
			###InternalSwitchboarD		name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate',
			###InternalSwitchboarD		message =>[ "Testing: $key" ], } );
			if( $key =~ /$report/i ){
				###InternalSwitchboarD	$self->master_talk( { report => 'log_file', level => 0,
				###InternalSwitchboarD		name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate',
				###InternalSwitchboarD		message =>[ "Matched key to the target report: $report" ], } );
				my $allowed = $self->_convert_level_name_to_number( $level_ref->{$key}, $report );
				###InternalSwitchboarD	$self->master_talk( { report => 'log_file', level => 0,
				###InternalSwitchboarD		name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate',
				###InternalSwitchboarD		message =>[ "The allowed level for -$report- is: $allowed" ], } );
				my $attempted = $self->_convert_level_name_to_number( $level, $report );
				###InternalSwitchboarD	$self->master_talk( { report => 'log_file', level => 0,
				###InternalSwitchboarD		name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate',
				###InternalSwitchboarD		message =>[ "The attempted level for -$level- is: $attempted" ], } );
				if( $attempted >= $allowed ){
					$x = "The message clears for report -$report- at level: $level";
					$pass = 1 ;
				}else{
					$x = "The destination -$report- is UNBLOCKed but not to the -$level- level at the name space: $name_string";
				}
				last REPORTTEST;
			}
		}
		$self->_set_can_com_cash( $cash_string => [ $pass, $x ] );
	}
	###InternalSwitchboarD	$self->master_talk( { report => 'log_file', level => 2,
	###InternalSwitchboarD		name_space => 'Log::Shiras::Switchboard::master_talk::_can_communicate',
	###InternalSwitchboarD		message =>[ $x ], } );
	return $pass;
}

sub _add_caller{
	my ( $self, $data_ref ) = @_;
	my $level = 2;
	if( !exists $data_ref->{source_sub} ){
		$data_ref->{source_sub} = 'Log::Shiras::Switchboard::master_talk';
		$level = 1;
	}
	###InternalSwitchboarD	$self->master_talk( { report => 'log_file', level => 2,
	###InternalSwitchboarD		name_space => 'Log::Shiras::Switchboard::master_talk::_add_caller',
	###InternalSwitchboarD		message =>[ "Arrived at _get_caller for start level (up): $level",
	###InternalSwitchboarD					"and source sub: $data_ref->{source_sub}",  ], } );
	my( $caller_ref, $complete, $last_ref,);
	while( !$complete ){
		@$caller_ref{qw( package filename line subroutine )} = (caller($level))[0..3];
		###InternalSwitchboarD	$self->master_talk( { report => 'log_file', level => 0,
		###InternalSwitchboarD		name_space => 'Log::Shiras::Switchboard::master_talk::_add_caller',
		###InternalSwitchboarD		message =>[ "Retrieved caller data from up level: $level", $caller_ref ], } );
		if( $caller_ref->{subroutine} eq $data_ref->{source_sub} ){
			###InternalSwitchboarD	$self->master_talk( { report => 'log_file', level => 1,
			###InternalSwitchboarD		name_space => 'Log::Shiras::Switchboard::master_talk::_add_caller',
			###InternalSwitchboarD		message =>[ "Matched: $data_ref->{source_sub}" ], } );