File Coverage

blib/lib/ore.pm
Criterion Covered Total %
statement 55 83 66.2
branch 2 8 25.0
condition n/a
subroutine 17 23 73.9
pod 0 14 0.0
total 74 128 57.8


line stmt bran cond sub pod time code
1             package ore;
2              
3 1     1   32224 use 5.014;
  1         3  
4              
5 1     1   5 use strict;
  1         2  
  1         20  
6 1     1   4 use warnings;
  1         2  
  1         36  
7 1     1   6 use routines;
  1         2  
  1         7  
8              
9 1     1   1750 use base 'Exporter';
  1         3  
  1         126  
10              
11 1     1   507 use Data::Dump;
  1         5357  
  1         72  
12 1     1   573 use Data::Object::Space;
  1         11017  
  1         52  
13              
14 1     1   8 no strict 'refs';
  1         3  
  1         220  
15              
16             our @EXPORT=('dd');
17              
18             our $VERSION = '0.02'; # VERSION
19              
20             sub import {
21 1     1   27788 my $args = [map { /([^=]+)=(.*)/; $ENV{$1} = $2; $1 } @ARGV];
  0         0  
  0         0  
  0         0  
22              
23 1 50       43 new_vars([@$args ? @$args : keys %ENV]);
24 1 50       19 use_vars([@$args ? @$args : keys %ENV]);
25              
26 1         217 ore->export_to_level(1, @_);
27             }
28              
29 1     1 0 4 fun new_vars($args) {
  1         1  
30 1         13 [map new_vars_pump(new_vars_form($_)), grep /^New_/, @$args]
31             }
32              
33 1     1 0 3 fun new_vars_args($spec) {
  1         2  
34 1 0       9 [map { /^\$(\w+)$/ ? ${"ore::$1"} : $_ } @$spec[2..$#$spec]]
  0         0  
  0         0  
35             }
36              
37 1     1 0 29 fun new_vars_form($name) {
  1         5  
38 1         3 new_vars_make(new_vars_spec($name))
39             }
40              
41 1     1 0 3 fun new_vars_make($spec) {
  1         1  
42 1         12 [$spec->[1], Data::Object::Space->new($spec->[0])->build(@{new_vars_args($spec)})]
  1         13  
43             }
44              
45 1     1 0 3 fun new_vars_name($name) {
  1         1  
46 1         12 $name =~ s/^New_//gr =~ s/_/\//gr
47             }
48              
49 1     1 0 3 fun new_vars_spec($name) {
  1         1  
50 1         3 [new_vars_name($name), split /;\s*/, $ENV{$name}]
51             }
52              
53 1     1 0 18780 fun new_vars_pump($conf) {
  1         3  
54 1         3 ${"ore::$$conf[0]"} = $$conf[1]; push @EXPORT, '$'.$$conf[0]; $conf
  1         7  
  1         4  
  1         5  
55             }
56              
57 1     1 0 2 fun use_vars($args) {
  1         2  
58 1         8 [map use_vars_pump(use_vars_form($_)), grep /^Use_/, @$args]
59             }
60              
61 0     0 0   fun use_vars_args($spec) {
  0            
62 0 0         [map { /^\$(\w+)$/ ? ${"ore::$1"} : $_ } @$spec[2..$#$spec]]
  0            
  0            
63             }
64              
65 0     0 0   fun use_vars_form($name) {
  0            
66 0           use_vars_make(use_vars_spec($name))
67             }
68              
69 0     0 0   fun use_vars_make($spec) {
  0            
70 0           [$spec->[1], Data::Object::Space->new($spec->[0])]
71             }
72              
73 0     0 0   fun use_vars_name($name) {
  0            
74 0           $name =~ s/^Use_//gr =~ s/_/\//gr
75             }
76              
77 0     0 0   fun use_vars_spec($name) {
  0            
78 0           [use_vars_name($name), split /;\s*/, $ENV{$name}]
79             }
80              
81 0     0 0   fun use_vars_pump($conf) {
  0            
82 0           ${"ore::$$conf[0]"} = $$conf[1]; push @EXPORT, '$'.$$conf[0]; $conf
  0            
  0            
  0            
83             }
84              
85             1;
86              
87             =encoding utf8
88              
89             =head1 NAME
90              
91             ore
92              
93             =cut
94              
95             =head1 ABSTRACT
96              
97             Sugar for Perl 5 one-liners
98              
99             =cut
100              
101             =head1 SYNOPSIS
102              
103             BEGIN {
104             $ENV{New_File_Temp} = 'ft';
105             }
106              
107             use ore;
108              
109             $ft
110              
111             =cut
112              
113             =head1 DESCRIPTION
114              
115             This package provides automatic object instantiation based on environment
116             variables. This package exists because I was bored and inspired by L<new>.
117              
118             =head2 examples
119              
120             Simple command-line example using env vars to drive object instantiation:
121              
122             $ New_File_Temp=ft perl -More -e 'dd $ft'
123              
124             # "File::Temp"
125              
126             Another simple command-line example using env vars to return a
127             L<Data::Object::Space> object which calls C<children> and returns an arrayref
128             of L<Data::Object::Space> objects:
129              
130             $ Use_DBI=dbi perl -More -e 'dd $dbi->children'
131              
132             # [
133             # ...,
134             # "DBI/DBD",
135             # "DBI/Profile",
136             # "DBI/ProfileData",
137             # "DBI/ProfileDumper",
138             # ...,
139             # ]
140              
141             Here's another simple command-line example using args as env vars with ordered
142             variable interpolation:
143              
144             $ perl -More -E 'dd $pt' New_File_Temp=ft New_Path_Tiny='pt; $ft'
145              
146             # /var/folders/pc/v4xb_.../T/JtYaKLTTSo
147              
148             =cut
149              
150             =head1 AUTHOR
151              
152             Al Newkirk, C<awncorp@cpan.org>
153              
154             =head1 LICENSE
155              
156             Copyright (C) 2011-2019, Al Newkirk, et al.
157              
158             This is free software; you can redistribute it and/or modify it under the terms
159             of the The Apache License, Version 2.0, as elucidated in the L<"license
160             file"|https://github.com/iamalnewkirk/ore/blob/master/LICENSE>.
161              
162             =head1 PROJECT
163              
164             L<Wiki|https://github.com/iamalnewkirk/ore/wiki>
165              
166             L<Project|https://github.com/iamalnewkirk/ore>
167              
168             L<Initiatives|https://github.com/iamalnewkirk/ore/projects>
169              
170             L<Milestones|https://github.com/iamalnewkirk/ore/milestones>
171              
172             L<Contributing|https://github.com/iamalnewkirk/ore/blob/master/CONTRIBUTE.md>
173              
174             L<Issues|https://github.com/iamalnewkirk/ore/issues>
175              
176             =cut