File Coverage

blib/lib/Perl/ToPerl6/Transformer/Variables/RewriteSpecialVariables.pm
Criterion Covered Total %
statement 19 27 70.3
branch 0 2 0.0
condition 0 6 0.0
subroutine 8 12 66.6
pod 3 5 60.0
total 30 52 57.6


line stmt bran cond sub pod time code
1             package Perl::ToPerl6::Transformer::Variables::RewriteSpecialVariables;
2              
3 1     1   761 use 5.006001;
  1         3  
4 1     1   5 use strict;
  1         1  
  1         19  
5 1     1   4 use warnings;
  1         2  
  1         22  
6 1     1   4 use Readonly;
  1         2  
  1         40  
7              
8 1     1   4 use Perl::ToPerl6::Utils qw{ :severities };
  1         2  
  1         46  
9              
10 1     1   107 use base 'Perl::ToPerl6::Transformer';
  1         2  
  1         468  
11              
12             #-----------------------------------------------------------------------------
13              
14             Readonly::Scalar my $DESC => q{Transform @ARGV to @*ARGS};
15             Readonly::Scalar my $EXPL => q{Perl6 changes many special variables};
16              
17             #-----------------------------------------------------------------------------
18              
19             my %map = (
20             'STDIN' => '$*IN',
21             'STDOUT' => '$*OUT',
22             'STDERR' => '$*ERR',
23             '$ARG' => '$_',
24             #$_[1],$_[2].. => $^a,$^b # Say whaa?
25             #'$a' => -, # XXX Needs some work
26             #- => '$/',
27             '$`' => '$/.prematch',
28             '$PREMATCH' => '$/.prematch',
29             '${^PREMATCH}' => '$/.prematch',
30             '$&' => '~$/',
31             '$MATCH' => '~$/',
32             '${^MATCH}' => '~$/',
33             '$\'' => '$/.postmatch',
34             '$POSTMATCH' => '$/.postmatch',
35             '${^POSTMATCH}' => '$/.postmatch',
36             '$+' => '$/[$/.end]', # Ouch?
37             '$^N' => '$/[*-1]', # Likewise.
38             '@+' => '(map {.from},$/[*])',
39             '@-' => '(map {.to},$/[*])',
40             #'@-' # $-[0] => $0.from, ergo $-[$n] = $/[$n].from # XXX special
41             #'@+' # $+[0] => $0.to, ergo $+[$n] = $/[$n].to # XXX special
42             '$.' => '$*IN.ins()',
43             '$NR' => '$*IN.ins()',
44             '$/' => '$*IN.input-line-separator()',
45             '$|' => '$*OUT:autoflush',
46             '$RS' => '$*IN.input-line-separator()',
47             '$!' => '$*OUT.autoflush()', # xxx May need some work
48             '$,' => '$*OUT.output-field-separator()',
49             '$OFS' => '$*OUT.output-field-separator()',
50             '$\\' => '$*OUT.output-record-separator()',
51             '$$' => '$*PID',
52             '$PID' => '$*PID',
53             '$(' => '$*GID',
54             '$GID' => '$*GID',
55             '$<' => '$*UID',
56             '$UID' => '$*UID',
57             '$>' => '$*EUID',
58             '$EUID' => '$*EUID',
59             '$)' => '$*EGID',
60             '$GID' => '$*EGID',
61             '$0' => '$*PROGRAM-NAME',
62             '$PROGRAM_NAME' => '$*PROGRAM-NAME',
63             '$^C' => '$*COMPILING',
64             '$COMPILING' => '$*COMPILING',
65             '$^D' => '$*DEBUGGING',
66             '$DEBUGGING' => '$*DEBUGGING',
67             '$^F' => '$*SYS_FD_MAX', # XXX ?
68             '$SYS_FD_MAX' => '$*SYS_FD_MAX', # XXX ?
69             '$^I' => '$*INPLACE_EDIT', # XXX ?
70             '$INPLACE_EDIT' => '$*INPLACE_EDIT', # XXX ?
71             '$^M' => '$*EMERGENCY_MEMORY', # XXX ?
72             '$^O' => '$*KERNEL.name',
73             '$^OSNAME' => '$*KERNEL.name',
74             '$^P' => '$*PERLDB',
75             '$PERLDB' => '$*PERLDB',
76             '$^R' => '$*LAST_REGEXP_CODE_RESULT', # XXX ?
77             '$^T' => '$*INITTIME', # Temporal::Instant
78             '$BASETIME' => '$*INITTIME', # Temporal::Instant
79             '$^V' => '$*PERL.version',
80             '$]' => '$*PERL.version',
81             '$^W' => '$*WARNINGS',
82             '${^WARNING_BITS}' => '$*WARNINGS',
83             '$^X' => '$?COMPILER',
84             'ARGV' => '$*ARGFILES',
85             # $*ARGFILES Note the P6 idiom for this handle:
86             # for lines() {
87             # # each time through loop
88             # # proc a line from files named in ARGS
89             # }
90             '@ARGV' => '@*ARGS', # XXX Remember $ARGV[...]
91             # 'ARGVOUT' # XXX ?
92             # '$ARGV' # XXX ?
93             '@F' => '@_', # XXX May require translation?
94             '%ENV' => '%*ENV', # XXX remember $ENV{...}
95             '@INC' => '@*INC', # XXX remember $INC[...]
96             '%INC' => '%*INC', # XXX remember $INC[...]
97             '$SIG{__WARN__}' => '$*ON_WARN', # XXX Note it's not the actual %SIG
98             '$SIG{__DIE__}' => '$*ON_DIE', # XXX Note it's not the actual %SIG
99             '$@' => '$!', # XXX May not be as appropriate.
100             );
101              
102             #-----------------------------------------------------------------------------
103              
104 1     1 0 2 sub supported_parameters { return () }
105 1     1 1 5 sub default_necessity { return $NECESSITY_HIGHEST }
106 0     0 1   sub default_themes { return qw( core ) }
107             sub applies_to {
108             return sub {
109             ( $_[1]->isa('PPI::Token::Symbol') or
110             $_[1]->isa('PPI::Token::Word') or
111             $_[1]->isa('PPI::Token::Magic') ) and
112 0 0 0 0     $map{$_[1]->content}
      0        
113             }
114 0     0 1   }
115              
116             #-----------------------------------------------------------------------------
117              
118             # Keep track of these because they might be useful notes.
119             my %all_new = (
120             '$!' => 1, # current exception
121             );
122              
123             my %eliminated = (
124             '%!' => 1, # Don't forget $!{...}
125             '$[' => 1,
126             '$*' => 1,
127             '$#' => 1, # XXX Don't confuse with $#a
128             '$^H' => 1, # Yipes?
129             '%^H' => 1, # Yipes?
130            
131             '$!' => 1, # => $! maybe
132             '$ERRNO' => 1, # => $! maybe
133             '$OS_ERROR' => 1, # => $! maybe
134             '$?' => 1, # => $! maybe
135             '$CHILD_ERROR' => 1, # => $! maybe
136             '$@' => 1, # => $! maybe
137             '$^E' => 1,
138             '$^S' => 1,
139             '$"' => 1,
140             '$LIST_SEPARATOR' => 1,
141             '$;' => 1,
142             '$SUBSEP' => 1,
143             '%INC' => 1, # XXX This is in a CompUnitRepo, whatever that is.
144             '%SIG' => 1, # XXX Different than the manpage - event filters plus exception translation
145             '${^OPEN}' => 1, # Supposedly internal-only.
146             );
147              
148             #
149             # @ARGV --> @*ARGS
150             # $1 --> $0 and so on.
151             #
152             sub transform {
153 0     0 0   my ($self, $elem, $doc) = @_;
154 0           my $old_content = $elem->content;
155              
156 0           my $new_content = $map{$old_content};
157              
158 0           $elem->set_content( $new_content );
159              
160 0           return $self->transformation( $DESC, $EXPL, $elem );
161             }
162              
163             1;
164              
165             #-----------------------------------------------------------------------------
166              
167             __END__
168              
169             =pod
170              
171             =head1 NAME
172              
173             Perl::ToPerl6::Transformer::Variables::RewriteSpecialVariables - Format special variables such as @ARGV
174              
175              
176             =head1 AFFILIATION
177              
178             This Transformer is part of the core L<Perl::ToPerl6|Perl::ToPerl6>
179             distribution.
180              
181              
182             =head1 DESCRIPTION
183              
184             Perl6 renames many special variables, this changes most of the common variable names, including replacing some of the more obscure variables with new Perl6 equivalent code:
185              
186             @ARGV --> @*ARGS
187             @+ --> (map {.from},$/[*])
188              
189             Other variables are no longer used in Perl6, but will not be removed as likely they have expressions attached to them. These cases will probably be dealt with by adding comments to the expression.
190              
191             Transforms special variables outside of comments, heredocs, strings and POD.
192              
193             =head1 CONFIGURATION
194              
195             This Transformer is not configurable except for the standard options.
196              
197             =head1 AUTHOR
198              
199             Jeffrey Goff <drforr@pobox.com>
200              
201             =head1 COPYRIGHT
202              
203             Copyright (c) 2015 Jeffrey Goff
204              
205             This program is free software; you can redistribute it and/or modify
206             it under the same terms as Perl itself.
207              
208             =cut
209              
210             ##############################################################################
211             # Local Variables:
212             # mode: cperl
213             # cperl-indent-level: 4
214             # fill-column: 78
215             # indent-tabs-mode: nil
216             # c-indentation-style: bsd
217             # End:
218             # ex: set ts=8 sts=4 sw=4 tw=78 ft=perl expandtab shiftround :