File Coverage

blib/lib/File/Stubb.pm

Criterion	Covered	Total	%
statement	101	146	69.1
branch	16	44	36.3
condition	10	36	27.7
subroutine	24	28	85.7
pod	2	4	50.0
total	153	258	59.3

line	stmt	bran	cond	sub	pod	time	code
1							package File::Stubb;
2	2			2		510503	use 5.016;
	2					10
3							our $VERSION = '0.04';
4	2			2		13	use strict;
	2					9
	2					74
5	2			2		16	use warnings;
	2					4
	2					147
6
7	2			2		26	use File::Basename;
	2					4
	2					210
8	2			2		1662	use Getopt::Long;
	2					33768
	2					13
9
10	2			2		1612	use File::Stubb::Home;
	2					6
	2					146
11	2			2		1118	use File::Stubb::Render;
	2					9
	2					163
12
13							use constant {
14	2					5465	MODE_DEFAULT => 0,
15							MODE_BATCH => 1,
16							MODE_LIST => 2,
17	2			2		19	};
	2					4
18
19							$0 =~ s!^.*[/\\]!!;
20
21							my $PRGNAM = 'stubb';
22							my $PRGVER = $VERSION;
23
24							my $HELP = <<"HERE";
25							$PRGNAM - $PRGVER
26							Usage:
27							$0 [options] file template
28							$0 [options] file.template
29							$0 [options] -t template file ...
30							$0 [options] -l template
31
32							Options:
33							-d\|--template-dir= Specify template directory
34							-t\|--template=
35							-s\|--substitute= Provide stubb substitution parameters
36							-a\|--hidden Toggle whether to render hidden files or not
37							-A\|--no-hidden
38							-c\|--copy-perms Toggle whether to copy template permissions or not
39							-C\|--no-copy-perms
40							-w\|--follow-symlinks Toggle whether to follow symlinks or not
41							-W\|--no-follow-symlinks
42							-R\|--restricted Do not render Perl or shell targets
43							-U\|--no-defaults Disable the use of default substitution parameters
44							-I\|--no-config Ignore template's configuration file
45							-l\|--list List substitution targets in template
46							-q\|--quiet Disbale informative output
47
48							-h\|--help Display this help message
49							-v\|--version Display version/copyright info
50
51							Consults the $PRGNAM(1) manual for more documentation.
52							HERE
53
54							my $VER_MSG = <<"HERE";
55							$PRGNAM - $PRGVER
56
57							Copyright (C) 2025 Samuel Young
58
59							This program is free software: you can redistribute it and/or modify
60							it under the terms of the GNU General Public License as published by
61							the Free Software Foundation, either version 3 of the License, or
62							(at your option) any later version.
63							HERE
64
65							sub _subst_params {
66
67	2			2		6	my ($str) = @_;
68
69	2					5	my $params = {};
70
71							# Temporarily hide escaped commas.
72	2					9	$str =~ s/\\,/\x{fffd}/g;
73
74	2					40	my @kvs = grep { /=>/ } split /,/, $str;
	6					22
75
76	2					8	for my $kv (@kvs) {
77
78	6					19	my ($k, $v) = split /=>/, $kv, 2;
79	6					33	$k =~ s/^\s+\|\s+$//g;
80	6					25	$v =~ s/^\s+\|\s+$//g;
81
82	6	50				24	unless ($k =~ /^[a-zA-Z0-9_]+$/) {
83	0					0	die "'$k' is not a valid substitution target\n";
84							}
85
86	6					16	$v =~ s/\x{fffd}/,/g;
87
88	6					19	$params->{ $k } = $v;
89
90							}
91
92	2					8	return $params;
93
94							}
95
96							sub _get_template {
97
98	11			11		28	my ($self, $str, %param) = @_;
99	11		100			52	my $no_path = $param{ no_path } // 0;
100
101							my ($p) =
102	23					479	grep { -e }
103	23					273	map { File::Spec->catfile($_, "$str.stubb") }
104	11					20	@{ $self->{ TempDir } };
	11					30
105
106
107	11	50	33			87	if ($str !~ /[\/\\]/ and defined $p) {
		0	0
108	11					63	return $p;
109							} elsif (!$no_path and -e $str) {
110	0					0	return $str;
111							} else {
112	0					0	return undef;
113							}
114
115							}
116
117							sub render {
118
119	9			9	0	28	my ($self) = @_;
120
121							my $render = File::Stubb::Render->new(
122							template => $self->{ Template },
123							subst => $self->{ Subst },
124							ignore_config => $self->{ IgnoreConf },
125							render_hidden => $self->{ Hidden },
126							follow_symlinks => $self->{ FollowLinks },
127							copy_perms => $self->{ CopyPerms },
128							defaults => $self->{ Defaults },
129							restricted => $self->{ Restricted },
130	9					108	);
131
132	9					14	my @created;
133
134	9					10	for my $f (@{ $self->{ Files } }) {
	9					22
135	9					37	push @created, $render->render($f);
136							}
137
138	9	50	33			57	if ($self->{ Verbose } and $self->{ Files }[0] ne '-') {
139	9					209	say "Created:";
140	9					27	for my $f (@created) {
141	17					86	say " $f";
142							}
143							}
144
145	9					63	return 1;
146
147							}
148
149							sub list {
150
151	0			0	0	0	my ($self) = @_;
152
153							my $render = File::Stubb::Render->new(
154							template => $self->{ Template },
155							ignore_config => $self->{ IgnoreConf },
156							hidden => $self->{ Hidden },
157							follow_symlinks => $self->{ FollowLinks },
158							restricted => $self->{ Restricted },
159	0					0	);
160
161	0					0	my $targets = $render->targets;
162
163	0					0	my $have_basic = !! @{ $targets->{ basic } };
	0					0
164	0					0	my $have_perl = !! @{ $targets->{ perl } };
	0					0
165	0					0	my $have_shell = !! @{ $targets->{ shell } };
	0					0
166
167	0	0	0			0	unless ($have_basic or $have_perl or $have_shell) {
			0
168	0					0	say "No targets in $self->{ Template }";
169	0					0	return 1;
170							}
171
172	0	0				0	if ($have_basic) {
173	0					0	say "Substitution targets:";
174	0					0	for my $t (@{ $targets->{ basic } }) {
	0					0
175	0					0	say " $t";
176							}
177	0	0	0			0	print "\n" if $have_perl or $have_shell;
178							}
179
180	0	0				0	if ($have_perl) {
181	0					0	say "Perl targets:";
182	0					0	for my $t (@{ $targets->{ perl } }) {
	0					0
183	0					0	say " $t";
184							}
185	0	0				0	print "\n" if $have_shell;
186							}
187
188	0	0				0	if ($have_shell) {
189	0					0	say "Shell targets:";
190	0					0	for my $t (@{ $targets->{ shell } }) {
	0					0
191	0					0	say " $t";
192							}
193							}
194
195	0					0	return 1;
196
197							}
198
199							sub init {
200
201	11			11	1	252384	my ($class) = @_;
202
203	11					141	my $self = {
204							Mode => MODE_DEFAULT,
205							Files => [],
206							Template => undef,
207							Subst => undef,
208							TempDir => [],
209							Verbose => 1,
210							# Render options
211							Hidden => undef,
212							FollowLinks => undef,
213							CopyPerms => undef,
214							Defaults => undef,
215							IgnoreConf => undef,
216							Restricted => undef,
217							};
218
219	11					31	bless $self, $class;
220
221	11					22	my $subst = [];
222	11					15	my $temp;
223
224	11					48	Getopt::Long::config('bundling');
225							GetOptions(
226							'template-dir\|d=s' => $self->{ TempDir },
227							'template\|t=s' => sub {
228	1			1		1459	$self->{ Mode } = MODE_BATCH;
229	1					13	$temp = $_[1];
230							},
231							'substitute\|s=s' => $subst,
232	0			0		0	'list\|l' => sub { $self->{ Mode } = MODE_LIST },
233	1			1		1450	'quiet\|q' => sub { $self->{ Verbose } = 0 },
234							# Render options
235	1			1		1633	'hidden\|a' => sub { $self->{ Hidden } = 1 },
236	2			2		1818	'no-hidden\|A' => sub { $self->{ Hidden } = 0 },
237	1			1		136	'follow-symlinks\|w' => sub { $self->{ FollowLinks } = 1 },
238	1			1		192	'no-follow-symlinks\|W' => sub { $self->{ FollowLinks } = 0 },
239	1			1		140	'copy-perms\|c' => sub { $self->{ CopyPerms } = 1 },
240	1			1		154	'no-copy-perms\|C' => sub { $self->{ CopyPerms } = 0 },
241	1			1		1626	'restricted\|R' => sub { $self->{ Restricted } = 1 },
242	2			2		254	'no-defaults\|U' => sub { $self->{ Defaults } = 0 },
243	2			2		1852	'no-config\|I' => sub { $self->{ IgnoreConf } = 1 },
244							# Message options
245	0			0		0	'help\|h' => sub { print $HELP; exit 0 },
	0					0
246	0			0		0	'version\|v' => sub { print $VER_MSG; exit 0 },
	0					0
247	11	50				740	) or die "Invalid command-line arguments\n";
248
249	11	50				7940	if (exists $ENV{ STUBB_TEMPLATES }) {
250	11					21	push @{ $self->{ TempDir } }, split /:/, $ENV{ STUBB_TEMPLATES };
	11					63
251							}
252
253	11					21	push @{ $self->{ TempDir } }, File::Spec->catfile(home, '.stubb');
	11					65
254
255	11	100				49	if ($self->{ Mode } == MODE_DEFAULT) {
		50
		0
256	10		50			40	$self->{ Files }[0] = shift @ARGV // die $HELP;
257	10					20	$temp = shift @ARGV;
258	10	100				25	if (defined $temp) {
259	9		50			29	$self->{ Template } = $self->_get_template($temp)
260							// die "'$temp' is not a valid template\n";
261							} else {
262	1					70	$temp = (fileparse($self->{ Files }[0], qr/\.[^.]*/))[2];
263	1					5	$temp =~ s/^\.//;
264	1	50				4	if ($temp eq '') {
265	0					0	die "Please specify a stub template either by an additional argument or a file suffix\n";
266							}
267	1		50			19	$self->{ Template } = $self->_get_template($temp, no_path => 1)
268							// die "'$temp' is not a valid template\n";
269							}
270							} elsif ($self->{ Mode } == MODE_BATCH) {
271	1	50				4	die $HELP unless @ARGV;
272	1					4	$self->{ Template } = $self->_get_template($temp);
273	1					4	$self->{ Files } = [ @ARGV ];
274	1	50	33			2	if (@{ $self->{ Files } } > 1 and grep { $_ eq '-' } @{ $self->{ Files } }) {
	1					7
	0					0
	0					0
275	0					0	die "Cannot write stub to stdout in batch stub creation\n";
276							}
277							} elsif ($self->{ Mode } == MODE_LIST) {
278	0		0			0	$temp = shift @ARGV // die $HELP;
279	0		0			0	$self->{ Template } = $self->_get_template($temp)
280							// die "'$temp' is not a valid template\n";
281							}
282
283	11	100				31	if (@$subst) {
284							$self->{ Subst } = _subst_params(
285							# Don't lead trailing backslashes escape commas in next param
286	2					6	join ',', map { $_ =~ s/\\$/\\ /r } @$subst
	2					17
287							);
288							}
289
290	11					102	return $self;
291
292							}
293
294							sub run {
295
296	9			9	1	4088	my ($self) = @_;
297
298	9	50	66			45	if ($self->{ Mode } == MODE_DEFAULT or $self->{ Mode } == MODE_BATCH) {
		0
299	9					64	$self->render;
300							} elsif ($self->{ Mode } == MODE_LIST) {
301	0					0	$self->list;
302							}
303
304	9					61	return 1;
305
306							}
307
308							1;
309
310							=head1 NAME
311
312							File::Stubb - Stub file creator
313
314							=head1 USAGE
315
316							use File::Stubb;
317
318							my $stubb = File::Stubb->init;
319							$stubb->run;
320
321							=head1 DESCRIPTION
322
323							B is the module that provides the command-line interface for
324							L. This is a private module, for user documentation you should consult
325							the L manual.
326
327							=head1 METHODS
328
329							=over 4
330
331							=item $stubb = File::Stubb->init;
332
333							Reads C<@ARGV> and returns a blessed B object. View the L
334							manual for a list of valid arguments.
335
336							=item $stubb->run;
337
338							Runs L based on the arguments parsed during C.
339
340							=back
341
342							=head1 AUTHOR
343
344							Written by Samuel Young, Esamyoung12788@gmail.comE.
345
346							This project's source can be found on its
347							L. Comments and pull
348							requests are welcome!
349
350							=head1 COPYRIGHT
351
352							Copyright (C) 2025 Samuel Young
353
354							This program is free software: you can redistribute it and/or modify
355							it under the terms of the GNU General Public License as published by
356							the Free Software Foundation, either version 3 of the License, or
357							(at your option) any later version.
358
359							=head1 SEE ALSO
360
361							L
362
363							=cut
364
365							# vim: expandtab shiftwidth=4