File Coverage

blib/lib/Datahub/Factory/Util.pm
Criterion Covered Total %
statement 15 43 34.8
branch 0 22 0.0
condition 0 8 0.0
subroutine 5 11 45.4
pod 0 5 0.0
total 20 89 22.4


line stmt bran cond sub pod time code
1             package Datahub::Factory::Util;
2              
3 1     1   8 use Datahub::Factory::Sane;
  1         1  
  1         7  
4              
5             our $VERSION = '1.76';
6              
7 1     1   5 use Exporter qw(import);
  1         2  
  1         21  
8 1     1   5 use Scalar::Util ();
  1         1  
  1         22  
9 1     1   497 use Ref::Util ();
  1         1482  
  1         516  
10              
11             our %EXPORT_TAGS = (
12             misc => [qw(require_package)]
13             );
14              
15             our @EXPORT_OK = map {@$_} values %EXPORT_TAGS;
16              
17             $EXPORT_TAGS{all} = \@EXPORT_OK;
18              
19             # globtype Reference
20             *is_ref = \&Ref::Util::is_ref;
21              
22             # globtype Reference
23             *is_glob_ref = \&Ref::Util::is_plain_globref;
24              
25             # Output everything in UTF-8
26             binmode STDOUT, ":utf8";
27              
28             sub is_value {
29 0 0 0 0 0   defined($_[0]) && !is_ref($_[0]) && !is_glob_ref(\$_[0]);
30             }
31              
32             sub is_string {
33 0 0   0 0   is_value($_[0]) && length($_[0]) > 0;
34             }
35              
36             sub is_invocant {
37 0     0 0   my ($inv) = @_;
38 0 0         if (ref $inv) {
39 0           return !!Scalar::Util::blessed($inv);
40             }
41             else {
42 0           return !!_get_stash($inv);
43             }
44             }
45              
46             sub is_instance {
47 0     0 0   my $obj = shift;
48 0 0         Scalar::Util::blessed($obj) || return 0;
49 0   0       $obj->isa($_) || return 0 for @_;
50 0           1;
51             }
52              
53             sub require_package {
54 0     0 0   my ($pkg, $ns) = @_;
55              
56 0 0         if ($ns) {
57 0 0 0       unless ($pkg =~ s/^\+// || $pkg =~ /^$ns/) {
58 0           $pkg = "${ns}::$pkg";
59             }
60             }
61              
62 0 0         return $pkg if is_invocant($pkg);
63              
64 0 0         eval "require $pkg;1;"
65             or Catmandu::NoSuchPackage->throw(
66             message => "No such package: $pkg",
67             package_name => $pkg
68             );
69              
70 0           $pkg;
71             }
72              
73             # the following code is taken from Data::Util::PurePerl 0.63
74             sub _get_stash {
75 0     0     my ($inv) = @_;
76              
77 0 0         if (Scalar::Util::blessed($inv)) {
    0          
78 1     1   7 no strict 'refs';
  1         2  
  1         190  
79 0           return \%{ref($inv) . '::'};
  0            
80             }
81             elsif (!is_string($inv)) {
82 0           return undef;
83             }
84              
85 0           $inv =~ s/^:://;
86              
87 0           my $pack = *main::;
88 0           for my $part (split /::/, $inv) {
89 0 0         return undef unless $pack = $pack->{$part . '::'};
90             }
91 0           return *{$pack}{HASH};
  0            
92             }
93              
94              
95             1;
96              
97             __END__