1# This program is copyright 2013 Percona Ireland Ltd.
2# Feedback and improvements are welcome.
3#
4# THIS PROGRAM IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
5# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
6# MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
7#
8# This program is free software; you can redistribute it and/or modify it under
9# the terms of the GNU General Public License as published by the Free Software
10# Foundation, version 2; OR the Perl Artistic License.  On UNIX and similar
11# systems, you can issue `man perlgpl' or `man perlartistic' to read these
12# licenses.
13#
14# You should have received a copy of the GNU General Public License along with
15# this program; if not, write to the Free Software Foundation, Inc., 59 Temple
16# Place, Suite 330, Boston, MA  02111-1307  USA.
17# ###########################################################################
18# Lmo::Utils package
19# ###########################################################################
20package Lmo::Utils;
21
22use strict;
23use warnings qw( FATAL all );
24require Exporter;
25our (@ISA, @EXPORT, @EXPORT_OK);
26
27BEGIN {
28   @ISA = qw(Exporter);
29   @EXPORT = @EXPORT_OK = qw(
30      _install_coderef
31      _unimport_coderefs
32      _glob_for
33      _stash_for
34   );
35}
36
37{
38   # Gets the glob from a given string.
39   no strict 'refs';
40   sub _glob_for {
41      return \*{shift()}
42   }
43
44   # Gets the stash from a given string.
45   # A stash is a symbol table hash; rough explanation on
46   # http://perldoc.perl.org/perlguts.html#Stashes-and-Globs
47   # But the gist of it is that we can use a hash-like thing to
48   # refer to a class and modify it.
49   sub _stash_for {
50      return \%{ shift() . "::" };
51   }
52}
53
54sub _install_coderef {
55   my ($to, $code) = @_;
56
57   return *{ _glob_for $to } = $code;
58}
59
60sub _unimport_coderefs {
61   my ($target, @names) = @_;
62   return unless @names;
63   my $stash = _stash_for($target);
64   foreach my $name (@names) {
65      if ($stash->{$name} and defined(&{$stash->{$name}})) {
66         delete $stash->{$name};
67      }
68   }
69}
70
711;
72# ###########################################################################
73# End Lmo::Utils package
74# ###########################################################################
75