package Stack;
use strict;
use Exception::Handler;
use err_log;
$Stack::VERSION = 1.08; # 8/29/2002, 12:05:21 PM
@Stack::ISA = qw( Exception::Handler );
=pod
AUTHOR
-Tommy Butler, professional contractor and open source proponent
Atrixnet™, for Internet Business Software®
http://atrixnet.com
6711 Forest Park Dr
Arlington, TX
76001
COPYRIGHT
Copyright Tommy Butler. All rights reserved
LISCENCE
This software is free, and you may use and distribute it under the
GNU GPL liscence. If you modify the code for your own purposes
please acknowledge its original author.
BUGS
Please report any of the following to me
- bugs
- interface inconsistencies
- suggestions
- comments
- complaints
=cut
# --------------------------------------------------------
# Constructor
# --------------------------------------------------------
sub new {
my($class) = shift;
my($this) = {};
my($name) = __PACKAGE__;
# -------------------------------------------
# bless object ref into the class' namespace
# -------------------------------------------
bless($this, $name);
my($in) = $this->coerce_array(@_);
# -------------------------------------------
# begin setting up class attributes
# -------------------------------------------
$this->{'name'} = $name;
$this->{'CONFIG'} = $in->{'CONFIG'};
# -------------------------------------------
# finish by verifying class attributes
# -------------------------------------------
$this->verify_attributes();
$this->init();
# return object reference
return($this);
}
# --------------------------------------------------------
# Stack::verify_attributes()
# --------------------------------------------------------
sub verify_attributes {
my($this) = shift;
my($name) = $this->{'name'};
my($CONFIG) = $this->{'CONFIG'};
$this->quit
(
qq[$name needs a ref to CONFIG config hash]
)
if not $CONFIG;
return(1);
}
# --------------------------------------------------------
# Stack::init()
# --------------------------------------------------------
sub init {
my($this) = shift;
# what is my own debug mode?
$this->{'debug'} = $this->{'CONFIG'}{'debug'} || [];
$this->{'verbose'} = $this->{'CONFIG'}{'verbose'} || [];
if (ref($this->{'debug'}) eq 'SCALAR') {
my($debug) = $this->{'debug'};
CORE::undef($this->{'debug'});
$this->{'debug'}[0] = ($debug) ? 'all' : 'none';
}
if (ref($this->{'verbose'}) eq 'SCALAR') {
my($verbose) = $this->{'verbose'};
CORE::undef($this->{'verbose'});
$this->{'verbose'}[0] = ($verbose) ? 'all' : 'none';
}
return(1);
}
# --------------------------------------------------------
# Stack::debug()
# --------------------------------------------------------
sub debug {
my($this) = shift;
my($caller) = caller();
return(1)
if ($this->{'debug'}[0] eq 'all');
foreach(@{ $this->{'debug'} }) {
return(1)
if $_ eq $caller;
}
return(undef);
}
# --------------------------------------------------------
# Stack::verbose()
# --------------------------------------------------------
sub verbose {
my($this) = shift;
my($caller) = caller();
return(1)
if ($this->{'verbose'}[0] eq 'all');
foreach(@{ $this->{'verbose'} }) {
return(1)
if $_ eq $caller;
}
return(0);
}
# --------------------------------------------------------
# Stack::use_private_log()
# --------------------------------------------------------
sub use_private_log {
my($this) = shift;
my($filename) = shift;
my($FHref) = err_log->new();
$this->{'handles'}[$this->{'logid'}] = $FHref;
++$this->{'logid'};
return($FHref);
}
# --------------------------------------------------------
# Stack::warn_to_pvlog()
# --------------------------------------------------------
sub warn_to_pvlog {
my($this) = shift;
my($plogid) = 0;
if
(
scalar(@_) > 1
and
length($_[0]) < 2
and
int($_[0])
)
{
$plogid = int(shift(@_));
}
return(-1)
if
(
not exists($this->{'handles'}[$plogid])
or
not defined($this->{'handles'}[$plogid])
);
my($FHref) = $this->{'handles'}[$plogid];
{
local($^W)=0;
print $FHref @_;
}
return(1);
}
# --------------------------------------------------------
# Stack::announce()
# --------------------------------------------------------
sub announce {
my($this) = shift;
my($newobject) = shift || '';
# tell everyone the details of
# this new objects birth
my
(
$pak, $filename,
$linenum, $subroutine,
$hasargs, $wantarray,
$evaltext, $req_OR_use
) = caller(1);
if (defined($newobject)) {
$newobject = ref($newobject);
if (length($newobject) > 0) {
$newobject .= qq[ was created by $pak, line $linenum.];
}
}
return
(
$this->
fwarn
(
$newobject
)
);
}
# --------------------------------------------------------
# Stack::coerce_array()
# --------------------------------------------------------
sub coerce_array {
my($this) = shift;
my($hashref) = {};
while (@_) {
my($name) = shift(@_) || '';
my($val) = shift(@_) || '';
if (defined($name) and defined($val)) {
$hashref->{$name} = $val;
}
else {
next;
}
}
return($hashref);
}
# --------------------------------------------------------
# Stack::DESTROY()
# --------------------------------------------------------
sub DESTROY { } sub AUTOLOAD { }
# --------------------------------------------------------
# end Stack Class, return true on import
# --------------------------------------------------------
1;