File Coverage

blib/lib/Acme/Zalgo.pm
Criterion Covered Total %
statement 36 39 92.3
branch 4 8 50.0
condition n/a
subroutine 9 9 100.0
pod 0 4 0.0
total 49 60 81.6


line stmt bran cond sub pod time code
1 1     1   22325 use strict;
  1         2  
  1         35  
2 1     1   5 use warnings;
  1         1  
  1         48  
3              
4             package Acme::Zalgo;
5             $Acme::Zalgo::VERSION = '0.002';
6             # ABSTRACT: Speak the forbidden tongue, or just screw up your terminal
7              
8 1     1   5 use Exporter qw(import);
  1         5  
  1         252  
9              
10             our @EXPORT = qw(zalgo);
11              
12             # spaces are zalgofied by default, but not other whitespace
13             our $ZALGO_REGEX = qr/([[:alnum:] ])/;
14              
15             my $chars = <<"HE_COMES";
16             # up
17             \x{030d}\x{030e}\x{0304}\x{0305}
18             \x{033f}\x{0311}\x{0306}\x{0310}
19             \x{0352}\x{0357}\x{0351}\x{0307}
20             \x{0308}\x{030a}\x{0342}\x{0343}
21             \x{0344}\x{034a}\x{034b}\x{034c}
22             \x{0303}\x{0302}\x{030c}\x{0350}
23             \x{0300}\x{0301}\x{030b}\x{030f}
24             \x{0312}\x{0313}\x{0314}\x{033d}
25             \x{0309}\x{0363}\x{0364}\x{0365}
26             \x{0366}\x{0367}\x{0368}\x{0369}
27             \x{036a}\x{036b}\x{036c}\x{036d}
28             \x{036e}\x{036f}\x{033e}\x{035b}
29             \x{0346}\x{031a}
30             # middle
31             \x{0315}\x{031b}\x{0340}\x{0341}
32             \x{0358}\x{0321}\x{0322}\x{0327}
33             \x{0328}\x{0334}\x{0335}\x{0336}
34             \x{034f}\x{035c}\x{035d}\x{035e}
35             \x{035f}\x{0360}\x{0362}\x{0338}
36             \x{0337}\x{0361}\x{0489}
37             # down
38             \x{0316}\x{0317}\x{0318}\x{0319}
39             \x{031c}\x{031d}\x{031e}\x{031f}
40             \x{0320}\x{0324}\x{0325}\x{0326}
41             \x{0329}\x{032a}\x{032b}\x{032c}
42             \x{032d}\x{032e}\x{032f}\x{0330}
43             \x{0331}\x{0332}\x{0333}\x{0339}
44             \x{033a}\x{033b}\x{033c}\x{0345}
45             \x{0347}\x{0348}\x{0349}\x{034d}
46             \x{034e}\x{0353}\x{0354}\x{0355}
47             \x{0356}\x{0359}\x{035a}\x{0323}
48             HE_COMES
49              
50             our @ZALGO = map { my $s = $_; $s =~ s/\s+//g; $s } grep {$_} split qr/^#.*?$/ms, $chars;
51              
52 1     1   7 use Carp;
  1         2  
  1         563  
53              
54             sub randint {
55 355     355 0 344 my ($min, $max) = @_;
56 355 100       584 if (not defined $max) {
57 256         236 $max = $min;
58 256         231 $min = 0;
59             }
60 355         1101 return int(rand($max - $min)) + $min;
61             }
62              
63             sub rand_char {
64 256     256 0 247 my ($s) = @_;
65 256         474 return substr($s, randint(length $s), 1);
66             }
67              
68             sub zalgo_char {
69 33     33 0 64 my ($c, $upmin, $upmax, $midmin, $midmax, $downmin, $downmax) = @_;
70 33         49 for my $i (1..randint($upmin, $upmax)) {
71 89         132 $c .= rand_char($ZALGO[0]);
72             }
73 33         64 for my $i (1..randint($midmin, $midmax)) {
74 91         148 $c .= rand_char($ZALGO[1]);
75             }
76 33         56 for my $i (1..randint($downmin, $downmax)) {
77 76         141 $c .= rand_char($ZALGO[2]);
78             }
79 33         116 return $c;
80             }
81              
82             sub zalgo {
83 2 50   2 0 10 if (not @_) {
84 0         0 @_ = ("HE COMES");
85             }
86 2 50       6 if (@_ == 1) {
    0          
87 2         5 push @_, (0,5, 0,5, 0,5);
88             } elsif (@_ == 2) {
89 0         0 my ($s, $max) = @_;
90 0         0 @_ = ($s, 0, $max, 0, $max, 0, $max);
91             }
92 2         4 my ($str, $minup, $maxup, $minmid, $maxmid, $mindown, $maxdown) = @_;
93 2         12 $str =~ s/$ZALGO_REGEX/zalgo_char($1,$minup,$maxup+1,$minmid,$maxmid+1,$mindown,$maxdown+1)/ge;
  33         76  
94 2         12 return $str;
95             }
96              
97             package
98             COMES; # hide from cpan
99              
100             sub HE {
101 1     1   8 my $pkg = shift;
102 1         3 Acme::Zalgo::zalgo(@_);
103             }
104              
105             1;
106             __END__