File Coverage

blib/lib/everywhere.pm
Criterion Covered Total %
statement 35 46 76.0
branch 13 22 59.0
condition 4 12 33.3
subroutine 5 5 100.0
pod n/a
total 57 85 67.0


line stmt bran cond sub pod time code
1             package everywhere;
2              
3             =head1 NAME
4              
5             everywhere - Use a module (or feature) everywhere
6              
7             =head1 SYNOPSIS
8              
9             #!/usr/bin/perl
10              
11             use strict;
12             use everywhere qw/ feature say /;
13             use Greet;
14              
15             Greet::hello();
16              
17             # in Greet.pm
18             package Greet;
19             use strict;
20             sub hello {
21             say "Helloooooo!!!!";
22             }
23              
24             =head1 DESCRIPTION
25              
26             I got tired of putting "use 5.010" at the top of every module. So now I can
27             throw this in my toplevel program and not have to Repeat Myself elsewhere.
28              
29             In theory you should be able to pass it whatever you pass to use.
30              
31             Also, I just made it so you can do:
32              
33             use everywhere 'MooseX::Declare',
34             matching => '^MyApp',
35             use_here => 0;
36              
37             for example and then it will only apply this module to things matching your
38             regex. And not use it here. You can also throw in 'package_level => 1' to use
39             your package after every "package ..." line. All these are experimental :)
40              
41             =cut
42              
43 2     2   73880 use strict;
  2         6  
  2         154  
44 2     2   15 use warnings;
  2         3  
  2         1229  
45              
46             our $VERSION = '0.07';
47              
48             sub import {
49 2     2   19 my ($class, $module, @items) = @_;
50 2         5 my $use_line = "use $module";
51             # TODO do this parameter parsing better :)
52 2         12 my $matching = qr/.*/;
53 2 50 33     15 if(defined $items[0] && $items[0] eq 'matching') {
54 0         0 $matching = $items[1];
55 0         0 shift @items; shift @items;
  0         0  
56             }
57 2         4 my $use_here = 1;
58 2 50 33     13 if(defined $items[0] && $items[0] eq 'use_here') {
59 0         0 $use_here = eval $items[1];
60 0         0 shift @items; shift @items;
  0         0  
61             }
62 2         3 my $file_level = 1;
63 2 50 33     9 if(defined $items[0] && $items[0] eq 'package_level') {
64 0         0 $file_level = ! eval $items[1];
65 0         0 shift @items; shift @items;
  0         0  
66             }
67 2 50       7 $use_line .= " qw/" . join(' ', @items) . "/" if @items;
68 2         4 $use_line .= ";\n";
69 2 50   2   434 eval $use_line if $use_here;
  2         86  
  2         110  
  2         179  
70             unshift @INC, sub {
71 13     13   396135 my ($self, $file) = @_;
72 13 50       167 if($file =~ $matching) {
73 13         43 foreach my $dir (@INC) {
74 118 100       265 next if ref $dir;
75 105         399 my $full = "$dir/$file";
76 105 100       7389 if(open my $fh, "<", $full) {
77 11 50       90 my @lines = ($file_level ? ($use_line) : (),
78             qq{#line 1 "$dir/$file"\n});
79             return ($fh, sub {
80 4239 50       46831 if(@lines) {
81 4239         10839 push @lines, $_;
82 4239         16037 $_ = shift @lines;
83 4239 50 33     26921 $_.= $use_line if (!$file_level) && /^\s*package\s+.+\s*;\s*$/;
84 4239         147520 return length $_;
85             }
86 0         0 return 0;
87 11         812 });
88             }
89             }
90             } else {
91 0         0 return undef;
92             }
93 2         17 };
94 2         34 return;
95             }
96              
97             =head1 BUGS
98              
99             Currently you can only use this once.
100              
101             =head1 SEE ALSO
102              
103             L -- from which most code came!
104              
105             Also look at L and L.
106              
107             =head1 AUTHOR
108              
109             Brock Wilcox - http://thelackthereof.org/
110             Thanks to mst and #moose ;-)
111              
112             =head1 COPYRIGHT
113              
114             Copyright (c) 2008-2011 Brock Wilcox . All rights
115             reserved. This program is free software; you can redistribute it and/or
116             modify it under the same terms as Perl 5.10 or later.
117              
118             =cut
119              
120             1;
121