File Coverage

blib/lib/Perl/ToPerl6/Transformer/Operators/FormatOperators.pm
Criterion Covered Total %
statement 25 38 65.7
branch 0 20 0.0
condition 0 18 0.0
subroutine 12 13 92.3
pod 3 5 60.0
total 40 94 42.5


line stmt bran cond sub pod time code
1             package Perl::ToPerl6::Transformer::Operators::FormatOperators;
2              
3 17     17   12247 use 5.006001;
  17         52  
4 17     17   82 use strict;
  17         26  
  17         378  
5 17     17   81 use warnings;
  17         28  
  17         436  
6 17     17   72 use Readonly;
  17         25  
  17         888  
7              
8 17     17   87 use Perl::ToPerl6::Utils qw{ :characters :severities };
  17         24  
  17         1010  
9 17     17   5056 use Perl::ToPerl6::Utils::PPI qw{ is_ppi_token_operator };
  17         26  
  17         896  
10              
11 17     17   83 use base 'Perl::ToPerl6::Transformer';
  17         22  
  17         8952  
12              
13             our $VERSION = '0.03';
14              
15             #-----------------------------------------------------------------------------
16              
17             Readonly::Scalar my $DESC => q{Transform operators to perl6 equivalents};
18             Readonly::Scalar my $EXPL =>
19             q{Operators, notably '->' and '!', change names in Perl6};
20              
21             #-----------------------------------------------------------------------------
22              
23             my %after = (
24             and => 1,
25             or => 1,
26             xor => 1,
27             not => 1,
28             cmp => 1,
29             lt => 1,
30             gt => 1,
31             le => 1,
32             ge => 1,
33             eq => 1,
34             ne => 1,
35             );
36              
37             my %before = (
38             '<' => 1,
39             '<=' => 1,
40             '<=>' => 1,
41             );
42              
43             my %mutate = (
44             # From the unary operators:
45             #
46             # '++', '--' are unchanged.
47             # '!' is unchanged.
48             # 'not' is unchanged.
49              
50             # '^', '!' are changed.
51             '^' => '+^',
52             '!' => '?^',
53             '~' => '+^',
54              
55             # ',' is unchanged.
56             # '+', '-', '*', '/', '%', '**' are unchanged.
57             # '&&', '||', '^' are unchanged.
58             # 'and', 'or', 'xor' are unchanged.
59             # '==', '!=', '<', '>', '<=', '>=' are unchanged.
60             # 'eq', 'ne', 'lt', 'gt', 'le', 'ge' are unchanged.
61              
62             # '<=>' behaves similarly.
63             # 'cmp' is now named 'leg'.
64             # '~~' is unchanged, but the semantics are wildly different.
65             'cmp' => 'leg',
66              
67             # '&', '|', '^' are changed, and string semantics are different.
68             '&' => '+&', '&=' => '+&=',
69             '|' => '+|', '|=' => '+|=',
70             '^' => '+^', '^=' => '+^=',
71              
72             '<<' => '+<', '<<=' => '+<=',
73             '>>' => '+>', '>>=' => '+>=',
74              
75             '.' => '~', '.=' => '~=',
76              
77             '->' => '.',
78              
79             '=~' => '~~',
80             '!~' => '!~~',
81              
82             # And finally, the lone ternary operator:
83             #
84             '?' => '??',
85             ':' => '!!',
86             );
87              
88             #-----------------------------------------------------------------------------
89              
90 40     40 0 2477 sub supported_parameters { return () }
91 28     28 1 118 sub default_severity { return $SEVERITY_HIGHEST }
92 25     25 1 88 sub default_themes { return qw(core bugs) }
93             sub applies_to {
94             return sub {
95 61     61   1045 is_ppi_token_operator($_[1], %mutate, %before, %after)
96             }
97 4     4 1 23 }
98              
99             #-----------------------------------------------------------------------------
100              
101             sub transform {
102 0     0 0   my ($self, $elem, $doc) = @_;
103              
104             # nonassoc ++
105             # nonassoc --
106             # right !
107             # right ~
108             # right \
109             # right +
110             # right -
111             # left *
112             # left %
113              
114             # nonassoc ~~
115             # left &
116             # right *= etc. goto last next redo dump
117              
118             # nonassoc list operators (rightward)
119             # right not
120              
121 0           my $old_content = $elem->content;
122              
123             $elem->set_content( $mutate{$old_content} ) if
124 0 0         exists $mutate{$old_content};;
125              
126 0 0         if ( $old_content eq '=>' ) { # XXX This is a special case.
    0          
    0          
    0          
127             }
128             elsif ( $old_content eq 'x' ) { # XXX This is a special case.
129             }
130             elsif ( $old_content eq '..' ) { # XXX This is a special case.
131             # List version is unchanged.
132             # Scalar version is now 'ff'
133 0           $elem->set_content('ff XXX');
134             }
135             elsif ( $old_content eq '...' ) { # XXX This is a special case.
136             # List version is unchanged.
137             # Scalar version is now 'fff'
138 0           $elem->set_content('fff XXX');
139             }
140              
141 0 0         if ( $elem->content eq '.' ) {
142 0 0 0       $elem->next_sibling->remove if
143             $elem->next_sibling and
144             $elem->next_sibling->isa('PPI::Token::Whitespace');
145 0 0 0       $elem->previous_sibling->remove if
146             $elem->previous_sibling and
147             $elem->previous_sibling->isa('PPI::Token::Whitespace');
148             }
149              
150 0 0 0       if ( $before{$elem->content} and
    0 0        
      0        
      0        
151             $elem->previous_sibling and
152             not( $elem->previous_sibling->isa('PPI::Token::Whitespace') ) ) {
153 0           $elem->insert_before(
154             PPI::Token::Whitespace->new(' ')
155             );
156             }
157             elsif ( $after{$elem->content} and
158             $elem->next_sibling and
159             not( $elem->next_sibling->isa('PPI::Token::Whitespace') ) ) {
160 0           $elem->insert_after(
161             PPI::Token::Whitespace->new(' ')
162             );
163             }
164              
165 0           return $self->transformation( $DESC, $EXPL, $elem );
166             }
167              
168             1;
169              
170             #-----------------------------------------------------------------------------
171              
172             __END__
173              
174             =pod
175              
176             =head1 NAME
177              
178             Perl::ToPerl6::Transformer::Operators::FormatOperators - Transform '->', '!" &c to their Perl6 equivalents
179              
180              
181             =head1 AFFILIATION
182              
183             This Transformer is part of the core L<Perl::ToPerl6|Perl::ToPerl6>
184             distribution.
185              
186              
187             =head1 DESCRIPTION
188              
189             Several operators in Perl5 have been renamed or repurposed in Perl6. For instance, the various negations such as '~', '^' and '!' have been unified under '^', and the previous numeric, logical and Boolean contexts are now represented in the first character, so '!' is now '?^' to repreent Boolean ('?') negation ('^'):
190              
191             ~32 --> +^32
192             !$x --> ?^$x
193             1 ? 2 : 3 --> 1 ?? 2 !! 3
194              
195             Transforms operators outside of comments, heredocs, strings and POD.
196              
197             =head1 CONFIGURATION
198              
199             This Transformer is not configurable except for the standard options.
200              
201             =head1 AUTHOR
202              
203             Jeffrey Goff <drforr@pobox.com>
204              
205             =head1 COPYRIGHT
206              
207             Copyright (c) 2015 Jeffrey Goff
208              
209             This program is free software; you can redistribute it and/or modify
210             it under the same terms as Perl itself.
211              
212             =cut
213              
214             ##############################################################################
215             # Local Variables:
216             # mode: cperl
217             # cperl-indent-level: 4
218             # fill-column: 78
219             # indent-tabs-mode: nil
220             # c-indentation-style: bsd
221             # End:
222             # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :