File Coverage

blib/lib/App/Dapper/Utils.pm

Criterion	Covered	Total	%
statement	24	71	33.8
branch	0	18	0.0
condition			n/a
subroutine	8	17	47.0
pod	9	9	100.0
total	41	115	35.6

line	stmt	bran	sub	pod	time	code
1						package App::Dapper::Utils;
2
3						=head1 NAME
4
5						App::Dapper::Utils - Common utility functions used throughout Dapper.
6
7						=cut
8
9	2		2		11	use utf8;
	2				3
	2				12
10	2		2		55	use open ':std', ':encoding(UTF-8)';
	2				4
	2				10
11	2		2		797	use 5.8.0;
	2				7
	2				64
12	2		2		10	use strict;
	2				4
	2				81
13	2		2		22	use warnings FATAL => 'all';
	2				3
	2				66
14
15	2		2		10	use POSIX;
	2				4
	2				24
16	2		2		15346	use Unicode::Normalize;
	2				7079
	2				211
17	2		2		20	use File::Spec::Functions qw/ canonpath /;
	2				4
	2				2630
18
19						my $DEFAULT_LAYOUT = "index";
20
21						=head2 read_file
22
23						Read a file and return a scalar with the file's contents.
24
25						=cut
26
27						# Takes a file name and returns a string of the contents
28						sub read_file {
29	0		0	1		my ($file_name) = @_;
30	0					my $file_contents;
31
32						#print "Reading contents of $file_name\n";
33
34	0	0				open(FILE, "<:encoding(UTF-8)", "$file_name") or die("could not open file: $!\n");
35	0					foreach () { $file_contents .= $_; }
	0
36	0	0				close(FILE) or die("could not close file: $!\n");
37
38	0					return $file_contents;
39						}
40
41						=head2 get_modified_time
42
43						Takes a file and returns the last modified time of the file.
44
45						=cut
46
47						sub get_modified_time {
48	0		0	1		my ($file) = @_;
49	0					my $date = POSIX::strftime( "%Y-%m-%d %H:%M:%S", localtime((stat $file)[9]));
50	0					return $date;
51						}
52
53						=head2 slugify
54
55						Takes an input string (e.g. the title of a blog post) and "slugifies" it, meaning that
56						it removes non-ASCII characters, removes all non-word characters (e.g. '_', '-', etc.),
57						removes leading and trailing whitespace, replaces spaces with hyphens, and converts to
58						lowercase.
59
60						=cut
61
62						sub slugify {
63	0		0	1		my ($input) = @_;
64
65	0	0				if (not defined $input) { return; }
	0
66
67						#print "Slugifying $input\n";
68
69	0					$input = NFKD($input); # Normalize the Unicode string
70	0					$input =~ tr/\000-\177//cd; # Strip non-ASCII characters (>127)
71	0					$input =~ s/[^\w\s-]//g; # Remove all characters that are not word characters (includes _), spaces, or hyphens
72	0					$input =~ s/^\s+\|\s+$//g; # Trim whitespace from both ends
73	0					$input = lc($input);
74	0					$input =~ s/[-\s]+/-/g; # Replace all occurrences of spaces and hyphens with a single hyphen
75
76	0					return $input;
77						}
78
79						=head2 find_template_statement
80
81						Takes a string, returns
82
83						=cut
84
85						sub find_template_statement {
86	0		0	1		my ($string) = @_;
87
88	0	0				if($string =~ /^use\s+([a-zA-Z0-9_]+)\s+template/) { return $1; }
	0
89
90	0					return $DEFAULT_LAYOUT;
91						}
92
93						=head2 filter_template_statements
94
95						Takes a string, removes all "use
96
97						=cut
98
99						sub filter_template_statements {
100	0		0	1		my ($string) = @_;
101
102	0					$string =~ s/^(use\s+[a-zA-Z0-9_]+\s+template)//g;
103
104	0					return $string;
105						}
106
107						=head2 filter_extension
108
109						Takes a string (filename) and returns the extension.
110
111						=cut
112
113						sub filter_extension {
114	0		0	1		my ($filename) = @_;
115	0					$filename = canonpath $filename;
116
117	0					my ($ext) = $filename =~ /(\.[^.]+)$/;
118
119	0					return $ext;
120						}
121
122						=head2 filter_stem
123
124						Takes a filename and returns the stem of the file name (without the extension).
125
126						=cut
127
128						sub filter_stem {
129	0		0	1		my ($filename) = @_;
130	0					$filename = canonpath $filename;
131
132	0					(my $stem = $filename) =~ s/\.[^.]+$//;
133
134	0					return $stem;
135						}
136
137						=head2 create_file
138
139						Takes a file name and a string of the content and writes it to disk.
140
141						=cut
142
143						sub create_file {
144	0		0	1		my ($filename, $content) = @_;
145	0					$filename = canonpath $filename;
146	0					print "Creating $filename\n";
147	0	0				die "Invalid number of arguments to create_file" if @_ != 2;
148	0	0				die "$filename exists. Skipping." if -f $filename;
149
150						#open(my $fh, '+>:encoding(UTF-8)', $filename)
151	0	0				open(my $fh, '+>', $filename)
152						or die "Could not open file '$filename' $!";
153
154	0					print $fh $content;
155	0					close $fh;
156						}
157
158						=head2 create_dir
159
160						Takes a directory name and creates it on disk.
161
162						=cut
163
164						sub create_dir {
165	0		0	1		my ($dirname) = @_;
166	0					$dirname = canonpath $dirname;
167	0	0				die "Invalid number of arguments to create_dir" if @_ != 1;
168
169	0	0				mkdir($dirname)
170						or die "Could not create directory '$dirname' $!";
171						}
172
173						1;