File Coverage

blib/lib/JavaScript/Minifier.pm
Criterion Covered Total %
statement 144 148 97.3
branch 77 86 89.5
condition 123 150 82.0
subroutine 20 20 100.0
pod 0 16 0.0
total 364 420 86.6


line stmt bran cond sub pod time code
1             package JavaScript::Minifier;
2              
3 3     3   214233 use strict;
  3         42  
  3         96  
4 3     3   17 use warnings;
  3         5  
  3         7216  
5              
6             our $VERSION = '1.15'; # VERSION
7              
8             require Exporter;
9             our @ISA = qw(Exporter);
10             our @EXPORT = qw(minify);
11              
12             # string 'return' as array to handle special case of returning a regexp from a function
13             my @return = qw(r e t u r n);
14              
15             #return true if the character is allowed in identifier.
16             sub isAlphanum {
17 432   66 432 0 3457 return ($_[0] =~ /[\w\$\\]/ || ord($_[0]) > 126);
18             }
19              
20             sub isEndspace {
21 427   66 427 0 2891 return ($_[0] eq "\n" || $_[0] eq "\r" || $_[0] eq "\f");
22             }
23              
24             sub isWhitespace {
25 2537   66 2537 0 23779 return ($_[0] eq ' ' || $_[0] eq "\t" || $_[0] eq "\n"
26             || $_[0] eq "\r" || $_[0] eq "\f");
27             }
28              
29             # New line characters before or after these characters can be removed.
30             # Not + - / in this list because they require special care.
31             sub isInfix {
32 58     58 0 328 $_[0] =~ /[,;:=&%*<>\?\|\n]/;
33             }
34              
35             # New line characters after these characters can be removed.
36             sub isPrefix {
37 31   66 31 0 139 return ($_[0] =~ /[\{\(\[!]/ || isInfix($_[0]));
38             }
39              
40             # New line characters before these characters can removed.
41             sub isPostfix {
42 41   66 41 0 211 return ($_[0] =~ /[\}\)\]]/ || isInfix($_[0]));
43             }
44              
45             # -----------------------------------------------------------------------------
46              
47             sub _get {
48 1427     1427   1977 my $s = shift;
49              
50 1427 100       2619 if ($s->{inputType} eq 'file') {
    50          
51 1289         3584 my $char = getc($s->{input});
52 1289 100       3478 $s->{last_read_char} = $char
53             if defined $char;
54              
55 1289         7412 return $char;
56             }
57             elsif ($s->{inputType} eq 'string') {
58 138 100       301 if ($s->{'inputPos'} < length($s->{input})) {
59             return $s->{last_read_char}
60 118         437 = substr($s->{input}, $s->{inputPos}++, 1);
61             }
62             else { # Simulate getc() when off the end of the input string.
63 20         56 return undef;
64             }
65             }
66             else {
67 0         0 die "no input";
68             }
69             }
70              
71             sub _put {
72 743     743   982 my $s = shift;
73 743         1347 my $x = shift;
74 743         1614 my $outfile = ($s->{outfile});
75 743 100       1293 if (defined($s->{outfile})) {
76 657         2262 print $outfile $x;
77             }
78             else {
79 86         207 $s->{output} .= $x;
80             }
81             }
82              
83             # -----------------------------------------------------------------------------
84              
85             # print a
86             # move b to a
87             # move c to b
88             # move d to c
89             # new d
90             #
91             # i.e. print a and advance
92             sub action1 {
93 575     575 0 973 my $s = shift;
94 575 100       937 if (!isWhitespace($s->{a})) {
95 495         1192 $s->{lastnws} = $s->{a};
96             }
97 575         1197 $s->{last} = $s->{a};
98 575         945 action2($s);
99             }
100              
101             # sneeky output $s->{a} for comments
102             sub action2 {
103 740     740 0 1259 my $s = shift;
104 740         1623 _put($s, $s->{a});
105 740         1505 action3($s);
106             }
107              
108             # move b to a
109             # move c to b
110             # move d to c
111             # new d
112             #
113             # i.e. delete a
114             sub action3 {
115 1243     1243 0 1872 my $s = shift;
116 1243         2230 $s->{a} = $s->{b};
117 1243         2218 action4($s);
118             }
119              
120             # move c to b
121             # move d to c
122             # new d
123             #
124             # i.e. delete b
125             sub action4 {
126 1342     1342 0 1795 my $s = shift;
127 1342         2204 $s->{b} = $s->{c};
128 1342         2217 $s->{c} = $s->{d};
129 1342         2090 $s->{d} = _get($s);
130             }
131              
132             # -----------------------------------------------------------------------------
133              
134             # put string and regexp literals
135             # when this sub is called, $s->{a} is on the opening delimiter character
136             sub putLiteral {
137 15     15 0 27 my $s = shift;
138 15         33 my $delimiter = $s->{a}; # ', " or /
139 15         36 action1($s);
140             do {
141 93   66     483 while (defined($s->{a}) && $s->{a} eq '\\') { # escape character only escapes only the next one character
142 11         27 action1($s);
143 11         26 action1($s);
144             }
145 93         180 action1($s);
146 15   66     38 } until ($s->{last} eq $delimiter || !defined($s->{a}));
147 15 50       53 if ($s->{last} ne $delimiter) { # ran off end of file before printing the closing delimiter
148 0 0       0 die 'unterminated ' . ($delimiter eq '\'' ? 'single quoted string' : $delimiter eq '"' ? 'double quoted string' : 'regular expression') . ' literal, stopped';
    0          
149             }
150             }
151              
152             # -----------------------------------------------------------------------------
153              
154             # If $s->{a} is a whitespace then collapse all following whitespace.
155             # If any of the whitespace is a new line then ensure $s->{a} is a new line
156             # when this function ends.
157             sub collapseWhitespace {
158 420     420 0 581 my $s = shift;
159 420   100     1193 while (defined($s->{a}) && isWhitespace($s->{a}) &&
      100        
      100        
160             defined($s->{b}) && isWhitespace($s->{b})) {
161 99 100 100     210 if (isEndspace($s->{a}) || isEndspace($s->{b})) {
162 82         152 $s->{a} = "\n";
163             }
164 99         188 action4($s); # delete b
165             }
166             }
167              
168             # Advance $s->{a} to non-whitespace or end of file.
169             # Doesn't print any of this whitespace.
170             sub skipWhitespace {
171 241     241 0 375 my $s = shift;
172 241   100     767 while (defined($s->{a}) && isWhitespace($s->{a})) {
173 193         399 action3($s);
174             }
175             }
176              
177             # Advance $s->{a} to non-whitespace or end of file
178             # If any of the whitespace is a new line then print one new line.
179             sub preserveEndspace {
180 125     125 0 225 my $s = shift;
181 125         268 collapseWhitespace($s);
182 125 100 100     455 if (defined($s->{a}) && isEndspace($s->{a}) && defined($s->{b}) && !isPostfix($s->{b}) ) {
      100        
      100        
183 27         61 action1($s);
184             }
185 125         292 skipWhitespace($s);
186             }
187              
188             sub onWhitespaceConditionalComment {
189 28     28 0 42 my $s = shift;
190             return (defined($s->{a}) && isWhitespace($s->{a}) &&
191             defined($s->{b}) && $s->{b} eq '/' &&
192             defined($s->{c}) && ($s->{c} eq '/' || $s->{c} eq '*') &&
193 28   66     91 defined($s->{d}) && $s->{d} eq '@');
194             }
195              
196             # -----------------------------------------------------------------------------
197              
198             sub minify {
199 20     20 0 15256 my %h = @_;
200             # Immediately turn hash into a hash reference so that notation is the same in this function
201             # as others. Easier refactoring.
202 20         51 my $s = \%h; # hash reference for "state". This module is functional programming and the state is passed between functions.
203              
204             # determine if the the input is a string or a file handle.
205 20         50 my $ref = \$s->{input};
206 20 100 66     144 if (defined($ref) && ref($ref) eq 'SCALAR'){
207 5         14 $s->{inputPos} = 0;
208 5         14 $s->{inputType} = 'string';
209             }
210             else {
211 15         89 $s->{inputType} = 'file';
212             }
213              
214             # Determine if the output is to a string or a file.
215 20 100       55 if (!defined($s->{outfile})) {
216 5         12 $s->{output} = '';
217             }
218              
219             # Print the copyright notice first
220 20 100       47 if ($s->{copyright}) {
221 1         6 _put($s, '/* ' . $s->{copyright} . ' */');
222             }
223              
224             # Initialize the buffer.
225             do {
226 25         65 $s->{a} = _get($s);
227 20   66     35 } while (defined($s->{a}) && isWhitespace($s->{a}));
228 20         55 $s->{b} = _get($s);
229 20         45 $s->{c} = _get($s);
230 20         44 $s->{d} = _get($s);
231 20         42 $s->{return_flag} = 0;
232 20         40 $s->{return_string} = '';
233 20         43 $s->{last} = undef; # assign for safety
234 20         37 $s->{lastnws} = undef; # assign for safety
235              
236             # local variables
237 20         27 my $ccFlag; # marks if a comment is an Internet Explorer conditional comment and should be printed to output
238              
239 20         49 while (defined($s->{a})) { # on this line $s->{a} should always be a non-whitespace character or undef (i.e. end of file)
240              
241 460 50       1020 if (isWhitespace($s->{a})) { # check that this program is running correctly
242 0         0 die 'minifier bug: minify while loop starting with whitespace, stopped';
243             }
244              
245             # track 'return' operator
246 460 100       1268 if ($s->{a} ne '/') {
247 365   66     1399 $s->{return_flag} = defined($return[length($s->{return_string})]) && $s->{a} eq $return[length($s->{return_string})];
248 365 100       866 $s->{return_string} = $s->{return_flag} ? $s->{return_string} . $s->{a} : '';
249             }
250              
251             # Each branch handles trailing whitespace and ensures $s->{a} is on non-whitespace or undef when branch finishes
252 460 100 100     2857 if ($s->{a} eq '/') { # a division, comment, or regexp literal
    100 100        
    100 100        
    100 100        
    100 100        
    100 100        
      100        
      66        
      66        
253 95 100 66     881 if (defined($s->{b}) && $s->{b} eq '/') { # slash-slash comment
    100 66        
    100 100        
      66        
      33        
      66        
254 29   66     133 $ccFlag = defined($s->{c}) && $s->{c} eq '@'; # tests in IE7 show no space allowed between slashes and at symbol
255             do {
256 156 100       350 $ccFlag ? action2($s) : action3($s);
257 29   66     40 } until (!defined($s->{a}) || isEndspace($s->{a}));
258 29 50       82 if (defined($s->{a})) { # $s->{a} is a new line
259 29 100 100     90 if ($ccFlag) {
    100 100        
260 14         35 action1($s); # cannot use preserveEndspace($s) here because it might not print the new line
261 14         32 skipWhitespace($s);
262             }
263             elsif (defined($s->{last}) && !isEndspace($s->{last}) && !isPrefix($s->{last})) {
264 8         21 preserveEndspace($s);
265             }
266             else {
267 7         21 skipWhitespace($s);
268             }
269             }
270             }
271             elsif (defined($s->{b}) && $s->{b} eq '*') { # slash-star comment
272 38   66     156 $ccFlag = defined($s->{c}) && $s->{c} eq '@'; # test in IE7 shows no space allowed between star and at symbol
273             do {
274 265 100       586 $ccFlag ? action2($s) : action3($s);
275 38   100     57 } until (!defined($s->{b}) || ($s->{a} eq '*' && $s->{b} eq '/'));
      66        
276 38 50       93 if (defined($s->{b})) { # $s->{a} is asterisk and $s->{b} is foreslash
277 38 100       94 if ($ccFlag) {
278 15         33 action2($s); # the *
279 15         42 action2($s); # the /
280             # inside the conditional comment there may be a missing terminal semi-colon
281 15         39 preserveEndspace($s);
282             }
283             else { # the comment is being removed
284 23         52 action3($s); # the *
285 23         74 $s->{a} = ' '; # the /
286 23         54 collapseWhitespace($s);
287 23 100 66     138 if (defined($s->{last}) && defined($s->{b}) &&
    100 100        
      100        
      100        
288             ((isAlphanum($s->{last}) && (isAlphanum($s->{b})||$s->{b} eq '.')) ||
289             ($s->{last} eq '+' && $s->{b} eq '+') || ($s->{last} eq '-' && $s->{b} eq '-'))) { # for a situation like 5-/**/-2 or a/**/a
290             # When entering this block $s->{a} is whitespace.
291             # The comment represented whitespace that cannot be removed. Therefore replace the now gone comment with a whitespace.
292 4         12 action1($s);
293             }
294             elsif (defined($s->{last}) && !isPrefix($s->{last})) {
295 7         18 preserveEndspace($s);
296             }
297             else {
298 12         29 skipWhitespace($s);
299             }
300             }
301             }
302             else {
303 0         0 die 'unterminated comment, stopped';
304             }
305             }
306             elsif ((defined($s->{lastnws}) && ($s->{lastnws} eq ')' || $s->{lastnws} eq ']' ||
307             $s->{lastnws} eq '.' || isAlphanum($s->{lastnws}))) && (!$s->{return_flag} || length($s->{return_string}) != scalar(@return))) { # division
308              
309 19         49 action1($s);
310 19         191 collapseWhitespace($s);
311             # don't want a division to become a slash-slash comment with following conditional comment
312 19 100       53 onWhitespaceConditionalComment($s) ? action1($s) : preserveEndspace($s);
313             }
314             else { # regexp literal
315 9         29 putLiteral($s);
316 9         27 collapseWhitespace($s);
317             # don't want closing delimiter to become a slash-slash comment with following conditional comment
318 9 100       32 onWhitespaceConditionalComment($s) ? action1($s) : preserveEndspace($s);
319             }
320             }
321             elsif ($s->{a} eq '\'' || $s->{a} eq '"' ) { # string literal
322 6         30 putLiteral($s);
323 6         17 preserveEndspace($s);
324             }
325             elsif ($s->{a} eq '+' || $s->{a} eq '-') { # careful with + + and - -
326 31         84 action1($s);
327 31         96 collapseWhitespace($s);
328 31 100 100     113 if (defined($s->{a}) && isWhitespace($s->{a})) {
329 4 100 66     24 (defined($s->{b}) && $s->{b} eq $s->{last}) ? action1($s) : preserveEndspace($s);
330             }
331             }
332             elsif (isAlphanum($s->{a})) { # keyword, identifiers, numbers
333 213         557 action1($s);
334 213         577 collapseWhitespace($s);
335 213 100 100     757 if (defined($s->{a}) && isWhitespace($s->{a})) {
336             # if $s->{b} is '.' could be (12 .toString()) which is property invocation. If space removed becomes decimal point and error.
337 49 100 66     160 (defined($s->{b}) && (isAlphanum($s->{b}) || $s->{b} eq '.')) ? action1($s) : preserveEndspace($s);
338             }
339             }
340             elsif ($s->{a} eq ']' || $s->{a} eq '}' || $s->{a} eq ')') { # no need to be followed by space but maybe needs following new line
341 31         81 action1($s);
342 31         71 preserveEndspace($s);
343             }
344             elsif ($s->{stripDebug} && $s->{a} eq ';' &&
345             defined($s->{b}) && $s->{b} eq ';' &&
346             defined($s->{c}) && $s->{c} eq ';') {
347 1         5 action3($s); # delete one of the semi-colons
348 1         2 $s->{a} = '/'; # replace the other two semi-colons
349 1         4 $s->{b} = '/'; # so the remainder of line is removed
350             }
351             else { # anything else just prints and trailing whitespace discarded
352 83         216 action1($s);
353 83         185 skipWhitespace($s);
354             }
355             }
356              
357 20 100 66     122 if ( defined $s->{last_read_char} and $s->{last_read_char} =~ /\n/ ) {
358 2         7 _put($s, "\n");
359             }
360              
361 20 100       125 if (!defined($s->{outfile})) {
362 5         75 return $s->{output};
363             }
364              
365             } # minify()
366              
367             1;
368             __END__