File Coverage

blib/lib/Perl/ToPerl6/Transformer/Regexes/SwapModifiers.pm
Criterion Covered Total %
statement 22 45 48.8
branch 0 4 0.0
condition n/a
subroutine 11 12 91.6
pod 3 5 60.0
total 36 66 54.5


line stmt bran cond sub pod time code
1             package Perl::ToPerl6::Transformer::Regexes::SwapModifiers;
2              
3 17     17   12215 use 5.006001;
  17         58  
4 17     17   87 use strict;
  17         29  
  17         381  
5 17     17   77 use warnings;
  17         24  
  17         456  
6 17     17   73 use Readonly;
  17         26  
  17         940  
7              
8 17     17   95 use Perl::ToPerl6::Utils qw{ :characters :severities };
  17         33  
  17         1008  
9              
10 17     17   4632 use base 'Perl::ToPerl6::Transformer';
  17         58  
  17         10772  
11              
12             our $VERSION = '0.03';
13              
14             #-----------------------------------------------------------------------------
15              
16             Readonly::Scalar my $DESC =>
17             q{Regex modifiers now appear at the start of expresions};
18             Readonly::Scalar my $EXPL =>
19             q{Regex modifiers now appear at the start of expresions};
20              
21             #-----------------------------------------------------------------------------
22              
23 40     40 0 1228 sub supported_parameters { return () }
24 29     29 1 122 sub default_severity { return $SEVERITY_HIGHEST }
25 25     25 1 75 sub default_themes { return qw(core bugs) }
26             sub applies_to {
27             return sub {
28 61     61   741 $_[1]->isa('PPI::Token::Regexp')
29             }
30 4     4 1 19 }
31              
32             #-----------------------------------------------------------------------------
33              
34             my %modifier_map = (
35             m => {
36             m => 'm',
37             s => 's', # Changes meaning actually.
38             i => 'i',
39             x => 'x',
40             p => 'p',
41             o => '', # These 5 are not allowed. Others may mean different
42             d => '', # things.
43             u => '',
44             a => '',
45             l => '',
46             g => 'c', # /g --> /c
47             r => 'r',
48             c => '', # /c --> ...
49             e => 'e',
50             },
51             s => {
52             m => 'm',
53             s => 's',
54             i => 'i',
55             x => 'x',
56             p => 'p',
57             o => '', # These 5 are not allowed. Others may mean different
58             d => '', # things.
59             u => '',
60             a => '',
61             l => '',
62             g => 'c',
63             r => 'r',
64             c => '',
65             e => 'e',
66             },
67             tr => {
68             m => 'm',
69             s => 's',
70             i => 'i',
71             x => 'x',
72             p => 'p',
73             o => '', # These 5 are not allowed. Others may mean different
74             d => '', # things.
75             u => '',
76             a => '',
77             l => '',
78             g => 'c',
79             r => 'r',
80             c => '',
81             e => 'e',
82             }
83             );
84              
85             sub transform {
86 0     0 0   my ($self, $elem, $doc) = @_;
87 0           my $new_content = $elem->content;
88              
89 0           $new_content =~ s{^/}{m/};
90 0           $new_content =~ s{^y}{tr};
91 0           $new_content =~ m{^(m|s|tr)};
92 0           $elem->{operator} = $1;
93              
94 0           my $num_modifiers = keys %{ $elem->get_modifiers };
  0            
95 0           my $modifiers =
96             substr( $elem->content, -$num_modifiers, $num_modifiers, '' );
97              
98 0           my $operator = $elem->{operator};
99 0           my $new_modifiers = '';
100             $new_modifiers = join( '',
101 0 0         map { $modifier_map{$operator}{$_} }
  0            
102             split //, $modifiers
103             ) if $modifiers;
104              
105 0           my $delta = length($modifiers) - length($new_modifiers);
106 0           for ( @{ $elem->{sections} } ) {
  0            
107 0           $_->{position} -= $delta;
108             }
109              
110 0 0         if ( $new_modifiers ) {
111 0           $new_content =~ s{^(m|s|tr)}{$elem->{operator}:$new_modifiers:P5};
112             }
113             else {
114 0           $new_content =~ s{^(m|s|tr)}{$elem->{operator}:P5};
115             }
116 0           $new_content =~ s{$modifiers$}{};
117              
118 0           $elem->set_content($new_content);
119              
120 0           return $self->transformation( $DESC, $EXPL, $elem );
121             }
122              
123             1;
124              
125             #-----------------------------------------------------------------------------
126              
127             __END__
128              
129             =pod
130              
131             =head1 NAME
132              
133             Perl::ToPerl6::Transformer::Regexex::SwapModifiers
134              
135              
136             =head1 AFFILIATION
137              
138             This Transformer is part of the core L<Perl::ToPerl6|Perl::ToPerl6>
139             distribution.
140              
141              
142             =head1 DESCRIPTION
143              
144             In Perl6, modifiers have moved to the start of the regular expression declaration, and some are no longer needed:
145              
146             m/foo/ --> m/foo/
147             m/foo/x --> m/foo/
148             m/foo/gi --> m:gi/foo/
149              
150             Transforms regular expressions outside of comments, heredocs, strings and POD.
151              
152             =head1 CONFIGURATION
153              
154             This Transformer is not configurable except for the standard options.
155              
156             =head1 AUTHOR
157              
158             Jeffrey Goff <drforr@pobox.com>
159              
160             =head1 COPYRIGHT
161              
162             Copyright (c) 2015 Jeffrey Goff
163              
164             This program is free software; you can redistribute it and/or modify
165             it under the same terms as Perl itself.
166              
167             =cut
168              
169             ##############################################################################
170             # Local Variables:
171             # mode: cperl
172             # cperl-indent-level: 4
173             # fill-column: 78
174             # indent-tabs-mode: nil
175             # c-indentation-style: bsd
176             # End:
177             # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :