# Copyright (c) 2007-2009 bivio Software, Inc. All Rights Reserved. # # Visit http://www.bivio.biz for more info. # # This library is free software; you can redistribute it and/or modify # it under the terms of the GNU Lesser General Public License as # published by the Free Software Foundation; either version 2.1 of the # License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public # License along with this library; If not, you may get a copy from: # http://www.opensource.org/licenses/lgpl-license.html # # $Id: Base.pm,v 1.12 2010/10/29 17:37:29 nagler Exp $ package Bivio::Base; use strict; use base 'Bivio::UNIVERSAL'; use Bivio::Die; use Bivio::IO::Alert; use Bivio::IO::ClassLoader; use Bivio::IO::Trace; our($VERSION) = sprintf('%d.%02d', q$Revision: 1.12 $ =~ /\d+/g); my($_USE) = {}; sub import { my(undef, $map_or_class) = @_; Bivio::Die->die('must specify class or map on "use Bivio::Base" line') unless $map_or_class; my($pkg) = (caller(0))[0]; Bivio::Die->eval_or_die( "package $pkg; use base '" . Bivio::IO::ClassLoader->map_require( $map_or_class =~ /\W/ ? $map_or_class : Bivio::IO::ClassLoader->after_in_map($map_or_class, $pkg) ) . "';1", ); { foreach my $n (qw(b_catch b_debug b_die b_info b_trace b_use b_warn)) { # Special case call because $pkg has yet to initialize Bivio::UNIVERSAL::replace_subroutine($pkg, $n, \&{$n}); } }; return; } sub b_catch { return Bivio::Die->catch(@_); } sub b_debug { return Bivio::IO::Alert->debug(Bivio::IO::Alert->calling_context, @_); } sub b_die { return Bivio::Die->throw_or_die(Bivio::IO::Alert->calling_context, @_); } sub b_info { return Bivio::IO::Alert->info(Bivio::IO::Alert->calling_context, @_); } sub b_trace { return Bivio::IO::Trace->set_named_filters(@_); } sub b_use { my($cache); # COUPLING: Bivio::IO::ClassLoader->unsafe_map_require { no strict 'refs'; $cache = ${(caller(0))[0] . '::'}{HASH}->{'Bivio::Base::b_use'} ||= {}; }; return $cache->{join($;, @_)} ||= Bivio::IO::ClassLoader->map_require(@_); } sub b_warn { return Bivio::IO::Alert->warn(Bivio::IO::Alert->calling_context, @_); } 1;