File Coverage

blib/lib/Devel/GlobalSub.pm

Criterion	Covered	Total	%
statement	48	48	100.0
branch	11	12	91.6
condition	10	12	83.3
subroutine	8	8	100.0
pod			n/a
total	77	80	96.2

package Devel::GlobalSub;
use 5.006;
use strict;
use warnings;

our $VERSION = '0.03';

unshift @INC, \&_inject;
my $seen;
my @EXPORT;

sub import {
	my $self = shift;
	my ($package, $file, $line) = caller;
	for my $name (@_) {
		my $full_name = $name;
		unless ($name =~ /::/) {
			$full_name = "${package}::$name";
		}
		push @EXPORT, $full_name;
	}
}

sub _inject {
	no strict 'refs';
	my @known_packages = keys %{_get_known_packages()};
	my $caller = caller;
	for my $sub (@EXPORT) {
		my ($sub_pack, $sub_name) = split /::([^:]+)$/, $sub;
		for my $package (sort @known_packages) {
			if (not defined &{"${package}::$sub_name"}) {
				*{"${package}::$sub_name"} = \&{$sub};
			}
		}
	}
}

sub _get_known_packages {
	my @packs = @_ ? @_ : 'main';
	my $result = {main => 1};
	my @todo;
	for my $pack (@packs) {
		no strict 'refs';
		while (my ($key, $val) = each %{*{"$pack\::"}}) {
			local(*ENTRY) = $val;
			if (
				defined $val &&
				defined *ENTRY{HASH} &&
				$key =~ /::$/ &&
				$key ne 'main::' &&
				$key ne '::'
			) {
				my $p = $pack ne 'main' ? "$pack\::" : '';
				($p .= $key) =~ s/::$//;
				$result->{$p}++;
				push @todo, $p;
			}
		}
	}
	$result = {%$result, %{_get_known_packages(@todo)}} if @todo;
	$result;
}

1;


=head1 NAME

Devel::GlobalSub - Automagically import a subroutine into all namespaces

=head1 VERSION

Version 0.03

=head1 SYNOPSIS

	*** WARNING ***

	This module will allow you to import one or more subroutines into all namespaces automatically.

	Please note: This is generally A REALLY BAD IDEA. You should never use this module in production environments. If you need your project to import subroutines into some namespaces, do it the normal way: using Exporter or some other controlled method.

	This module should be useful only for development purposes. For example, when you temporarily want a certain subroutine to be available anywhere in a project for debugging purposes.

	Using this module for purposes other than development/debugging is a terrible idea. You've been warned.

	You can use this module

To ensure this module to properly work, loading it should be the very first thing your code does. Ideally, you shouldn't even use the module in your code, but in your call to Perl (see bellow). If this module is called late, it might not be able to discover all known namespaces and consequently not be able to import your desired subroutines.

First, you want to write a module of your own, where you can define which subroutines will be globally available. Example:

	# File: MyGlobalSubs.pm

	# Very first thing in your code:
	use Devel::GlobalSub qw(global_sub_1 global_sub_2);

	sub global_sub_1 {
		print "I'm global_sub_1 being called!\n";
	}

	sub global_sub_2 {
		print "I'm global_sub_2 being called!\n";
	}

	1;

Later, the ideal point in time to inject your global functions, is in the call to Perl. Example:

	joe@devbox:~$ perl -MMyGlobalSubs some_script.pl

If you need to tell perl where your module is, you can also do this, assuming you have your module at /home/joe/my_perl_libs/MyGlobalSubs.pm:

	joe@devbox:~$ perl -I/home/joe/my_perl_libs -MMyGlobalSubs some_script.pl

If that's is not possible for you for any reason, then you can simply call your module in your script. But, it should be the first thing that gets loaded in your code, so it should be also be called in the main script being executed. Example:

	#!/usr/bin/perl
	# File: some_script.pl

	use MyGlobalSubs qw(exported_1 exported_2); # <- Very first thing in your code
	use strict;
	use warnings;

	# ... the rest of your code



=head1 EXPORT

None.

=head1 SUBROUTINES/METHODS

=head2 Devel::GlobalSub->import(@list_of_sub_names)

You shouldn't ever need to call import. This module works only if it is called at compile time. By simply Cing it, the import method is automatically invoked, like with any other module. That is:

	use Devel::GlobalSub qw(your_global_sub1 your_global_sub_2 your_global_sub_3 etc);

It needs to receive the names of the subroutines you want to export everywhere. For exmaple:

	# File: MyGlobalSubs.pm

	use Devel::GlobalSub qw(global_sub_1 global_sub_2); # Just the names, not references
	use strict;
	use warnings;

	# Define the subs you are exporting:

	sub global_sub_1 {
		print "I'm global_sub_1 being called!\n";
	}

	sub global_sub_2 {
		print "I'm global_sub_2 being called!\n";
	}

	1;

If you call this module after having called other modules, you might not see your functions exported everywhere, or at all.

=head1 AUTHOR

Francisco Zarabozo, C<<  >>

=head1 BACKGROUND/WHY

As noted at the beginning: This is generally a really bad idea and it shouldn't be ever used as a permanent solution. So, why did I write it?

I work on big projects at my everyday job. Many under platforms like Catalyst or Mojolicious. Some times, I need to do some custom debugging in them and I use some personal debugging modules/functions for that. For example, to send deugging information/messages to a custom file I'm following through `tail -f` in a separate console, away from the rest of the system logging, making it really easy to read for me.

I found myself constantly wanting to use my custom tools, and having to edit each file in the project where I wanted to run them, having to C my custom module on each one, or having to call my subs with fully qualified names.

I wanted something cleaner, quick to type, that didn't need me to add unnecessary, some times dangerous lines to the files. I resolved it with this module. I include it in my call to Perl as:

	perl -I/home/me/perllibs -MMyDebuggingModule some_project_startup_script.pl -D

And with that, I can suddenly put a line in the middle of any file in the project like this:

	# Some code...
	my_debug('Hi there, here are some objects:', $request, $stash, $schema);
	# Some more code

After my work is complete, it's a lot easier to search for the lines I need to delete this way. Also, there's no possible way this will run in another machine, as it is not defined anywhere for real.

=head1 BUGS

Please report any bugs or feature requests to C, or through
the web interface at L.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.


=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Devel::GlobalSub


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back


=head1 ACKNOWLEDGEMENTS


=head1 LICENSE AND COPYRIGHT

This software is copyright (c) 2021 by Francisco Zarabozo.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.


=cut