Pangloss::Object - base class for all Pangloss objects.

Pangloss documentation Contained in the Pangloss distribution.

Index

Code Index:

NAME

Top

Pangloss::Object - base class for all Pangloss objects.

SYNOPSIS

Top

 package Foo;
 use base qw( Pangloss::Object );

 # Pangloss::accessors is loaded for you:
 use accessors qw( bar );

 my $foo = Foo->new( @optional_args )->bar('baz');

 $Pangloss::DEBUG{ Foo } = 1;
 $Pangloss::DEBUG{ ALL } = 1;

 $foo->emit( 'a message' );

DESCRIPTION

Top

Base class for Pangloss objects.

METHODS

Top

$obj = $class->new( @args )

creates and returns a new object, if $obj->init( @args ) returns a true value.

$bool = $obj->init( @args )

does nothing by default. a false return value means initialization failed.

$obj = $obj->emit( $msg )

emits $msg if debugging is enabled for this object's class. can also be called as a class method.

CLASS VARIABLES

Top

%Pangloss::DEBUG

hash of classes to enable debugging for, via emit(). If 'ALL' is set, debugging for all Pangloss classes is enabled.

AUTHOR

Top

Steve Purkis <spurkis@quiup.com>

SEE ALSO

Top

Pangloss, Similar to OpenFrame::Object.

Pangloss documentation Contained in the Pangloss distribution. 
package Pangloss::Object;

use strict;
use warnings::register;

our $VERSION  = ((require Pangloss::Version), $Pangloss::VERSION)[1];
our $REVISION = (split(/ /, ' $Revision: 1.10 $ '))[2];

sub new {
    my $class = shift->class;
    my $self  = bless {}, $class;
    $self->init(@_) || return;
    return $self;
}

sub init {
    my $self = shift;
}

sub emit {
    my $self  = shift;
    my $mesg  = shift;
    my $class = $self->class;
    my ($package, $filename, $line, $subroutine, $hasargs,
	$wantarray, $evaltext, $is_require, $hints, $bitmask) = caller( 1 );
    $subroutine =~ s/.*:://;
    if ($Pangloss::DEBUG{ ALL } || $Pangloss::DEBUG{ $class }) {
	my $warn_str = "[$class\::$subroutine] $mesg";
	$warn_str   .= "\n" unless $mesg =~ /\n/;
	warn( $warn_str );
    }
    return $self;
}

sub class {
    my $thing = shift;
    return ref($thing) || $thing;
}

1;

__END__

#------------------------------------------------------------------------------