File Coverage

blib/lib/Object/HashBase/Inline.pm
Criterion Covered Total %
statement 56 56 100.0
branch 19 26 73.0
condition n/a
subroutine 6 6 100.0
pod 0 1 0.0
total 81 89 91.0


line stmt bran cond sub pod time code
1             package Object::HashBase::Inline;
2 1     1   411 use strict;
  1         2  
  1         29  
3 1     1   6 use warnings;
  1         2  
  1         44  
4              
5             our $VERSION = '0.009';
6              
7 1     1   28 BEGIN { $Object::HashBase::Test::NO_RUN = 1 }
8 1     1   6 use Object::HashBase;
  1         2  
  1         6  
9 1     1   404 use Object::HashBase::Test;
  1         3  
  1         564  
10              
11             my $hb_file = $INC{'Object/HashBase.pm'};
12             my $t_file = $INC{'Object/HashBase/Test.pm'};
13              
14             sub inline {
15 1     1 0 802 my ($prefix, $version) = @_;
16 1 50       6 $version = $VERSION unless defined $version;
17              
18 1         2 my $path = $prefix;
19 1         6 $path =~ s{::}{/}g;
20 1         3 $path = "lib/$path";
21 1         3 my $partial = '';
22              
23 1         6 for my $part (split /\//, "$path") {
24 3         11 $partial = join '/', grep { $_ } $partial, $part;
  6         19  
25 3 50       137 mkdir($partial) unless -d $partial;
26             }
27              
28 1         6 $path .= "/HashBase.pm";
29              
30 1 50       41 mkdir('t') unless -d 't';
31              
32 1 50       60 open(my $hbf, '>', $path) or die "Could not create '$path': $!";
33 1 50       52 open(my $tf, '>', 't/HashBase.t') or die "Could not create 't/HashBase.t': $!";
34              
35 1 50       39 open(my $hin, '<', $hb_file) or die "Could not open '$hb_file': $!";
36 1 50       35 open(my $tin, '<', $t_file) or die "Could not open '$t_file': $!";
37              
38              
39 1         16 print $hbf <<" EOT";
40             package $prefix\::HashBase;
41             use strict;
42             use warnings;
43              
44             our \$VERSION = '$version';
45              
46             #################################################################
47             # #
48             # This is a generated file! Do not modify this file directly! #
49             # Use hashbase_inc.pl script to regenerate this file. #
50             # The script is part of the Object::HashBase distribution. #
51             # Note: You can modify the version number above this comment #
52             # if needed, that is fine. #
53             # #
54             #################################################################
55              
56             {
57             no warnings 'once';
58             \$$prefix\::HashBase::HB_VERSION = '$Object::HashBase::VERSION';
59             \*$prefix\::HashBase::ATTR_SUBS = \\\%Object::HashBase::ATTR_SUBS;
60             \*$prefix\::HashBase::ATTR_LIST = \\\%Object::HashBase::ATTR_LIST;
61             \*$prefix\::HashBase::VERSION = \\\%Object::HashBase::VERSION;
62             \*$prefix\::HashBase::CAN_CACHE = \\\%Object::HashBase::CAN_CACHE;
63             }
64              
65             EOT
66              
67 1         17 print $tf <<" EOT";
68             use strict;
69             use warnings;
70              
71             use Test::More;
72              
73             EOT
74              
75 1         4 my $writing = 0;
76 1         37 while (my $line = <$hin>) {
77 469 100       841 if ($line =~ m/<-- START -->/) {
78 1         19 $writing = 1;
79 1         19 next;
80             }
81              
82 468 100       769 if ($line =~ m/^=head1 INCLUDING IN YOUR DIST$/) {
83 1         2 $writing = 0;
84 1         4 print $hbf <<" EOT";
85             =head1 THIS IS A BUNDLED COPY OF HASHBASE
86              
87             This is a bundled copy of L. This file was generated using
88             the
89             C<$0>
90             script.
91              
92             EOT
93 1         4 next;
94             }
95 467 100       751 if ($line =~ m/^=head1 /) {
96 11         17 $writing = 1;
97             }
98              
99 467 100       764 next unless $writing;
100              
101 441         673 $line =~ s/\QObject::\E/$prefix\::/g;
102              
103 441         1142 print $hbf $line;
104             }
105              
106 1         5 $writing = 0;
107 1         20 while (my $line = <$tin>) {
108 268 100       486 if ($line =~ m/<-- START -->/) {
109 1         2 $writing = 1;
110 1         3 next;
111             }
112              
113 267 100       440 next unless $writing;
114              
115 244         402 $line =~ s/\QObject::HashBase::Test::\E/main\::/g;
116 244         366 $line =~ s/\QObject::\E/$prefix\::/g;
117 244         595 print $tf $line;
118             }
119              
120 1         32 close($hbf);
121 1         43 close($tf);
122             }
123              
124             1;