File Coverage

blib/lib/Perl/ToPerl6/Transformer/Pragmas/FormatConstants.pm
Criterion Covered Total %
statement 27 48 56.2
branch 3 14 21.4
condition 11 21 52.3
subroutine 11 11 100.0
pod 3 5 60.0
total 55 99 55.5


line stmt bran cond sub pod time code
1             package Perl::ToPerl6::Transformer::Pragmas::FormatConstants;
2              
3 17     17   10794 use 5.006001;
  17         47  
4 17     17   72 use strict;
  17         24  
  17         328  
5 17     17   91 use warnings;
  17         22  
  17         391  
6 17     17   60 use Readonly;
  17         25  
  17         882  
7              
8 17     17   85 use Perl::ToPerl6::Utils qw{ :characters :severities };
  17         29  
  17         983  
9              
10 17     17   4225 use base 'Perl::ToPerl6::Transformer';
  17         26  
  17         8642  
11              
12             our $VERSION = '0.03';
13              
14             #-----------------------------------------------------------------------------
15              
16             Readonly::Scalar my $DESC => q{Transform Readonly into constant};
17             Readonly::Scalar my $EXPL => q{Perl6 has real constants};
18              
19             #-----------------------------------------------------------------------------
20              
21 40     40 0 1140 sub supported_parameters { return () }
22 38     38 1 152 sub default_severity { return $SEVERITY_HIGHEST }
23 25     25 1 85 sub default_themes { return qw(core bugs) }
24 4     4 1 12 sub applies_to { return 'PPI::Statement' }
25              
26             #-----------------------------------------------------------------------------
27              
28             my %map = (
29             'my' => 1,
30             'our' => 1
31             );
32              
33             #
34             # Readonly our @foo => ('a', 'b') --> our constant @foo = ('a', 'b')
35             #
36             sub transform {
37 9     9 0 15 my ($self, $elem, $doc) = @_;
38 9 50 33     126 return unless $elem and $elem->first_element;
39              
40 9         74 my $head = $elem->first_element;
41 9         29 my $current = $head;
42              
43 9 50 66     65 if ( $current->isa('PPI::Token::Word') and
    50 100        
      66        
      66        
      33        
44             $current->content =~ m{^Readonly} ) {
45              
46 0         0 $current->set_content('constant');
47 0 0       0 $current->next_sibling->delete if
48             $current->next_sibling->isa('PPI::Token::Whitespace');
49              
50 0         0 $current = $current->snext_sibling;
51              
52 0 0       0 if ( exists $map{$current->content} ) {
53 0         0 $head->insert_before(
54             PPI::Token::Word->new($current->content)
55             );
56              
57 0         0 $head->insert_before(
58             PPI::Token::Whitespace->new(' ')
59             );
60              
61 0         0 my $temp = $current;
62 0         0 $current = $current->snext_sibling;
63              
64 0         0 $temp->remove;
65             }
66 0 0       0 if ( $current->content =~ / ^ ( \$ | \@ ) /x ) {
67 0         0 my $new_content = $current->content;
68 0         0 $new_content =~ s< ^ ( \$ | \@ ) ><>x;
69 0         0 $current->set_content($new_content);
70             }
71              
72 0         0 $current = $current->snext_sibling;
73              
74 0         0 $current->set_content('=');
75             }
76             elsif ( $head->isa('PPI::Token::Word') and
77             $head->content eq 'use' and
78             $head->snext_sibling and
79             $head->snext_sibling->isa('PPI::Token::Word') and
80             $head->snext_sibling->content eq 'constant' ) {
81              
82 0   0     0 while ( $current->snext_sibling and $current->content ne '=>' ) {
83 0         0 $current = $current->snext_sibling;
84             }
85 0         0 $current->set_content('=');
86              
87 0 0       0 if ( $head->next_sibling->isa('PPI::Token::Whitespace') ) {
88 0         0 $head->next_sibling->remove;
89             }
90 0         0 $head->remove;
91             }
92              
93 9         238 return $self->transformation( $DESC, $EXPL, $elem );
94             }
95              
96             1;
97              
98             #-----------------------------------------------------------------------------
99              
100             __END__
101              
102             =pod
103              
104             =head1 NAME
105              
106             Perl::ToPerl6::Transformer::FormatConstants - Transform Readonly and constant
107              
108              
109             =head1 AFFILIATION
110              
111             This Transformer is part of the core L<Perl::ToPerl6|Perl::ToPerl6>
112             distribution.
113              
114              
115             =head1 DESCRIPTION
116              
117             Perl6 has real constants, so we don't need modules or pragmas:
118              
119             use constant FOO => 1 --> constant $FOO = 1
120             Readonly my @FOO => (1) --> my constant @FOO = (1)
121              
122             =head1 CONFIGURATION
123              
124             This Transformer is not configurable except for the standard options.
125              
126             =head1 AUTHOR
127              
128             Jeffrey Goff <drforr@pobox.com>
129              
130             =head1 COPYRIGHT
131              
132             Copyright (c) 2015 Jeffrey Goff
133              
134             This program is free software; you can redistribute it and/or modify
135             it under the same terms as Perl itself.
136              
137             =cut
138              
139             ##############################################################################
140             # Local Variables:
141             # mode: cperl
142             # cperl-indent-level: 4
143             # fill-column: 78
144             # indent-tabs-mode: nil
145             # c-indentation-style: bsd
146             # End:
147             # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :