view release on metacpan or  search on metacpan

lib/Basset/Object.pm  view on Meta::CPAN

			}
		} else {
			return $self->error("Object cannot perform method ($method)", "BO-10");
		};
	};

	if (@errors) {
		return $self->error(join("\n", @errors), join("\n", @codes));
	} else {
		return 1;
	};

};

=pod

=item stack_trace

A method useful for debugging. When called, returns a stack trace.

sub some_method {
	my $self = shift;
	#you know something weird happens here.
	print STDERR $self->stack_trace();
};

=cut

=pod

=begin btest(stack_trace)

sub tracer {
	return __PACKAGE__->stack_trace;
};

$test->ok(tracer(), "Got a stack trace");
my $trace = tracer();
$test->ok($trace, "Has a stack trace");
$test->like($trace, qr/Package:/, "Contains word: 'Package:'");
$test->like($trace, qr/Filename:/, "Contains word: 'Filename:'");
$test->like($trace, qr/Line number:/, "Contains word: 'Line number:'");
$test->like($trace, qr/Subroutine:/, "Contains word: 'Subroutine:'");
$test->like($trace, qr/Has Args\? :/, "Contains word: 'Has Args:'");
$test->like($trace, qr/Want array\? :/, "Contains word: 'Want array:'");
$test->like($trace, qr/Evaltext:/, "Contains word: 'Evaltext:'");
$test->like($trace, qr/Is require\? :/, "Contains word: 'Is require:'");

=end btest(stack_trace)

=cut

sub stack_trace {
	my $caller_count = 1;
	my $caller_stack = undef;
	my @verbose_caller = ("Package: ", "Filename: ", "Line number: ", "Subroutine: ", "Has Args? : ",
							"Want array? : ", "Evaltext: ", "Is require? : ");

	push @verbose_caller, ("Hints:  ", "Bitmask:  ") if $] >= 5.006;	#5.6 has a more verbose caller stack.

	while (my @caller = caller($caller_count++)){
		$caller_stack .= "\t---------\n";
		foreach (0..$#caller){
			my $callvalue = defined $caller[$_] ? $caller[$_] : '';
			$caller_stack .= "\t\t$verbose_caller[$_]$callvalue\n";# if $caller[$_];
		};
	};

	$caller_stack .= "\t---------\n";
	return $caller_stack;
};

=pod

=item no_op

no_op is a simple little method that just always returns 1, no matter what. Useful for cases where
you want to be able to call a method and have it succeed, such as a generic place holder.

=cut

=pod

=begin btest(no_op)

$test->ok(__PACKAGE__->no_op, "No op");
$test->is(__PACKAGE__->no_op, 1, "No op is 1");
my $obj = __PACKAGE__->new();
$test->ok($obj, "Got object");
$test->ok($obj->no_op, "Object no ops");
$test->is($obj->no_op, 1, "Object no op is 1");

=end btest(no_op)

=cut

sub no_op { return 1 };

=pod

=item system_prefix

Returns the prefix used by the system for internal methods as generated by add_attr and the like.

=cut

=pod

=begin btest(system_prefix)

$test->is(__PACKAGE__->system_prefix(), '__b_', 'expected system prefix');

=end btest(system_prefix)

=cut

sub system_prefix { return '__b_'};

=pod

=item privatize