File Coverage

blib/lib/Padre/Document/PHP.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package Padre::Document::PHP;
2              
3 1     1   7087 use 5.008;
  1         5  
  1         47  
4 1     1   7 use strict;
  1         1  
  1         40  
5 1     1   6 use warnings;
  1         2  
  1         31  
6 1     1   6 use Carp ();
  1         2  
  1         32  
7 1     1   477 use Padre::Document ();
  0            
  0            
8              
9             our $VERSION = '0.05';
10             our @ISA = 'Padre::Document';
11              
12             sub comment_lines_str { return '#' }
13              
14             sub event_on_char {
15             my ( $self, $editor, $event ) = @_;
16              
17             my $main = Padre->ide->wx->main;
18             my $config = Padre->ide->config;
19              
20             $editor->Freeze;
21              
22             $self->autocomplete_matching_char(
23             $editor, $event,
24             34 => 34, # " "
25             39 => 39, # ' '
26             40 => 41, # ( )
27             60 => 62, # < >
28             91 => 93, # [ ]
29             123 => 125, # { }
30             );
31              
32             $editor->Thaw;
33              
34             $main->on_autocompletion($event) if $config->autocomplete_always;
35              
36             return;
37             }
38              
39             sub autocomplete {
40             my $self = shift;
41             my $event = shift;
42              
43             my $editor = $self->editor;
44             my $pos = $editor->GetCurrentPos;
45             my $line = $editor->LineFromPosition($pos);
46             my $first = $editor->PositionFromLine($line);
47              
48             # line from beginning to current position
49             my $prefix = $editor->GetTextRange( $first, $pos );
50             my $suffix = $editor->GetTextRange( $pos, $pos + 15 );
51             $suffix = $1 if $suffix =~ /^(\w*)/; # Cut away any non-word chars
52              
53             # The second parameter may be a reference to the current event or the next
54             # char which will be added to the editor:
55             my $nextchar;
56             if ( defined($event) and ( ref($event) eq 'Wx::KeyEvent' ) ) {
57             my $key = $event->GetUnicodeKey;
58             $nextchar = chr($key);
59             } elsif ( defined($event) and ( !ref($event) ) ) {
60             $nextchar = $event;
61             }
62              
63             # check for hashs
64             elsif ( $prefix =~ /(\$\w+(?:\-\>)?)\[([\'\"]?)([\$\&]?\w*)$/ ) {
65             my $hashname = $1;
66             my $textmarker = $2;
67             my $keyprefix = $3;
68              
69             my $last = $editor->GetLength();
70             my $text = $editor->GetTextRange( 0, $last );
71              
72             my %words;
73             while ( $text =~ /\Q$hashname\E\[(([\'\"]?)\Q$keyprefix\E.+?\2)\]/g ) {
74             $words{$1} = 1;
75             }
76              
77             return (
78             length( $textmarker . $keyprefix ),
79             sort {
80             my $a1 = $a;
81             my $b1 = $b;
82             $a1 =~ s/^([\'\"])(.+)\1/$2/;
83             $b1 =~ s/^([\'\"])(.+)\1/$2/;
84             $a1 cmp $b1;
85             } ( keys(%words) )
86             );
87              
88             }
89              
90             $prefix =~ s{^.*?((\w+::)*\w+)$}{$1};
91             my $last = $editor->GetLength();
92             my $text = $editor->GetTextRange( 0, $last );
93             my $pre_text = $editor->GetTextRange( 0, $first + length($prefix) );
94             my $post_text = $editor->GetTextRange( $first, $last );
95              
96             my $regex;
97             eval { $regex = qr{\b(\Q$prefix\E\w+(?:::\w+)*)\b} };
98             if ($@) {
99             return ("Cannot build regex for '$prefix'");
100             }
101             my @keywords=qw/abstract and array as break
102             case catch cfunction class clone
103             const continue declare default do
104             else elseif enddeclare endfor endforeach
105             endif endswitch endwhile extends final
106             for foreach function global goto
107             if implements interface instanceof
108             namespace new old_function or private
109             protected public static switch throw
110             try use var while xor/;
111              
112             my %seen;
113             my @words;
114             push @words, grep { $_ =~ $regex and !$seen{$_}++} @keywords;
115             push @words, grep { !$seen{$_}++ } reverse( $pre_text =~ /$regex/g );
116             push @words, grep { !$seen{$_}++ } ( $post_text =~ /$regex/g );
117              
118             if ( @words > 20 ) {
119             @words = @words[ 0 .. 19 ];
120             }
121              
122             # Suggesting the current word as the only solution doesn't help
123             # anything, but your need to close the suggestions window before
124             # you may press ENTER/RETURN.
125             if ( ( $#words == 0 ) and ( $prefix eq $words[0] ) ) {
126             return;
127             }
128              
129             # While typing within a word, the rest of the word shouldn't be
130             # inserted.
131             if ( defined($suffix) ) {
132             for ( 0 .. $#words ) {
133             $words[$_] =~ s/\Q$suffix\E$//;
134             }
135             }
136              
137             # This is the final result if there is no char which hasn't been
138             # saved to the editor buffer until now
139             return ( length($prefix), @words ) if !defined($nextchar);
140              
141             # Finally cut out all words which do not match the next char
142             # which will be inserted into the editor (by the current event)
143             my @final_words;
144             for (@words) {
145              
146             # Accept everything which has prefix + next char + at least one other char
147             next if !/^\Q$prefix$nextchar\E./;
148             push @final_words, $_;
149             }
150              
151             return ( length($prefix), @final_words );
152             }
153              
154             sub autoclean {
155             my $self = shift;
156              
157             my $editor = $self->editor;
158             my $text = $editor->GetText;
159              
160             $text =~ s/[\s\t]+([\r\n]*?)$/$1/mg;
161             $text .= "\n" if $text !~ /\n$/;
162              
163             $editor->SetText($text);
164              
165             return 1;
166              
167             }
168              
169             sub get_command {
170              
171             my $self = shift;
172             my $debug = shift;
173              
174             my $config = Padre->ide->config;
175              
176             # Use a temporary file if run_save is set to 'unsaved'
177             my $filename =
178             $config->run_save eq 'unsaved' && !$self->is_saved
179             ? $self->store_in_tempfile
180             : $self->filename;
181              
182             my $php = $config->php_cmd;
183              
184             # Warn if the PHP interpreter is not executable:
185             if ( defined($php) and ( $php ne '' ) and ( !-x $php ) ) {
186             my $ret = Wx::MessageBox(
187             Wx::gettext(
188             sprintf( '%s seems to be no executable PHP interpreter, use the system default PHP instead?', $php )
189             ),
190             Wx::gettext('Run'),
191             Wx::wxYES_NO | Wx::wxCENTRE,
192             Padre->ide->wx->main,
193             );
194             $php = 'php'
195             if $ret == Wx::wxYES;
196              
197             } else {
198             $php = 'php';
199             }
200              
201             # Set default arguments
202             my %run_args = (
203             interpreter => $config->php_interpreter_args_default,
204              
205             # script => $config->run_script_args_default,
206             );
207              
208             # Overwrite default arguments with the ones preferred for given document
209             foreach my $arg ( keys %run_args ) {
210             my $type = "run_${arg}_args_" . File::Basename::fileparse($filename);
211             $run_args{$arg} = Padre::DB::History->previous($type) if Padre::DB::History->previous($type);
212             }
213              
214             # TODO: Pack args here, because adding the space later confuses the called interpreter
215             my $Script_Args = '';
216             $Script_Args = ' ' . $run_args{script} if defined( $run_args{script} ) and ( $run_args{script} ne '' );
217              
218             my $dir = File::Basename::dirname($filename);
219             chdir $dir;
220              
221             return $debug
222             ? qq{"$php" -d error_reporting=E_ALL $run_args{interpreter} "$filename"$Script_Args}
223             : qq{"$php" $run_args{interpreter} "$filename"$Script_Args};
224             }
225              
226             sub menu {
227             my $self = shift;
228              
229             return ['menu.PHP'];
230             }
231              
232              
233             sub newline_keep_column {
234             my $self = shift;
235              
236             my $editor = $self->editor or return;
237             my $pos = $editor->GetCurrentPos;
238             my $line = $editor->LineFromPosition($pos);
239             my $first = $editor->PositionFromLine($line);
240             my $col = $pos - $editor->PositionFromLine( $editor->LineFromPosition($pos) );
241             my $text = $editor->GetTextRange( $first, ( $pos - $first ) );
242              
243             $editor->AddText( $self->newline );
244              
245             $pos = $editor->GetCurrentPos;
246             $first = $editor->PositionFromLine( $editor->LineFromPosition($pos) );
247              
248             # my $col2 = $pos - $first;
249             # $editor->AddText( ' ' x ( $col - $col2 ) );
250              
251             # TODO: Remove the part made by auto-ident before addtext:
252             $text =~ s/[^\s\t\r\n]/ /g;
253             $editor->AddText($text);
254              
255             $editor->SetCurrentPos( $first + $col );
256              
257             return 1;
258             }
259              
260              
261             1;