tniemi

Automatical Exporter for all subs from perl package

Apr 1st, 2013
260
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. package Exporter::Auto;
  2. our $VERSION = 0.10;
  3. our $AUTHOR = "Tero Niemi <tero.niemi\100nimbus\056fi>";
  4. #
  5. #   Create Exporter variables (and tag groups) automatically.
  6. #   In your modules, use like Exporter. F.ex.:
  7. #
  8. #       use parent 'Exporter::Auto';
  9. #
  10. #   The following variables will be created,
  11. #   or, if they exists, extended:
  12. #
  13. #       our $VERSION = 0.1;
  14. #       our @EXPORT_OK;
  15. #       our %EXPORT_TAGS;
  16. #
  17. #   All subs are automatically marked 'OK' for exporting.
  18. #   Variables have to be manually added:
  19. #
  20. #       our @EXPORT_OK = qw( %hash @array $scalar );
  21. #
  22. use warnings;
  23. use strict;
  24. no strict 'refs';
  25.  
  26. require Exporter;
  27.  
  28. sub import {
  29.     my $package = $_[0].'::';  # Package name
  30.     my %export_ok = ();        # List of exportable items
  31.     my %export_tags = ();      # Exportable items grouped into tags
  32.  
  33.     # Add items in @EXPORT and @EXPORT_OK into exportable list
  34.     foreach (@{$package.'EXPORT'}, @{$package.'EXPORT_OK'}) {
  35.         $export_ok{$_}++;
  36.     }
  37.  
  38.     # Automatically add all subroutines into exportable list
  39.     foreach (keys %{$package}) {
  40.         next unless defined &{$package.$_};
  41.         $export_ok{$_}++;
  42.     }
  43.  
  44.     # Convert possibly predefined tag arrays into inner hashes
  45.     %export_tags = (%{$package.'EXPORT_TAGS'});
  46.     foreach my $tag (keys %export_tags) {
  47.         my @items = (@{$export_tags{$tag}});
  48.         $export_tags{$tag} = {};
  49.         foreach (@items) {
  50.             $export_tags{$tag}->{$_}++;
  51.         }
  52.     }
  53.  
  54.     # Automatically group items (by prefixes) into tags
  55.     foreach (keys %export_ok) {
  56.         my $prefix = /^[\%\@\$]?([^_]+)/i ? lc $1 : undef;
  57.         $export_tags{$prefix}->{$_}++ if defined $prefix;
  58.         $export_tags{all}->{$_}++;
  59.     }
  60.  
  61.     # Convert inner hashes back into arrays
  62.     foreach my $tag (keys %export_tags) {
  63.         $export_tags{$tag} = [keys $export_tags{$tag}];
  64.     }
  65.  
  66.     # Set variables ready for Exporter
  67.     ${$package.'VERSION'} = 0.1 unless defined ${$package.'VERSION'};
  68.     @{$package.'EXPORT_OK'} = @{$export_tags{all}};
  69.     %{$package.'EXPORT_TAGS'} = %export_tags;
  70.  
  71.     # Let Exporter do the rest
  72.     goto &Exporter::import;
  73. }
  74.  
  75. 1;
  76. __END__
RAW Paste Data

Adblocker detected! Please consider disabling it...

We've detected AdBlock Plus or some other adblocking software preventing Pastebin.com from fully loading.

We don't have any obnoxious sound, or popup ads, we actively block these annoying types of ads!

Please add Pastebin.com to your ad blocker whitelist or disable your adblocking software.

×