view release on metacpan or  search on metacpan

lib/Object/Import.pm  view on Meta::CPAN

This program 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 General Public License for more details.

A copy of the GNU General Public License can be found in the
source tree of this module under the name "GPL", or else see
"http://www.gnu.org/licenses/".  A copy of the Artistic License can
be found in the source tree under the name "ARTISTIC", or else see
"http://search.cpan.org/~rjbs/perl-5.16.1/pod/perlartistic.pod".

=cut


use strict;
use 5.007;
use Scalar::Util qw"blessed reftype";
eval "
use MRO::Compat;
";
if (my $use_mro_compat_error = $@) {
	eval "
	use mro;
	";
	my $use_mro_error = $@;
	$use_mro_error and
		die "$use_mro_compat_error\n$use_mro_error\nerror: could not use either of modules MRO::Compat or mro";
}


# Methods must not be exported automatically if their original name is in %special_source
# or if the name of the exported sub is in %special_target.
our %special_source;
our %special_target;

# Any name starting with a character other than a letter or underscore are forced to
# package main.  Such names in other packages may only be accessed with an explicit
# package name.  Most of these are special or reserved to be special by the core, though
# none of their function slots are used.  We do not export these because the user could
# not call them easily unless exported to main.  Note that names starting with unicode
# non-letter characters or names that start with invalid utf-8 also seem to be forced
# to main (these may only be accessed through symbolic references).
# The following names are also forced to main like above.
$special_source{$_}++, $special_target{$_}++ for
	qw"ENV INC ARGV ARGVOUT SIG STDIN STDOUT STDERR _";
# The following names are called by the core on some occasions.
$special_source{$_}++, $special_target{$_}++ for qw"
	AUTOLOAD BINMODE CLEAR CLEARERR CLONE CLONE_SKIP CLOSE DELETE DESTROY
	EOF ERROR EXISTS EXTEND FDOPEN FETCH FETCHSIZE FILENO FILL FIRSTKEY
	FLUSH GETC NEXTKEY OPEN POP POPPED PRINT PRINTF PUSH PUSHED READ READLINE
	SCALAR SEEK SETLINEBUF SHIFT SPLICE STORE STORESIZE SYSOPEN TELL TIEARRAY
	TIEHANDLE TIEHASH TIESCALAR UNREAD UNSHIFT UNTIE UTF8 WRITE";
# Names starting with "(" are used by the overload mechanism, even as functions in some
# cases.  We do not touch such subs.
# Names starting with "_<" are used for something related to source files,
# but the sub slot is not used, so we don't care.
# The following names are called by use/no, so they definitely should not be exported.
$special_source{$_}++, $special_target{$_}++ for qw"import unimport";
# The following should not occur as subs, but we exclude them for good measure.
$special_source{$_}++, $special_target{$_}++ for
	qw"BEGIN UNITCHECK CHECK INIT END";
# The following names could override a builtin function if exported to a module
$special_target{$_}++ for qw"
	abs accept alarm atan2 bind binmode bless break caller chdir chmod
	chomp chop chown chr chroot close closedir connect continue cos
	crypt dbmclose dbmopen default defined delete die do dump each
	else elsif endgrent endhostent endnetent endprotoent endpwent
	endservent eof eval exec exists exit exp fcntl fileno flock for
	foreach fork format formline getc getgrent getgrgid getgrnam
	gethostbyaddr gethostbyname gethostent getlogin getnetbyaddr
	getnetbyname getnetent getpeername getpgrp getppid getpriority
	getprotobyname getprotobynumber getprotoent getpwent getpwnam
	getpwuid getservbyname getservbyport getservent getsockname
	getsockopt given glob gmtime goto grep hex if index int
	ioctl join keys kill last lc lcfirst length link listen local
	localtime lock log lstat map mkdir msgctl msgget msgrcv msgsnd
	my next no not oct open opendir ord our pack package pipe pop
	pos print printf prototype push quotemeta rand read readdir
	readline readlink readpipe recv redo ref rename require reset
	return reverse rewinddir rindex rmdir say scalar seek seekdir
	select semctl semget semop send setgrent sethostent setnetent
	setpgrp setpriority setprotoent setpwent setservent setsockopt
	shift shmctl shmget shmread shmwrite shutdown sin sleep socket
	socketpair sort splice split sprintf sqrt srand stat state
	study sub substr symlink syscall sysopen sysread sysseek system
	syswrite tell telldir tie tied time times truncate uc ucfirst
	umask undef unless unlink unpack unshift untie until use utime
	values vec wait waitpid wantarray warn when while write
	fc evalbytes __SUB__ __FILE__ __LINE__ __PACKAGE__
";
# The following four are UNIVERSAL functions.
$special_source{$_}++, $special_target{$_}++ for qw"can isa DOES VERSION";
# The following keywords cannot be overriden this way, so are safe to export,
# though you may have to use tricky syntax to call some of them:
0 for qw "and cmp eq ge gt le lt m ne or q qq qr qw qx s tr x xor y";
# The old aliases LT etc are removed from core at perl 5.8 and do not count
# as special anymore.
# Some of the above long list might also not be overridable, eg. "if".
# The following are special, but are not functions and not forced to main.
0 for qw"a b DATA OVERLOAD";
# The following names are English aliases for special variables so they could
#   be aliased to special names, eg. if the module imports English
# then &ARG and &::_ are the same.  The function slot of none of these is special.
# Exporting to such names would be a bad idea because they could overwrite
# a function in main.
$special_source{$_}++, $special_target{$_}++ for qw"
	ACCUMULATOR ARG ARRAY_BASE BASETIME CHILD_ERROR COMPILING DEBUGGING
	EFFECTIVE_GROUP_ID EFFECTIVE_USER_ID EGID ERRNO EUID EVAL_ERROR
	EXCEPTIONS_BEING_CAUGHT EXECUTABLE_NAME EXTENDED_OS_ERROR FORMAT_FORMFEED
	FORMAT_LINES_LEFT FORMAT_LINES_PER_PAGE FORMAT_LINE_BREAK_CHARACTERS
	FORMAT_NAME FORMAT_PAGE_NUMBER FORMAT_TOP_NAME GID INPLACE_EDIT
	INPUT_LINE_NUMBER INPUT_RECORD_SEPARATOR LAST_MATCH_END LAST_MATCH_START
	LAST_PAREN_MATCH LAST_REGEXP_CODE_RESULT LAST_SUBMATCH_RESULT
	LIST_SEPARATOR MATCH NR OFMT OFS OLD_PERL_VERSION ORS OSNAME OS_ERROR
	OUTPUT_AUTOFLUSH OUTPUT_FIELD_SEPARATOR OUTPUT_RECORD_SEPARATOR PERLDB
	PERL_VERSION PID POSTMATCH PREMATCH PROCESS_ID PROGRAM_NAME REAL_GROUP_ID
	REAL_USER_ID RS SUBSCRIPT_SEPARATOR SUBSEP SYSTEM_FD_MAX UID WARNING";
# The following are names used by Exporter, but not as functions.
0 for qw"EXPORT EXPORT_OK EXPORT_FAIL EXPORT_TAGS";
# The following are subs used by Exporter, some internal.
$special_source{$_}++, $special_target{$_}++ for qw"