File Coverage

blib/lib/Regexp/Common/AT/Profanity.pm
Criterion Covered Total %
statement 18 18 100.0
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 24 24 100.0


line stmt bran cond sub pod time code
1 1     1   6957 use 5.008;
  1         4  
  1         33  
2 1     1   4 use strict;
  1         2  
  1         27  
3 1     1   4 use warnings;
  1         1  
  1         47  
4              
5             package Regexp::Common::AT::Profanity;
6             our $VERSION = '1.100860';
7             # ABSTRACT: Provide regexes for profanity in Austrian German
8 1     1   4 use Regexp::Common qw /pattern clean no_defaults/;
  1         2  
  1         8  
9 1     1   1415 use Regexp::Assemble;
  1         21276  
  1         48  
10 1     1   916 use HTML::Entities;
  1         6072  
  1         481  
11              
12             # rot13 in vim: g?{motion}
13             my @nouns = qw(
14             (nefpu|bnfpu)(tr?fvpug|xrxf|yrpxre|ybpu|jnemra?)?
15             (qerpxf|fpurv&fmyvt;)?gfpuhfpu(ra)?(fnh)?
16             nygre\f+fnpx
17             nezyrhpugre
18             onaxreg
19             onfgneq
20             orvqr?y(cenpxre)?
21             ovgpu
22             oy&bhzy;qznaa
23             ohzfrerv
24             qnezsybevfg
25             qrcc
26             qvyyb
27             qbyz
28             qerpxfnh
29             qh\f+bcsre
30             qhzzrewna
31             qhzcsonpxr
32             srggr\f+fnh
33             srggfnpx
34             srggfnh
35             srgmr?afpu&nhzy;qry
36             svpxr(a|e(rv)?)
37             shpx
38             shpxvat
39             shg
40             trfvpugffpunoenpxr
41             trfvpugfibgmr
42             uveav
43             ubuyxbcs
44             uhaqfsbgg
45             uher
46             uher?a(orvqr?y|xvaq|fbua)
47             uhererv
48             vqvbg
49             vue\f+bcsref?
50             whqraoratry
51             whqrafnh
52             xnanxra?
53             xanyypunetr
54             xanyyxbcs
55             xbgmserffr
56             y&hhzy;zzry
57             yrpx\f+zvpu
58             zvfgfg&hhzy;px
59             avttre
60             cvffre
61             cengreuher?
62             chqrenag
63             chqrerv
64             enhfpuxvaq
65             fnpxenggr
66             fnhwhqr?
67             fpujnamyhgfpure
68             fpujhpugry
69             fpujhyr\f+fnh
70             freivreshg
71             fcnpxb
72             fcnfgv?
73             fg&hhzy;px\f+qerpx
74             gnfpuraovyyneq
75             gebggry
76             hathfgr?y
77             ibyyvqvbg
78             ibyyxbssre
79             ibgmr
80             jv(kk?|puf)(re(rv)?|ibeyntr)
81             );
82             my $adj_dekl = "(e[mnrs]?)?";
83             my @adjectives = qw(
84             (or|ire)(fpuvffra|xnpxg)
85             (ibyy|na)tr(fpuvffra|xnpxg)
86             oy&bhzy;q
87             oynq
88             oehamryaq
89             qrccreg
90             qbbs
91             svfpuryaq
92             cvffra
93             fpurv(&fmyvt;|ff)
94             ireqnzzg
95             iresvpxg
96             iresyhpug
97             ireuheg
98             gebggryvt
99             iregebggryg
100             );
101             my $verb_dekl = '';
102             my @verbs = qw(
103             nofcevgmra
104             notrfcevgmg
105             ohzfra
106             oehamry?a
107             svfpurya
108             trsvpxg
109             xvssra
110             urehzuhera
111             urehzfpujhpugrya
112             chqrea
113             fnhsra
114             );
115             tr/A-Za-z/N-ZA-Mn-za-m/ for @nouns, @verbs, @adjectives;
116             my @profanity = @nouns;
117              
118             # verbs ending in -en or -ern can be made into adjectives by adding -d
119             push @profanity => map { "$_$adj_dekl" } @adjectives,
120             map { $_ . 'd' }
121             grep { /er?n$/ } @verbs;
122             push @profanity => map { "$_$verb_dekl" } @verbs;
123             my $assembler = Regexp::Assemble->new(flags => 'i');
124             for (@profanity) {
125             decode_entities($_);
126             $assembler->add($_);
127             }
128              
129             # the '\x{'.'%s}' kludge is so it doesn't look like a template start tag
130             (my $profanity = $assembler->re) =~ s/(.)/
131             ord($1) > 127
132             ? sprintf('\x{'.'%s}', unpack("H*", pack("n", ord($1))))
133             : $1
134             /ge;
135             pattern
136             name => [qw(at profanity)],
137             create => '(?:\b(?k:' . $profanity . ')\b)';
138             1;
139              
140              
141             __END__