view release on metacpan or  search on metacpan

lib/AutoCode/Root0.pm  view on Meta::CPAN

    return %hints;
}

sub debug {
    my $self=shift;
#    return unless($self->{DEBUG_HINTS_SLOT}->{enable});
    
    return unless $debug;
    my $pkg=caller;
    print STDERR "In $pkg, @_\n";
}

sub throw {
    my ($self, $string)=@_;
    my $out ="\n". '-'x20 . ' EXCEPTION '. '-'x20 . "\n";
    $out .= "MSG: $string\n";
    $out .= $self->stack_trace_dump .'-'x51 ."\n";
    die $out;
}

sub warn {
    my ($self, $msg)=@_;
    my $out="\n". '-'x20 . ' WARNING '. '-'x20 . "\n";
    $out .= "MSG: $msg\n";
    $out .= '-'x51 ."\n";
    print STDERR $out;
}

sub stack_trace_dump {
    my $self=shift;
    my @stack=$self->stack_trace;
    eval{
        #<< x 3;
        shift @stack;
        shift @stack;shift @stack;
    };
    my $out;
    my ($module, $function, $file, $position);
    map {
        ($module, $function, $file, $position)=@$_;
        $out.= "STACK $function $file:$position\n";
    } @stack;
    return $out;
}

sub stack_trace {
    my $self=shift;
    my $i=0;
    my @out=();
    my $prev=[];
    while(my @call=caller($i++)){
        $prev->[3]=$call[3];
        push(@out, $prev);
        $prev=\@call;
    }
    $prev->[3]='toplevel';
    push @out, $prev;
    return @out;
}

sub _not_implemented_msg {
    my $self=shift;
    my $pkg=ref $self;
    my $method=(caller(1))[3];
    my $msg="Abstract method [$method] is not implemented by package $pkg.\n";
    return $msg;
}

sub throw_not_implemented {
    my $self=shift;
    $self->throw($self->_not_implemented_msg);
}

sub warn_not_implemented {
    my $self=shift;
    $self->warn($self->_not_implemented_msg);
}

1;