view release on metacpan or  search on metacpan

lib/Stem/Msg.pm  view on Meta::CPAN

#print "METH: $method\n" ;

# check if we can deliver there or to msg_in

	unless ( $cell->can( $method ) ) {

		return $self->dump( <<DUMP ) unless( $cell->can( 'msg_in' ) ) ;
missing message delivery methods '$method' and 'msg_in'
DUMP

		$method = 'msg_in' ;
	}

	TraceMsg "MSG to $cell $method" ;

	my @response = $cell->$method( $self ) ;

#print "RESP [@response]\n" ;

# if we get a response then return it in a message

	if ( @response && $self->{'type'} eq 'cmd' ) {

# make the response data a reference

		my $response = shift @response ;
		my $data = ( ref $response ) ? $response : \$response ;

#print $self->dump( 'CMD msg' ) ;
		my $reply_msg = $self->reply(
					'data' => $data,
		) ;

#print $reply_msg->dump( 'AUTO REPONSE' ) ;

		$reply_msg->dispatch() ;
	}

	if ( $self->{'ack_req'} ) {

		my $reply_msg = $self->reply( 'type' => 'msg_ack' ) ;

		$reply_msg->dispatch() ;
	}

	return ;
}

# dump a message for debugging

sub dump {

	my( $self, $label, $deep ) = @_ ;

	require Data::Dumper ;

	my $dump = '' ;
	$label ||= 'UNKNOWN' ;

	my( $file_name, $line_num ) = (caller)[1,2] ;

	$dump .= <<LABEL ;

>>>>
MSG Dump at Line $line_num in $file_name
$label = {
LABEL

	foreach my $type ( @addr_types ) {

		my $addr = $self->{$type} ;

		next unless $addr ;

		my $addr_text = $addr || 'NONE' ;

		$dump .= "\t$type\t=> $addr_text\n" ;
	}

	foreach my $attr ( sort keys %is_plain_attr ) {

		next unless exists $self->{$attr} ;

		my $tab = ( length $attr > 4 ) ? "" : "\t" ;

		my( $val_text, $q, $ret ) ; 

		if ( $deep || $attr eq 'data' ) {

			$val_text = Data::Dumper::Dumper( $self->{$attr} ) ;

			$val_text =~ s/^.+?=// ;
			$val_text =~ s/;\n?$// ;
			$val_text =~ s/^\s+/\t\t/gm ;
			$val_text =~ s/^\s*([{}])/\t$1/gm ;

			$q = '' ;
			$ret = "\n" ;
		}
		else {
			$val_text = $self->{$attr} ;
			$q = $val_text =~ /\D/ ? "'" : '' ;
			$ret = '' ;
		}

		$dump .= <<ATTR ;
	$attr$tab	=> $ret$q$val_text$q,
ATTR

	}

	$dump .= "}\n<<<<\n\n" ;

	return($dump) ;
}

1 ;