| 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 |