Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Perlito5 - Dumper - encode "unsafe" strings

  • Loading branch information...
commit 72f9f0a64780c2bbe2ec9ae2f01bcc75c7951706 1 parent 69de328
@fglock authored
View
42 html/perlito5.js
@@ -2211,7 +2211,47 @@ var p5100 = p5pkg['main'];
};
};
};
- return (p5context([(String.fromCharCode(39) + p5str(v_obj) + String.fromCharCode(39))], p5want));
+ return (p5pkg["Perlito5::Dumper"].escape_string([v_obj], p5want));
+ }
+ catch(err) {
+ if ( err instanceof Error ) {
+ throw(err);
+ }
+ else {
+ return(err);
+ }
+ }
+ });
+ var Hash_safe_char = {};
+ (Hash_safe_char = p5a_to_h([' ', 1, '!', 1, '"', 1, '#', 1, '$', 1, '%', 1, '&', 1, '(', 1, ')', 1, '*', 1, '+', 1, ',', 1, '-', 1, '.', 1, '/', 1, ':', 1, ';', 1, '<', 1, '=', 1, '>', 1, '?', 1, '@', 1, '[', 1, ']', 1, '^', 1, '_', 1, '`', 1, '{', 1, '|', 1, '}', 1, '~', 1]));
+ p5make_sub("Perlito5::Dumper", "escape_string", function (List__, p5want) {
+ try {
+ var v_s;
+ (v_s = (List__.shift()));
+ var List_out= [];
+ var v_tmp;
+ (v_tmp = (''));
+ if ( (p5str(v_s) == '') ) {
+ throw(p5context([String.fromCharCode(39) + String.fromCharCode(39)], p5want));
+ };
+ p5for_lex(function (v_i) {
+ var v_c;
+ (v_c = (p5pkg["Perlito5::Dumper"].substr([v_s, v_i, 1], 0)));
+ if ( (((((p5str(v_c) >= 'a') && (p5str(v_c) <= 'z')) || ((p5str(v_c) >= 'A') && (p5str(v_c) <= 'Z'))) || ((p5str(v_c) >= '0') && (p5str(v_c) <= '9'))) || (Hash_safe_char).hasOwnProperty(v_c)) ) {
+ (v_tmp = ((p5str(v_tmp) + p5str(v_c))));
+ }
+ else {
+ if ( (p5str(v_tmp) != '') ) {
+ List_out.p5push([(String.fromCharCode(39) + p5str(v_tmp) + String.fromCharCode(39))]);
+ };
+ List_out.p5push([('chr(' + p5str(p5pkg["Perlito5::Dumper"].ord([v_c], 0)) + ')')]);
+ (v_tmp = (''));
+ };
+ }, p5list_to_a((function (a) { for (var i=0, l=(p5pkg["Perlito5::Dumper"].length([v_s], 0) - 1); i<=l; ++i){ a.push(i) }; return a })([])), false, "");
+ if ( (p5str(v_tmp) != '') ) {
+ List_out.p5push([(String.fromCharCode(39) + p5str(v_tmp) + String.fromCharCode(39))]);
+ };
+ return (p5context([p5pkg["Perlito5::Dumper"].join([' . ', p5list_to_a(List_out)], p5want)], p5want));
}
catch(err) {
if ( err instanceof Error ) {
View
53 perlito5.pl
@@ -7856,7 +7856,33 @@ sub Perlito5::Dumper::Dumper {
}
}
};
- return ((chr(39) . $obj . chr(39)))
+ return (escape_string($obj))
+};
+((my %safe_char) = (' ', 1, '!', 1, '"', 1, '#', 1, '$', 1, '%', 1, '&', 1, '(', 1, ')', 1, '*', 1, '+', 1, ',', 1, '-', 1, '.', 1, '/', 1, ':', 1, ';', 1, '<', 1, '=', 1, '>', 1, '?', 1, '@', 1, '[', 1, ']', 1, '^', 1, '_', 1, '`', 1, '{', 1, '|', 1, '}', 1, '~', 1));
+sub Perlito5::Dumper::escape_string {
+ ((my $s) = shift());
+ (my @out);
+ ((my $tmp) = '');
+ if (($s eq '')) {
+ return (chr(39) . chr(39))
+ };
+ for my $i ((0 .. (length($s) - 1))) {
+ ((my $c) = substr($s, $i, 1));
+ if ((((((($c ge 'a') && ($c le 'z'))) || ((($c ge 'A') && ($c le 'Z')))) || ((($c ge '0') && ($c le '9')))) || exists($safe_char{$c}))) {
+ ($tmp = ($tmp . $c))
+ }
+ else {
+ if (($tmp ne '')) {
+ push(@out, (chr(39) . $tmp . chr(39)) )
+ };
+ push(@out, ('chr(' . ord($c) . ')') );
+ ($tmp = '')
+ }
+ };
+ if (($tmp ne '')) {
+ push(@out, (chr(39) . $tmp . chr(39)) )
+ };
+ return (join(' . ', @out))
};
1;
@@ -10952,31 +10978,8 @@ package Perlito5::Perl5;
((my $level) = shift());
join("", ' ' x $level)
};
- ((my %safe_char) = (' ', 1, '!', 1, '"', 1, '#', 1, '$', 1, '%', 1, '&', 1, '(', 1, ')', 1, '*', 1, '+', 1, ',', 1, '-', 1, '.', 1, '/', 1, ':', 1, ';', 1, '<', 1, '=', 1, '>', 1, '?', 1, '@', 1, '[', 1, ']', 1, '^', 1, '_', 1, '`', 1, '{', 1, '|', 1, '}', 1, '~', 1));
sub Perlito5::Perl5::escape_string {
- ((my $s) = shift());
- (my @out);
- ((my $tmp) = '');
- if (($s eq '')) {
- return (chr(39) . chr(39))
- };
- for my $i ((0 .. (length($s) - 1))) {
- ((my $c) = substr($s, $i, 1));
- if ((((((($c ge 'a') && ($c le 'z'))) || ((($c ge 'A') && ($c le 'Z')))) || ((($c ge '0') && ($c le '9')))) || exists($safe_char{$c}))) {
- ($tmp = ($tmp . $c))
- }
- else {
- if (($tmp ne '')) {
- push(@out, (chr(39) . $tmp . chr(39)) )
- };
- push(@out, ('chr(' . ord($c) . ')') );
- ($tmp = '')
- }
- };
- if (($tmp ne '')) {
- push(@out, (chr(39) . $tmp . chr(39)) )
- };
- return (join(' . ', @out))
+ return (Perlito5::Dumper::escape_string($_[0]))
}
}};
package Perlito5::AST::CompUnit;
View
62 src5/lib/Perlito5/Dumper.pm
@@ -50,9 +50,69 @@ sub Dumper {
. $tab . "}, '$ref')";
}
- return "'$obj'";
+ return escape_string($obj);
}
+my %safe_char = (
+ ' ' => 1,
+ '!' => 1,
+ '"' => 1,
+ '#' => 1,
+ '$' => 1,
+ '%' => 1,
+ '&' => 1,
+ '(' => 1,
+ ')' => 1,
+ '*' => 1,
+ '+' => 1,
+ ',' => 1,
+ '-' => 1,
+ '.' => 1,
+ '/' => 1,
+ ':' => 1,
+ ';' => 1,
+ '<' => 1,
+ '=' => 1,
+ '>' => 1,
+ '?' => 1,
+ '@' => 1,
+ '[' => 1,
+ ']' => 1,
+ '^' => 1,
+ '_' => 1,
+ '`' => 1,
+ '{' => 1,
+ '|' => 1,
+ '}' => 1,
+ '~' => 1,
+);
+
+sub escape_string {
+ my $s = shift;
+ my @out;
+ my $tmp = '';
+ return "''" if $s eq '';
+ for my $i (0 .. length($s) - 1) {
+ my $c = substr($s, $i, 1);
+ if ( ($c ge 'a' && $c le 'z')
+ || ($c ge 'A' && $c le 'Z')
+ || ($c ge '0' && $c le '9')
+ || exists( $safe_char{$c} )
+ )
+ {
+ $tmp = $tmp . $c;
+ }
+ else {
+ push @out, "'$tmp'" if $tmp ne '';
+ push @out, "chr(" . ord($c) . ")";
+ $tmp = '';
+ }
+ }
+ push @out, "'$tmp'" if $tmp ne '';
+ return join(' . ', @out);
+}
+
+
1;
View
57 src5/lib/Perlito5/Perl5/Emitter.pm
@@ -9,63 +9,8 @@ package Perlito5::Perl5;
" " x $level
}
- my %safe_char = (
- ' ' => 1,
- '!' => 1,
- '"' => 1,
- '#' => 1,
- '$' => 1,
- '%' => 1,
- '&' => 1,
- '(' => 1,
- ')' => 1,
- '*' => 1,
- '+' => 1,
- ',' => 1,
- '-' => 1,
- '.' => 1,
- '/' => 1,
- ':' => 1,
- ';' => 1,
- '<' => 1,
- '=' => 1,
- '>' => 1,
- '?' => 1,
- '@' => 1,
- '[' => 1,
- ']' => 1,
- '^' => 1,
- '_' => 1,
- '`' => 1,
- '{' => 1,
- '|' => 1,
- '}' => 1,
- '~' => 1,
- );
-
sub escape_string {
- my $s = shift;
- my @out;
- my $tmp = '';
- return "''" if $s eq '';
- for my $i (0 .. length($s) - 1) {
- my $c = substr($s, $i, 1);
- if ( ($c ge 'a' && $c le 'z')
- || ($c ge 'A' && $c le 'Z')
- || ($c ge '0' && $c le '9')
- || exists( $safe_char{$c} )
- )
- {
- $tmp = $tmp . $c;
- }
- else {
- push @out, "'$tmp'" if $tmp ne '';
- push @out, "chr(" . ord($c) . ")";
- $tmp = '';
- }
- }
- push @out, "'$tmp'" if $tmp ne '';
- return join(' . ', @out);
+ return Perlito5::Dumper::escape_string($_[0]);
}
}
Please sign in to comment.
Something went wrong with that request. Please try again.