line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Egg::Helper::Util::Base; |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# Masatoshi Mizuno E<lt>lusheE<64>cpan.orgE<gt> |
4
|
|
|
|
|
|
|
# |
5
|
|
|
|
|
|
|
# $Id: Base.pm 337 2008-05-14 12:30:09Z lushe $ |
6
|
|
|
|
|
|
|
# |
7
|
37
|
|
|
37
|
|
247
|
use strict; |
|
37
|
|
|
|
|
73
|
|
|
37
|
|
|
|
|
1372
|
|
8
|
37
|
|
|
37
|
|
192
|
use warnings; |
|
37
|
|
|
|
|
74
|
|
|
37
|
|
|
|
|
1096
|
|
9
|
37
|
|
|
37
|
|
200
|
use Carp qw/ croak /; |
|
37
|
|
|
|
|
74
|
|
|
37
|
|
|
|
|
3387
|
|
10
|
37
|
|
|
37
|
|
41858
|
use Getopt::Easy; |
|
37
|
|
|
|
|
77797
|
|
|
37
|
|
|
|
|
11836
|
|
11
|
37
|
|
|
37
|
|
64610
|
use File::Temp qw/ tempdir /; |
|
37
|
|
|
|
|
1246094
|
|
|
37
|
|
|
|
|
3121
|
|
12
|
37
|
|
|
37
|
|
37126
|
use UNIVERSAL::require; |
|
37
|
|
|
|
|
73659
|
|
|
37
|
|
|
|
|
433
|
|
13
|
37
|
|
|
37
|
|
23873
|
use Egg::Exception; |
|
37
|
|
|
|
|
767
|
|
|
37
|
|
|
|
|
500
|
|
14
|
37
|
|
|
37
|
|
1390
|
use Cwd; |
|
37
|
|
|
|
|
80
|
|
|
37
|
|
|
|
|
196461
|
|
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
our $VERSION= '3.01'; |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
sub _start_helper { |
19
|
0
|
|
|
0
|
|
|
die q{ There is no method of '_start_helper'. }; |
20
|
|
|
|
|
|
|
} |
21
|
|
|
|
|
|
|
sub _helper_get_options { |
22
|
0
|
|
|
0
|
|
|
my $self = shift; |
23
|
0
|
|
0
|
|
|
|
my $opts = shift || ""; |
24
|
0
|
|
|
|
|
|
$opts.= " o-output_path= h-help g-debug "; |
25
|
0
|
|
|
|
|
|
Getopt::Easy::get_options($opts); |
26
|
0
|
0
|
|
|
|
|
$O{output_path}=~s{\s+} []g if $O{output_path}; |
27
|
0
|
0
|
|
|
|
|
if ($O{debug}) { |
28
|
0
|
|
|
|
|
|
$self->global->{flags}{-debug}= 1; |
29
|
0
|
|
|
|
|
|
$self->_setup_method(ref($self)); |
30
|
|
|
|
|
|
|
} |
31
|
0
|
|
|
|
|
|
\%O; |
32
|
|
|
|
|
|
|
} |
33
|
|
|
|
|
|
|
sub helper_perl_path { |
34
|
0
|
|
|
0
|
1
|
|
require File::Which; |
35
|
0
|
0
|
0
|
|
|
|
$ENV{PERL_PATH} || File::Which::which('perl') |
36
|
|
|
|
|
|
|
|| die q{ Please set environment variable 'PERL_PATH'. }; |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
sub helper_temp_dir { |
39
|
0
|
|
|
0
|
1
|
|
tempdir( CLEANUP=> 1 ); |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
*helper_tempdir= \&helper_temp_dir; |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
sub helper_current_dir { |
44
|
0
|
|
|
0
|
1
|
|
Cwd::getcwd(); |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
sub helper_is_platform { |
47
|
0
|
0
|
|
0
|
1
|
|
{ MSWin32=> 'Win32', MacOS=> 'MacOS' }->{$^O} || 'Unix'; |
48
|
|
|
|
|
|
|
} |
49
|
|
|
|
|
|
|
sub helper_is_unix { |
50
|
0
|
0
|
|
0
|
1
|
|
helper_is_platform() eq 'Unix' ? 1: 0; |
51
|
|
|
|
|
|
|
} |
52
|
|
|
|
|
|
|
sub helper_is_win32 { |
53
|
0
|
0
|
|
0
|
1
|
|
helper_is_platform() eq 'Win32' ? 1: 0; |
54
|
|
|
|
|
|
|
} |
55
|
|
|
|
|
|
|
sub helper_is_macos { |
56
|
0
|
0
|
|
0
|
1
|
|
helper_is_platform() eq 'MacOS' ? 1: 0; |
57
|
|
|
|
|
|
|
} |
58
|
|
|
|
|
|
|
*helper_is_mac= \&helper_is_macos; |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
sub helper_yaml_load { |
61
|
0
|
|
|
0
|
1
|
|
require Egg::Plugin::YAML; |
62
|
0
|
|
|
|
|
|
my $self= shift; |
63
|
0
|
|
0
|
|
|
|
my $data= shift || croak q{ I want yaml data. }; |
64
|
0
|
|
|
|
|
|
Egg::Plugin::YAML->yaml_load($data); |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
sub helper_stdout { |
67
|
0
|
|
|
0
|
1
|
|
require Egg::Util::STDIO; |
68
|
0
|
|
|
|
|
|
Egg::Util::STDIO->out(@_); |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
sub helper_stdin { |
71
|
0
|
|
|
0
|
1
|
|
require Egg::Util::STDIO; |
72
|
0
|
|
|
|
|
|
Egg::Util::STDIO->in(@_); |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
sub helper_load_rc { |
75
|
0
|
|
|
0
|
1
|
|
my $self= shift; |
76
|
0
|
|
0
|
|
|
|
my $pm = shift || {}; |
77
|
0
|
|
|
|
|
|
my $c = $self->config; |
78
|
0
|
|
|
|
|
|
require Egg::Plugin::rc; |
79
|
0
|
|
0
|
|
|
|
my $rc= Egg::Plugin::rc::load_rc |
80
|
|
|
|
|
|
|
($self, ($c->{root} || $c->{start_dir})) || {}; |
81
|
0
|
|
0
|
|
|
|
$rc->{author} ||= $rc->{copywright} || ""; |
|
|
|
0
|
|
|
|
|
82
|
0
|
|
0
|
|
|
|
$rc->{copywright} ||= $rc->{author} || ""; |
|
|
|
0
|
|
|
|
|
83
|
0
|
|
0
|
|
|
|
$rc->{headcopy} ||= $rc->{copywright} || ""; |
|
|
|
0
|
|
|
|
|
84
|
0
|
|
0
|
|
|
|
$rc->{license} ||= 'perl'; |
85
|
0
|
|
|
|
|
|
my %esc= ( "'"=> 'E<39>', '@'=> 'E<64>', "<"=> 'E<lt>', ">"=> 'E<gt>' ); |
86
|
0
|
|
|
|
|
|
for (qw{ author copyright headcopy }) { |
87
|
0
|
|
0
|
|
|
|
$rc->{$_} ||= $ENV{LOGNAME} || $ENV{USER} || 'none.'; |
|
|
|
0
|
|
|
|
|
88
|
0
|
|
|
|
|
|
$rc->{$_}=~s{([\'\@<>])} [$esc{$1}]gso; |
89
|
|
|
|
|
|
|
} |
90
|
0
|
|
|
|
|
|
@{$pm}{keys %$rc}= values %$rc; |
|
0
|
|
|
|
|
|
|
91
|
0
|
|
|
|
|
|
$pm; |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
sub helper_chdir { |
94
|
0
|
|
|
0
|
1
|
|
my $self= shift; |
95
|
0
|
0
|
|
|
|
|
my $path= $_[0] ? ($_[1] ? [@_]: $_[0]): croak q{ I want path. }; |
|
|
0
|
|
|
|
|
|
96
|
0
|
0
|
|
|
|
|
$path= [$path, 0] unless ref($path) eq 'ARRAY'; |
97
|
0
|
0
|
0
|
|
|
|
$self->helper_create_dir($path->[0]) if ($path->[1] && ! -e $path->[0]); |
98
|
0
|
|
|
|
|
|
print "= change dir : $path->[0]\n"; |
99
|
0
|
0
|
|
|
|
|
chdir($path->[0]) || croak qq{$! : $path->[0] }; |
100
|
|
|
|
|
|
|
} |
101
|
|
|
|
|
|
|
sub helper_create_dir { |
102
|
0
|
|
|
0
|
1
|
|
require File::Path; |
103
|
0
|
|
|
|
|
|
my $self= shift; |
104
|
0
|
0
|
|
|
|
|
my $path= $_[0] ? ($_[1] ? [@_]: $_[0]): croak q{ I want path. }; |
|
|
0
|
|
|
|
|
|
105
|
0
|
0
|
|
|
|
|
$path= [$path] unless ref($path) eq 'ARRAY'; |
106
|
0
|
|
|
|
|
|
File::Path::mkpath($path, 1, 0755); ## no critic |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
sub helper_remove_dir { |
109
|
0
|
|
|
0
|
1
|
|
require File::Path; |
110
|
0
|
|
|
|
|
|
my $self= shift; |
111
|
0
|
0
|
|
|
|
|
my $path= $_[0] ? ($_[1] ? [@_]: $_[0]): croak q{ I want dir. }; |
|
|
0
|
|
|
|
|
|
112
|
0
|
0
|
|
|
|
|
$path= [$path] unless ref($path) eq 'ARRAY'; |
113
|
0
|
|
|
|
|
|
print "- remove dir : ". join(', ', @$path). "\n"; |
114
|
0
|
0
|
|
|
|
|
File::Path::rmtree($path) || return 0; |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
sub helper_remove_file { |
117
|
0
|
|
|
0
|
1
|
|
my $self= shift; |
118
|
0
|
0
|
|
|
|
|
my $path= $_[0] ? ($_[1] ? [@_]: $_[0]): croak q{ I want file path. }; |
|
|
0
|
|
|
|
|
|
119
|
0
|
0
|
|
|
|
|
$path= [$path] unless ref($path) eq 'ARRAY'; |
120
|
0
|
0
|
|
|
|
|
for (@$path) { print "+ remove file: $_\n" if unlink($_) } |
|
0
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
sub helper_read_file { |
123
|
0
|
|
|
0
|
1
|
|
require FileHandle; |
124
|
0
|
|
|
|
|
|
my $self= shift; |
125
|
0
|
|
0
|
|
|
|
my $file= shift || croak q{ I want file path. }; |
126
|
0
|
|
0
|
|
|
|
my $fh = FileHandle->new($file) || croak qq{ '$file' : $! }; |
127
|
0
|
|
|
|
|
|
binmode $fh; |
128
|
0
|
|
|
|
|
|
my $value= join '', <$fh>; |
129
|
0
|
|
|
|
|
|
$fh->close; |
130
|
0
|
0
|
|
|
|
|
defined($value) ? $value: ""; |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
*helper_fread= \&helper_read_file; |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
sub helper_save_file { |
135
|
0
|
|
|
0
|
1
|
|
require File::Spec; |
136
|
0
|
|
|
|
|
|
require File::Basename; |
137
|
0
|
|
|
|
|
|
my $self = shift; |
138
|
0
|
|
0
|
|
|
|
my $path = shift || croak q{ I want save path. }; |
139
|
0
|
|
0
|
|
|
|
my $value= shift || croak q{ I want save value. }; |
140
|
0
|
|
0
|
|
|
|
my $type = shift || 'text'; |
141
|
0
|
|
|
|
|
|
my $base = File::Basename::dirname($path); |
142
|
0
|
0
|
|
|
|
|
if ($type=~m{^bin}i) { |
143
|
0
|
|
|
|
|
|
MIME::Base64->require; |
144
|
0
|
|
|
|
|
|
$$value= MIME::Base64::decode_base64($$value); |
145
|
|
|
|
|
|
|
} |
146
|
0
|
0
|
0
|
|
|
|
if (! -e $base || ! -d _) { |
147
|
0
|
0
|
|
|
|
|
$self->helper_create_dir($base) || die qq{ $! : $base }; |
148
|
|
|
|
|
|
|
} |
149
|
0
|
|
|
|
|
|
my @path= split /[\\\/\:]+/, $path; |
150
|
0
|
|
|
|
|
|
my $file= File::Spec->catfile(@path); |
151
|
0
|
|
0
|
|
|
|
open FH, "> $file" || die qq{ File Open Error: $file - $! }; ## no critic |
152
|
0
|
|
|
|
|
|
binmode(FH); |
153
|
0
|
|
|
|
|
|
print FH $$value; |
154
|
0
|
|
|
|
|
|
close FH; |
155
|
0
|
0
|
|
|
|
|
if (-e $file) { |
156
|
0
|
|
|
|
|
|
print "+ create file: ${file}\n"; |
157
|
0
|
0
|
0
|
|
|
|
if ($type=~m{^script}i or $type=~m{^bin_exec}i) { |
158
|
0
|
0
|
|
|
|
|
if ( chmod 0700, $file ) ## no critic |
159
|
0
|
|
|
|
|
|
{ print "+ chmod 0700: ${file}\n" } |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
} else { |
162
|
0
|
|
|
|
|
|
print "- create Failure : ${file}\n"; |
163
|
|
|
|
|
|
|
} |
164
|
0
|
|
|
|
|
|
return 1; |
165
|
|
|
|
|
|
|
} |
166
|
|
|
|
|
|
|
sub helper_create_file { |
167
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
168
|
0
|
|
0
|
|
|
|
my $data = shift || croak q{ I want data. }; |
169
|
0
|
|
0
|
|
|
|
my $param= shift || 0; |
170
|
0
|
|
0
|
|
|
|
my $path = $self->egg_var(($param || {}), $data->{filename}) |
171
|
|
|
|
|
|
|
|| croak q{ I want data->{filename} }; |
172
|
0
|
|
0
|
|
|
|
my $type = $data->{filetype} || ""; |
173
|
|
|
|
|
|
|
my $value= $type=~m{^bin}i ? do { |
174
|
0
|
|
|
|
|
|
$data->{value}; |
175
|
|
|
|
|
|
|
}: $param ? do { |
176
|
0
|
0
|
|
|
|
|
$self->egg_var($param, \$data->{value}, $path) || ""; |
177
|
0
|
0
|
|
|
|
|
}: do { |
|
|
0
|
|
|
|
|
|
178
|
0
|
0
|
|
|
|
|
defined($data->{value}) ? $data->{value}: ""; |
179
|
|
|
|
|
|
|
}; |
180
|
0
|
|
|
|
|
|
$self->helper_save_file($path, \$value, $type); |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
sub helper_create_files { |
183
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
184
|
0
|
|
0
|
|
|
|
my $data = shift || croak q{ I want data. }; |
185
|
0
|
0
|
|
|
|
|
$data= [$data] unless ref($data) eq 'ARRAY'; |
186
|
0
|
|
0
|
|
|
|
my $param= shift || 0; |
187
|
0
|
|
|
|
|
|
$self->helper_create_file($_, $param) for @$data; |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
sub helper_document_template { |
190
|
0
|
|
|
0
|
1
|
|
my $self= shift; |
191
|
0
|
|
0
|
|
|
|
$self->{helper_document_template} |
192
|
|
|
|
|
|
|
||= $self->helper_yaml_load(join '', <DATA>); |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
sub helper_valid_version_number { |
195
|
0
|
|
|
0
|
1
|
|
my $self= shift; |
196
|
0
|
|
0
|
|
|
|
my $version= shift || '0.01'; |
197
|
0
|
0
|
|
|
|
|
$version=~m{^\d+\.\d\d+$} |
198
|
|
|
|
|
|
|
|| return $self->_helper_help('Bad format of version number.'); |
199
|
0
|
|
|
|
|
|
$version; |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
sub helper_prepare_param { |
202
|
0
|
|
|
0
|
1
|
|
my $self= shift; |
203
|
0
|
|
0
|
|
|
|
my $pm = shift || {}; |
204
|
0
|
|
|
|
|
|
require Egg::Release; |
205
|
0
|
|
|
|
|
|
my $pname= $self->config->{project_name}; |
206
|
0
|
|
0
|
|
|
|
$pm->{project_name} ||= $pname; |
207
|
0
|
|
|
|
|
|
$pm->{lib_dir}= "lib/${pname}"; |
208
|
0
|
|
|
|
|
|
$pm->{lc_project_name}= lc($pname); |
209
|
0
|
|
|
|
|
|
$pm->{uc_project_name}= uc($pname); |
210
|
0
|
|
|
|
|
|
$pm->{ucfirst_project_name}= ucfirst($pname); |
211
|
0
|
|
|
|
|
|
$pm->{project_root}= $self->config->{root}; |
212
|
0
|
|
0
|
|
|
|
$pm->{output_path} ||= $pm->{project_root}; |
213
|
0
|
|
|
|
|
|
$pm->{dir} = $self->config->{dir}; |
214
|
0
|
|
|
0
|
|
|
$pm->{root}= sub { $self->config->{root} }; |
|
0
|
|
|
|
|
|
|
215
|
0
|
|
|
0
|
|
|
$pm->{year}= sub { (localtime time)[5]+ 1900 }; |
|
0
|
|
|
|
|
|
|
216
|
0
|
|
|
0
|
|
|
$pm->{perl_path}= sub { $self->helper_perl_path }; |
|
0
|
|
|
|
|
|
|
217
|
0
|
|
|
0
|
|
|
$pm->{gmtime_string}= sub { gmtime time }; |
|
0
|
|
|
|
|
|
|
218
|
0
|
|
0
|
|
|
|
$pm->{created} ||= "Egg::Helper v". Egg::Helper->VERSION; |
219
|
0
|
|
|
|
|
|
$pm->{revision} = '$'. 'Id'. '$'; |
220
|
0
|
|
0
|
|
|
|
$pm->{module_version} ||= 0.01; |
221
|
0
|
0
|
|
|
|
|
$pm->{perl_version}= $] > 5.006 ? sprintf "%vd", $^V : sprintf "%s", $]; |
222
|
0
|
|
|
|
|
|
$pm->{egg_release_version}= Egg::Release->VERSION; |
223
|
0
|
0
|
|
|
|
|
if (my $egg_inc= $ENV{EGG_INC}) { |
224
|
0
|
|
|
|
|
|
$pm->{egg_inc}= qq{\nuse lib qw(} |
225
|
|
|
|
|
|
|
. join(' ', split /\s*[\, ]\s*/, $egg_inc). qq{);}; |
226
|
|
|
|
|
|
|
} else { |
227
|
0
|
|
|
|
|
|
$pm->{egg_inc}= ""; ## "\nuse lib qw( ../../lib ../lib ./lib );"; |
228
|
|
|
|
|
|
|
} |
229
|
0
|
|
|
|
|
|
$self->helper_load_rc($pm); |
230
|
0
|
|
|
|
|
|
my $data= $self->helper_document_template; |
231
|
|
|
|
|
|
|
$pm->{document}= sub { |
232
|
0
|
|
|
0
|
|
|
my($proto, $param, $fname)= @_; |
233
|
0
|
|
|
|
|
|
my $pod_text= $data->{pod_text}; |
234
|
0
|
|
0
|
|
|
|
$proto->egg_var($param, \$pod_text, ($fname || "")); |
235
|
0
|
|
|
|
|
|
}; |
236
|
0
|
|
|
|
|
|
my %param_cache; |
237
|
|
|
|
|
|
|
$pm->{dist}= sub { |
238
|
0
|
|
|
0
|
|
|
my($proto, $param)= splice @_, 0, 2; |
239
|
0
|
|
0
|
|
|
|
my $fname= $proto->_conv_unix_path(@_) || return ""; |
240
|
0
|
0
|
|
|
|
|
return $param_cache{$fname} if $param_cache{$fname}; |
241
|
0
|
|
|
|
|
|
my $tmp= $fname; |
242
|
0
|
|
|
|
|
|
$tmp=~s{^[A-Za-z]\:+} []; |
243
|
0
|
|
0
|
|
|
|
for my $regex |
244
|
|
|
|
|
|
|
(($pm->{output_path} || $pm->{project_root}), $pm->{module_name}) { |
245
|
0
|
0
|
|
|
|
|
next unless $regex; |
246
|
0
|
|
|
|
|
|
$regex= quotemeta($regex); |
247
|
0
|
|
|
|
|
|
$tmp=~s{^$regex} []; |
248
|
0
|
|
|
|
|
|
$tmp=~s{^\.?/+} []; |
249
|
|
|
|
|
|
|
} |
250
|
0
|
|
|
|
|
|
$tmp=~s{^lib} []; |
251
|
0
|
|
|
|
|
|
$tmp=~s{^\.?/+} []; |
252
|
0
|
|
|
|
|
|
$tmp=~s{\.pm$} []; |
253
|
0
|
|
|
|
|
|
$tmp=~s{^(?:\:|\-)+} []o; |
254
|
0
|
|
|
|
|
|
$param_cache{$fname}= join '::', (split /\/+/, $tmp); |
255
|
0
|
|
|
|
|
|
}; |
256
|
0
|
|
|
|
|
|
$pm; |
257
|
|
|
|
|
|
|
} |
258
|
|
|
|
|
|
|
sub helper_prepare_param_module { |
259
|
0
|
|
|
0
|
1
|
|
my $self= shift; |
260
|
0
|
|
0
|
|
|
|
my $pm = shift || {}; |
261
|
0
|
0
|
|
|
|
|
my $name= ref($_[0]) eq 'ARRAY' ? $_[0]: \@_; |
262
|
0
|
|
0
|
|
|
|
my $output_path= $pm->{output_path} |
263
|
|
|
|
|
|
|
|| $self->config->{output_path} || croak q{ 'output_path' is empty. }; |
264
|
0
|
|
|
|
|
|
my @path; |
265
|
0
|
|
|
|
|
|
for (@$name) { |
266
|
0
|
|
|
|
|
|
my @n= split /\:+/, $_; |
267
|
0
|
|
|
|
|
|
splice @path, scalar(@path), 0, @n; |
268
|
|
|
|
|
|
|
} |
269
|
0
|
|
|
|
|
|
$pm->{module_name} = join('-', @path); |
270
|
0
|
|
|
|
|
|
$pm->{module_filepath}= join('/', @path). '.pm'; |
271
|
0
|
|
|
|
|
|
$pm->{module_distname}= join('::', @path); |
272
|
0
|
|
|
|
|
|
$pm->{module_basedir} = join('/', @path[0..($#path- 1)]); |
273
|
0
|
|
|
|
|
|
$pm->{module_filename}= $pm->{module_filepath}; |
274
|
0
|
|
|
|
|
|
$pm->{module_filename}=~s{^$pm->{module_basedir}} []; |
275
|
0
|
|
|
|
|
|
$pm->{module_filename}=~s{^/} []; |
276
|
0
|
|
|
|
|
|
$pm->{target_path} = "${output_path}/$pm->{module_name}"; |
277
|
0
|
|
|
|
|
|
$pm->{lib_dir} = "${output_path}/$pm->{module_name}/lib"; |
278
|
0
|
|
|
|
|
|
$pm->{lib_basedir} = "$pm->{lib_dir}/$pm->{module_basedir}"; |
279
|
0
|
|
|
|
|
|
$pm; |
280
|
|
|
|
|
|
|
} |
281
|
|
|
|
|
|
|
sub helper_generate_files { |
282
|
0
|
|
|
0
|
1
|
|
my $self= shift; |
283
|
0
|
0
|
|
|
|
|
my $attr= ref($_[0]) eq 'HASH' ? $_[0]: {@_}; |
284
|
0
|
|
0
|
|
|
|
my $pm= $attr->{param} || croak q{ I want generate param. }; |
285
|
0
|
0
|
|
|
|
|
$self->helper_chdir($attr->{chdir}) if $attr->{chdir}; |
286
|
0
|
|
|
|
|
|
eval { |
287
|
0
|
0
|
|
|
|
|
if (my $dirs = $attr->{create_dirs}) |
288
|
0
|
|
|
|
|
|
{ $self->helper_create_dir($_) for @$dirs } |
289
|
0
|
0
|
|
|
|
|
if (my $files= $attr->{create_files}) |
290
|
0
|
|
|
|
|
|
{ $self->helper_create_file($_, $pm) for @$files } |
291
|
0
|
0
|
|
|
|
|
if (my $code = $attr->{create_code}) |
292
|
0
|
|
|
|
|
|
{ $code->($self, $attr) } |
293
|
0
|
0
|
|
|
|
|
if ($attr->{makemaker_ok}) |
294
|
0
|
|
|
|
|
|
{ $self->_helper_execute_makemaker } |
295
|
0
|
0
|
|
|
|
|
if (my $message= $attr->{complete_msg}) { |
296
|
0
|
|
|
|
|
|
print $message. "\n\n"; |
297
|
|
|
|
|
|
|
} else { |
298
|
0
|
|
|
|
|
|
print "File generate is complete.\n\n"; |
299
|
|
|
|
|
|
|
} |
300
|
|
|
|
|
|
|
}; |
301
|
0
|
0
|
|
|
|
|
$self->helper_chdir($self->config->{start_dir}) if $attr->{chdir}; |
302
|
0
|
|
0
|
|
|
|
my $error= $@ || return 1; |
303
|
0
|
|
|
|
|
|
my $msg; |
304
|
0
|
0
|
|
|
|
|
if (my $err= $attr->{errors}) { |
305
|
0
|
|
0
|
|
|
|
$msg= $err->{message} || ""; |
306
|
0
|
0
|
|
|
|
|
if (my $dirs = $err->{rmdir}) { $self->helper_remove_dir($dirs) } |
|
0
|
|
|
|
|
|
|
307
|
0
|
0
|
|
|
|
|
if (my $files= $err->{unlink}) { $self->helper_remove_file(@$files) } |
|
0
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
} |
309
|
0
|
|
0
|
|
|
|
$msg ||= '>> File generate error'; |
310
|
0
|
|
|
|
|
|
die "${msg}:\n $error"; |
311
|
|
|
|
|
|
|
} |
312
|
|
|
|
|
|
|
sub helper_get_dbi_attr { |
313
|
0
|
|
|
0
|
1
|
|
shift; { |
314
|
0
|
0
|
0
|
|
|
|
table => ($ENV{EGG_DBI_TEST_TABLE} || 'egg_release_dbi_test'), |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
315
|
|
|
|
|
|
|
dsn => ($ENV{EGG_DBI_DSN} || ""), |
316
|
|
|
|
|
|
|
user => ($ENV{EGG_DBI_USER} || ""), |
317
|
|
|
|
|
|
|
password=> ($ENV{EGG_DBI_PASSWORD} || ""), |
318
|
|
|
|
|
|
|
host => ($ENV{EGG_DBI_HOST} || ""), |
319
|
|
|
|
|
|
|
port => ($ENV{EGG_DBI_PORT} || ""), |
320
|
|
|
|
|
|
|
options => ($_[1] ? {@_}: ($_[0] || {})), |
321
|
|
|
|
|
|
|
}; |
322
|
|
|
|
|
|
|
} |
323
|
|
|
|
|
|
|
sub helper_http_request { |
324
|
0
|
|
|
0
|
1
|
|
require HTTP::Request::Common; |
325
|
0
|
|
|
|
|
|
my $self = shift; |
326
|
0
|
|
0
|
|
|
|
my $method = uc(shift) || 'GET'; |
327
|
0
|
|
0
|
|
|
|
my $uri = shift || '/request'; |
328
|
37
|
|
|
37
|
|
409
|
no strict 'refs'; ## no critic. |
|
37
|
|
|
|
|
77
|
|
|
37
|
|
|
|
|
27355
|
|
329
|
0
|
|
|
|
|
|
my $q= &{"HTTP::Request::Common::$method"}( $uri=> @_); |
|
0
|
|
|
|
|
|
|
330
|
0
|
|
|
|
|
|
my $result= $q->as_string; |
331
|
0
|
|
|
|
|
|
$result=~s{^(?:GET|POST)[^\r\n]+\r?\n} []; |
332
|
0
|
|
|
|
|
|
$result=~s{Content\-Length\:\s+(\d+)\r?\n} |
333
|
0
|
|
|
|
|
|
[ $ENV{CONTENT_LENGTH}= $1; "" ]e; |
|
0
|
|
|
|
|
|
|
334
|
0
|
|
|
|
|
|
$result=~s{Content\-Type\:\s+([^\n]+)\r?\n} |
335
|
0
|
|
|
|
|
|
[ $ENV{CONTENT_TYPE}= $1; "" ]e; |
|
0
|
|
|
|
|
|
|
336
|
0
|
|
|
|
|
|
$result; |
337
|
|
|
|
|
|
|
} |
338
|
|
|
|
|
|
|
sub _helper_execute_makemaker { |
339
|
0
|
|
|
0
|
|
|
my($self)= @_; |
340
|
0
|
0
|
0
|
|
|
|
return unless ($self->helper_is_unix |
|
|
|
0
|
|
|
|
|
341
|
|
|
|
|
|
|
or (exists($ENV{EGG_MAKEMAKER}) and $ENV{EGG_MAKEMAKER}) ); |
342
|
0
|
|
|
|
|
|
Module::Install->require; |
343
|
0
|
0
|
0
|
|
|
|
if ($@ and $@=~m{^Can\'t\s+locate\s+(?:inc[/\:]+)?Module[/\:]+Install(?:\.pm)?\s+} ) { |
344
|
0
|
|
|
|
|
|
warn "\nWarning: Module::Install is not installed !!\n"; |
345
|
0
|
|
|
|
|
|
return 1; |
346
|
|
|
|
|
|
|
} |
347
|
0
|
|
|
|
|
|
eval{ |
348
|
0
|
0
|
|
|
|
|
system('perl Makefile.PL') and die $!; |
349
|
0
|
0
|
|
|
|
|
system('make manifest') and die $!; |
350
|
0
|
0
|
|
|
|
|
system('make') and die $!; |
351
|
0
|
0
|
|
|
|
|
system('make test') and die $!; |
352
|
|
|
|
|
|
|
}; |
353
|
0
|
0
|
|
|
|
|
if (my $err= $@) { print $err } |
|
0
|
|
|
|
|
|
|
354
|
0
|
|
|
|
|
|
eval{ `make distclean` }; |
|
0
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
} |
356
|
|
|
|
|
|
|
sub _helper_help { |
357
|
0
|
|
|
0
|
|
|
my $self= shift; |
358
|
0
|
|
0
|
|
|
|
my $msg = shift || ""; |
359
|
0
|
0
|
|
|
|
|
$msg= ">> ${msg}\n\n" if $msg; |
360
|
0
|
|
|
|
|
|
print <<END_HELP; |
361
|
|
|
|
|
|
|
${msg}% perl egg_helper.pl [MODE] -h |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
END_HELP |
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
sub _conv_unix_path { |
366
|
0
|
|
|
0
|
|
|
my $self= shift; |
367
|
0
|
|
0
|
|
|
|
my $path= shift || return ""; |
368
|
0
|
0
|
|
|
|
|
return $path if $self->helper_is_unix; |
369
|
0
|
0
|
|
|
|
|
my $regixp= $self->helper_is_mac ? qr{\:}: qr{\\}; |
370
|
0
|
|
|
|
|
|
$path=~s{$regixp+} [/]g; |
371
|
0
|
|
|
|
|
|
$path; |
372
|
|
|
|
|
|
|
} |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
1; |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
=head1 NAME |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
Egg::Helper::Util::Base - Utility for a helper module. |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
=head1 DESCRIPTION |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
It is a utility class for the helper module. |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
=head1 METHODS |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
The method of this module can be used in the shape succeeded to to L<Egg::Helper>. |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
These methods are the one having aimed at use from the helper module. |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
=head2 helper_perl_path |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
Passing perl is acquired and returned by L<File::Which>. |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
However, if PERL_PATH is set in the environment variable, the value is returned. |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
my $perl_path= Egg::Helper->helper_perl_path; |
397
|
|
|
|
|
|
|
|
398
|
|
|
|
|
|
|
=head2 helper_temp_dir |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
The work directory is temporarily made from L<File::Temp>, and the passing is |
401
|
|
|
|
|
|
|
returned. |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
When the process is annulled, the made directory is deleted by the automatic |
404
|
|
|
|
|
|
|
operation. |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
my $tempdir= Egg::Helper->helper_temp_dir; |
407
|
|
|
|
|
|
|
|
408
|
|
|
|
|
|
|
=over 4 |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
=item * Alias = helper_tempdir |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
=back |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
=head2 helper_current_dir |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
A current now passing is acquired and returned by L<Cwd>. |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
my $current_dir= Egg::Helper->helper_current_dir; |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
=head2 helper_is_platform |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
The name of the platform under operation is returned. |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
It is only Win32, MacOS, and Unix to be returned. |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
All Unix is returned if it is Win32, MacOS, and it doesn't exist. |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
=head2 helper_is_unix |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
The platform under operation returns and Win32 and MacOS return true if it is not. |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
=head2 helper_is_win32 |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
If the platform under operation is Win32, true is returned. |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
=head2 helper_is_macos |
437
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
If the platform under operation is MacOS, true is returned. |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
=over 4 |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
=item * helper_is_mac |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
=back |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
=head2 helper_yaml_load ([YAML_TEXT]) |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
The text of the YAML form is converted into data and it returns it. |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
my $hash= Egg::Helper->helper_yaml_load($yaml_text); |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
=head2 helper_stdout ([ARGS]) |
453
|
|
|
|
|
|
|
|
454
|
|
|
|
|
|
|
ARGS is passed to the out method of L<Egg::Util::STDIO>, and the result is returned. |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
=head2 helper_stdin ([ARGS]) |
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
ARGS is passed to the in method of L<Egg::Util::STDIO>, and the result is returned. |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
=head2 helper_load_rc ([HASH_REF]) |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
The rc file arranged by L<Egg::Plugin::rc> for the project is read. |
463
|
|
|
|
|
|
|
|
464
|
|
|
|
|
|
|
And, it read from the rc file, and author, copywright, headcopy, and license are |
465
|
|
|
|
|
|
|
set to HASH_REF and it returns it. |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
=head2 helper_chdir ([PATH_STR], [BOOL]) |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
The current directory is moved to PATH_STR. |
470
|
|
|
|
|
|
|
And, the moving destination is output to STDOUT. |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
It makes it if there is no moving destination when BOOL is given. |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
$helper->helper_chdir('/path/to/move', 1); |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
=head2 helper_create_dir ([PATH_LIST]) |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
The directory of PATH_LIST is made and the passing is output to STDOUT. |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
There is exist former directory not worrying because it uses 'mkpath' of L<File::Path>. |
481
|
|
|
|
|
|
|
|
482
|
|
|
|
|
|
|
$helper->helper_create_dir('/path/to/hoge', '/path/to/booo'); |
483
|
|
|
|
|
|
|
|
484
|
|
|
|
|
|
|
=head2 helper_remove_dir ([PATH_LIST]) |
485
|
|
|
|
|
|
|
|
486
|
|
|
|
|
|
|
The directory of PATH_LIST is deleted and the passing is output to STDOUT. |
487
|
|
|
|
|
|
|
L<File::Path> Because drinking 'rmtree' is used, all subordinate's directories |
488
|
|
|
|
|
|
|
are deleted. |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
$helper->helper_remove_dir('/path/to/hoge', '/path/to/booo'); |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
=head2 helper_remove_file ([PATH_LIST]) |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
All files of PATH_LIST are deleted and the passing is output to STDOUT. |
495
|
|
|
|
|
|
|
The deletion fails if passing specified this is specializing in the file is a |
496
|
|
|
|
|
|
|
file and doesn't exist. |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
$helper->helper_remove_file('/path/to/hoge.txt', '/path/to/booo.tmp'); |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
=head2 helper_read_file ([FILE_PATH]) |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
The content is returned reading FILE_PATH. Because binmode is always done, it is |
503
|
|
|
|
|
|
|
possible to read even by the binary. |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
my $value= $helper->helper_read_file('/path/to/hoge.txt'); |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
=over 4 |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
=item * Alias = helper_fread |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
=back |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
=head2 helper_save_file ([PATH], [SCALAR_REF], [TYPE]) |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
The file is generated. |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
PATH is passing of the generation file. |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
SCALAR_REF is a content of the generated file. |
520
|
|
|
|
|
|
|
It gives it by the SCALAR reference. |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
After it generates it, the execution attribute of 0700 is set if TYPE is script |
523
|
|
|
|
|
|
|
or 'bin_exec'. |
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
If it is a name that TYPE starts by bin, it puts it into the state to restore |
526
|
|
|
|
|
|
|
SCALAR_REF with L<MIME::Base64>. |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
If the directory of the generation place doesn't exist, 'helper_create_dir' is |
529
|
|
|
|
|
|
|
done and the directory is made. |
530
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
And, the generation situation is output to STDOUT. |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
$helper->helper_save_file('/path/to/', $value, 'text'); |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
The file is always written with binmode. |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
=head2 helper_create_file ([HASH_REF], [PARAM]) |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
'helper_save_file' is done according to the content of HASH_REF. |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
HASH_REF is HASH reference with the following keys. |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
filename ..... It corresponds to PATH of 'helper_save_file'. |
544
|
|
|
|
|
|
|
value ..... It corresponds to SCALAR_REF of 'helper_save_file'. |
545
|
|
|
|
|
|
|
filetype ..... It corresponds to TYPE of 'helper_save_file'. |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
Moreover, it is L<Egg::Util> if it is a name that giving PARAM and filetype start |
548
|
|
|
|
|
|
|
by bin and it doesn't exist. It 'drinks egg_var'. |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
$helper->helper_create_file({ |
551
|
|
|
|
|
|
|
filename => '<e.die.etc>/hoge.txt', |
552
|
|
|
|
|
|
|
value => 'Create OK', |
553
|
|
|
|
|
|
|
filetype => 'text', |
554
|
|
|
|
|
|
|
}, $e->config ); |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
=head2 helper_create_files ([CREATE_LIST], [PARAM]) |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
Two or more files are generated with helper_create_file based on CREATE_LIST. |
559
|
|
|
|
|
|
|
In CREATE_LIST, it is ARRAY always reference, and each element is HASH_REF passed |
560
|
|
|
|
|
|
|
to helper_create_file. |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
PARAM extends to helper_create_file as it is. |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
$helper->helper_create_files |
565
|
|
|
|
|
|
|
([ $helper->helper_yaml_load( join '', <DATA> ) ]) |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
=head2 helper_document_template |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
The document sample to bury it under the content when the module is generated is |
570
|
|
|
|
|
|
|
returned. |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
my $sample= $helper->helper_document_template; |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
=head2 helper_valid_version_number ([VERSION_NUM]) |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
It examines whether VERSION_NUM is suitable as the version number of the module. |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
'_helper_help' is called in case of not being suitably. |
579
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
When VERSION_NUM is omitted, '0.01' is returned. |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
my $version= $helper->helper_valid_version_number($o->{version}); |
583
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
=head2 helper_prepare_param ([PARAM]) |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
Each parameter needed when the file is generated is set in PARAM and it returns it. |
587
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
PARAM is omissible. Thing made HASH reference when giving it. |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
my $param= $helper->helper_prepare_param; |
591
|
|
|
|
|
|
|
$helper->helper_create_files($data, $param); |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
=head2 helper_prepare_param_module ([PARAM]) |
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
Each parameter needed when the module is generated is set in PARAM and it returns it. |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
my $param= $helper->helper_prepare_param; |
598
|
|
|
|
|
|
|
$helper->helper_prepare_param_module($param); |
599
|
|
|
|
|
|
|
$helper->helper_create_files($data, $param); |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
=head2 helper_generate_files ([HASH_REF]) |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
A series of file generation processing according to the content of HASH_REF is |
604
|
|
|
|
|
|
|
done. |
605
|
|
|
|
|
|
|
|
606
|
|
|
|
|
|
|
HASH_REF is HASH reference of the following content. |
607
|
|
|
|
|
|
|
Only param is indispensable. |
608
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
=over 4 |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
=item * param |
612
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
It is a parameter acquired with 'helper_prepare_param' etc. |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
=item * chdir |
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
It extends to 'helper_chdir'. When the flag is given, it does by the ARRAY reference. |
618
|
|
|
|
|
|
|
|
619
|
|
|
|
|
|
|
=item * create_dirs |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
It is ARRAY reference passed to 'helper_create_dir'. |
622
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
=item * create_files |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
It is ARRAY reference passed to 'helper_create_files'. |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
=item * create_code |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
It is CODE reference for doing on the way as for some processing. |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
=item * makemaker_ok |
632
|
|
|
|
|
|
|
|
633
|
|
|
|
|
|
|
After the file is generated, '_helper_execute_makemaker' is done. |
634
|
|
|
|
|
|
|
|
635
|
|
|
|
|
|
|
=item * complete_msg |
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
It is a message after processing ends. |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
=item * errors |
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
It is a setting when the error occurs by processing the above-mentioned and |
642
|
|
|
|
|
|
|
HASH reference. |
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
=over 4 |
645
|
|
|
|
|
|
|
|
646
|
|
|
|
|
|
|
=item * message |
647
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
Message when error occurs. |
649
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
=item * rmdir |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
List of directory passed to 'helper_remove_dir'. |
653
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
=item * unlink |
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
List of file passed to 'helper_remove_file'. |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
=back |
659
|
|
|
|
|
|
|
|
660
|
|
|
|
|
|
|
=back |
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
=head2 helper_get_dbi_attr ([HASH]) |
663
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
The setting concerning DBI for Egg is acquired from the environment variable. |
665
|
|
|
|
|
|
|
This is the one having aimed at the thing used in the test of the package. |
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
The following environment variables are acquired and the HASH reference is |
668
|
|
|
|
|
|
|
returned. |
669
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
{ |
671
|
|
|
|
|
|
|
table => ($ENV{EGG_DBI_TEST_TABLE} || 'egg_release_dbi_test'), |
672
|
|
|
|
|
|
|
dsn => ($ENV{EGG_DBI_DSN} || ""), |
673
|
|
|
|
|
|
|
user => ($ENV{EGG_DBI_USER} || ""), |
674
|
|
|
|
|
|
|
password=> ($ENV{EGG_DBI_PASSWORD} || ""), |
675
|
|
|
|
|
|
|
options => ($_[1] ? {@_}: ($_[0] || {})), |
676
|
|
|
|
|
|
|
}; |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
=head2 helper_http_request ([REQUEST_METHOD], [URI], [PARAM]) |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
When emulation is done in the code, the WEB request is convenient for this in |
681
|
|
|
|
|
|
|
the package test. |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
L<HTTP::Request::Common> is done, and 'as_string' of L<HTTP::Request> is received. |
684
|
|
|
|
|
|
|
And, after environment variable CONTENT_LENGTH and CONTENT_TYPE are set, |
685
|
|
|
|
|
|
|
the fragment of as_ string is returned. |
686
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
=head2 _helper_execute_makemaker |
688
|
|
|
|
|
|
|
|
689
|
|
|
|
|
|
|
Perl Makefile.PL etc. are executed at the command line level in the current |
690
|
|
|
|
|
|
|
directory. |
691
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
When the error occurs, the exception is not generated. It only reports on the |
693
|
|
|
|
|
|
|
error to STOUT. |
694
|
|
|
|
|
|
|
|
695
|
|
|
|
|
|
|
Moreover, helper_is_unix returns false and if environment variable EGG_MAKEMAKER |
696
|
|
|
|
|
|
|
is also undefined, it returns it without doing anything. |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
When L<Module::Install> is not installed, only warning is vomited and nothing is |
699
|
|
|
|
|
|
|
done. |
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
=head2 _helper_help ([MSG]) |
702
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
Help of default is displayed. |
704
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
After it helps, it is displayed in the part when MSG is passed. |
706
|
|
|
|
|
|
|
|
707
|
|
|
|
|
|
|
=head1 SEE ALSO |
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
L<Egg::Release>, |
710
|
|
|
|
|
|
|
L<Egg::Helper>, |
711
|
|
|
|
|
|
|
L<Egg::Plugin::YAML>, |
712
|
|
|
|
|
|
|
L<Egg::Plugin::rc>, |
713
|
|
|
|
|
|
|
L<Egg::Util::STDIO>, |
714
|
|
|
|
|
|
|
L<Egg::Exception>, |
715
|
|
|
|
|
|
|
L<Cwd>, |
716
|
|
|
|
|
|
|
L<File::Basename>, |
717
|
|
|
|
|
|
|
L<File::Path>, |
718
|
|
|
|
|
|
|
L<File::Spec>, |
719
|
|
|
|
|
|
|
L<File::Temp>, |
720
|
|
|
|
|
|
|
L<File::Which>, |
721
|
|
|
|
|
|
|
L<FileHandle>, |
722
|
|
|
|
|
|
|
L<Getopt::Easy>, |
723
|
|
|
|
|
|
|
L<HTTP::Request::Common>, |
724
|
|
|
|
|
|
|
L<MIME::Base64>, |
725
|
|
|
|
|
|
|
L<UNIVERSAL::require>, |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
=head1 AUTHOR |
728
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
Masatoshi Mizuno E<lt>lusheE<64>cpan.orgE<gt> |
730
|
|
|
|
|
|
|
|
731
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
732
|
|
|
|
|
|
|
|
733
|
|
|
|
|
|
|
Copyright (C) 2008 Bee Flag, Corp. E<lt>L<http://egg.bomcity.com/>E<gt>. |
734
|
|
|
|
|
|
|
|
735
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
736
|
|
|
|
|
|
|
it under the same terms as Perl itself, either Perl version 5.8.6 or, |
737
|
|
|
|
|
|
|
at your option, any later version of Perl 5 you may have available. |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
=cut |
740
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
|
744
|
|
|
|
|
|
|
__DATA__ |
745
|
|
|
|
|
|
|
pod_text: | |
746
|
|
|
|
|
|
|
# Below is stub documentation for your module. You'd better edit it! |
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
=head1 NAME |
749
|
|
|
|
|
|
|
|
750
|
|
|
|
|
|
|
< e.dist > - Perl extension for ... |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
=head1 SYNOPSIS |
753
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
use < e.dist >; |
755
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
... tansu, ni, gon, gon. |
757
|
|
|
|
|
|
|
|
758
|
|
|
|
|
|
|
=head1 DESCRIPTION |
759
|
|
|
|
|
|
|
|
760
|
|
|
|
|
|
|
Stub documentation for < e.dist >, created by < e.created > |
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
Blah blah blah. |
763
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
=head1 SEE ALSO |
765
|
|
|
|
|
|
|
|
766
|
|
|
|
|
|
|
L<Egg::Release>, |
767
|
|
|
|
|
|
|
|
768
|
|
|
|
|
|
|
=head1 AUTHOR |
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
< e.author > |
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
773
|
|
|
|
|
|
|
|
774
|
|
|
|
|
|
|
Copyright (C) < e.year > by < e.copyright >. |
775
|
|
|
|
|
|
|
|
776
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
777
|
|
|
|
|
|
|
it under the same terms as Perl itself, either Perl version < e.perl_version > or, |
778
|
|
|
|
|
|
|
at your option, any later version of Perl 5 you may have available. |
779
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
=cut |