package PCOM;
use strict;
$PCOM::VERSION = 1.10_4; # 9/14/02, 11:08 pm
=pod
AUTHOR
Tommy Butler <tommy @ atrixnet.com>
phone: (817)-468-7716
6711 Forest Park Dr
Arlington, TX
76001-8403
COPYRIGHT Tommy Butler. All rights reserved
LISCENCE This software is free, use/distribute under the GNU GPL.
BUGS TO Tommy Butler <perlmod @ atrixnet.com>
=cut
# ---------------------------------------------------------
# use these package vars
# ---------------------------------------------------------
use vars
qw( $main $pak $win $lin $filename $pwd $linenum
$subroutine $hasargs $wantarray $evaltext $req_OR_use );
# ---------------------------------------------------------
# PCOM object constructor
# ---------------------------------------------------------
sub new {
# -------------------------------------------
# bless object ref into the class' namespace
# -------------------------------------------
my($this) = {}; bless($this, shift(@_));
# -------------------------------------------
# get caller's pwd, namespace, stackalias
# -------------------------------------------
( $pak, $filename,
$linenum, $subroutine,
$hasargs, $wantarray,
$evaltext, $req_OR_use ) = caller(shift(@_)||0);
$main = *pak{'package'};
$pwd = $filename||'';
$pwd =~ s/(^.*)(?:\\|\/|\:)(.*$)/$$main{'PWD'}=$1;$$main{'SCRIPT'}=$2/e;
# -------------------------------------------
# set up object attrs, standard $main vars
# -------------------------------------------
$main->{'PWD'} ||= '.';
$main->{'SCRIPT'} ||= $pwd;
$main->{'PACKAGE'} = $pak;
$main->{'ENV'} = eval('\%'.$pak.'::ENV');
$main->{'ARGV'} = eval('\@'.$pak.'::ARGV');
$main->{'PCOM'} = $this;
$this->{'main'} = $main;
return($this);
}
# ---------------------------------------------------------
# PCOM::main()
# ---------------------------------------------------------
sub main { $_[0]->{'main'} }
# ---------------------------------------------------------
# PCOM::pwd_abs()
# ---------------------------------------------------------
sub pwd_abs { eval(<<'__ABS__') }
my($this,$script,$sl) = @_;
$script||=''; $sl||=''; return(0) if (!$script or !$sl);
my($pwd_abs) = $script;
$pwd_abs =~ s/(^.*$sl).*/$1/;
$pwd_abs = '.' unless ($pwd_abs =~ /$sl/);
return($pwd_abs);
__ABS__
# ---------------------------------------------------------
# PCOM::dumpstruct()
# ---------------------------------------------------------
sub dumpstruct { eval(<<'__DUMP__') }
my($this,$struct) = @_;
require Data::Dumper;
$Data::Dumper::Purity = 1;
$Data::Dumper::Deepcopy = 1;
$Data::Dumper::Indent = 2;
Data::Dumper::Dumper($struct);
__DUMP__
# --------------------------------------------------------
# PCOM::DESTROY(), End PCOM Class, return true on import
# --------------------------------------------------------
sub DESTROY { } sub AUTOLOAD { }
1;