File Coverage

blib/lib/JE/Object/String.pm
Criterion Covered Total %
statement 212 230 92.1
branch 104 128 81.2
condition 51 64 79.6
subroutine 32 38 84.2
pod 6 7 85.7
total 405 467 86.7


line stmt bran cond sub pod time code
1             package JE::Object::String;
2              
3             our $VERSION = '0.064';
4              
5              
6 101     101   34163 use strict;
  101         609  
  101         4166  
7 101     101   1341 use warnings; no warnings 'utf8';
  101     101   1157  
  101         4486  
  101         352  
  101         675  
  101         7392  
8              
9             sub surrogify($);
10             sub desurrogify($);
11              
12             our @ISA = 'JE::Object';
13              
14 101     101   1807 use POSIX qw 'floor ceil';
  101         17175  
  101         1614  
15 101     101   11085 use Scalar::Util 'blessed';
  101         575  
  101         34215  
16              
17             require JE::Code;
18             require JE::Number;
19             require JE::Object ;
20             require JE::Object::Error::TypeError;
21             require JE::Object::Function ;
22             require JE::String ;
23              
24             JE::String->import(qw/surrogify desurrogify/);
25             JE::Code->import('add_line_number');
26             sub add_line_number;
27              
28             =encoding UTF-8
29              
30             =head1 NAME
31              
32             JE::Object::String - JavaScript String object class
33              
34             =head1 SYNOPSIS
35              
36             use JE;
37             use JE::Object::String;
38              
39             $j = new JE;
40              
41             $js_str_obj = new JE::Object::String $j, "etetfyoyfoht";
42              
43             $perl_str = $js_str_obj->value;
44              
45             =head1 DESCRIPTION
46              
47             This class implements JavaScript String objects for JE. The difference
48             between this and JE::String is that that module implements
49             I string value, while this module implements the I
50              
51             =head1 METHODS
52              
53             See L for descriptions of most of the methods. Only what
54             is specific to JE::Object::String is explained here.
55              
56             =over 4
57              
58             =cut
59              
60             sub new {
61 34     34 1 59 my($class, $global, $val) = @_;
62 34   33     174 my $self = $class->SUPER::new($global, {
63             prototype => $global->prototype_for('String')
64             || $global->prop('String')->prop('prototype')
65             });
66              
67 34 100 66     360 $$$self{value} = defined $val
    100          
68             ? defined blessed $val
69             && $val->can('to_string')
70             ? $val->to_string->value16
71             : surrogify $val
72             : '';
73 34         148 $self;
74             }
75              
76             sub prop {
77 978     978 1 1105 my $self = shift;
78 978 100       2140 if($_[0] eq 'length') {
79 3         15 return JE::Number->new(
80             $$$self{global},length $$$self{value}
81             );
82             }
83 975         2620 SUPER::prop $self @_;
84             }
85              
86             sub delete {
87 0     0 1 0 my $self = shift;
88 0 0       0 $_[0] eq 'length' and return !1;
89 0         0 SUPER::delete $self @_;
90             }
91              
92             =item value
93              
94             Returns a Perl scalar.
95              
96             =cut
97              
98 3     3 1 4 sub value { desurrogify ${+shift}->{value} }
  3         9  
99              
100             =item value16
101              
102             Returns a Perl scalar containing a UTF-16 string (i.e., with surrogate
103             pairs if the string has chars outside the BMP). This is here more for
104             internal usage than anything else.
105              
106             =cut
107              
108 1     1 1 1 sub value16 { ${+shift}->{value} }
  1         5  
109              
110              
111              
112             sub is_readonly {
113 5     5 0 7 my $self = shift;
114 5 50       14 $_[0] eq 'length' and return 1;
115 5         25 SUPER::is_readonly $self @_;
116             }
117              
118 28     28 1 89 sub class { 'String' }
119              
120 101     101   1558 no warnings 'qw';
  101         671  
  101         145181  
121             our %_replace = qw/
122             $ \$
123             & ".substr($str,$-[0],$+[0]-$-[0])."
124             ` ".substr($str,0,$-[0])."
125             ' ".substr($str,$+[0])."
126             /;
127              
128             sub _new_constructor {
129 19     19   45 my $global = shift;
130             my $f = JE::Object::Function->new({
131             name => 'String',
132             scope => $global,
133             function => sub {
134 26     26   26 my $arg = shift;
135 26 100       94 defined $arg ? $arg->to_string :
136             JE::String->_new($global, '');
137             },
138             function_args => ['args'],
139             argnames => ['value'],
140             constructor => sub {
141 22     22   61 unshift @_, __PACKAGE__;
142 22         70 goto &new;
143             },
144 19         388 constructor_args => ['scope','args'],
145             });
146              
147             # E 15.5.3.2
148             $f->prop({
149             name => 'fromCharCode',
150             value => JE::Object::Function->new({
151             scope => $global,
152             name => 'fromCharCode',
153             length => 1,
154             no_proto => 1,
155             function_args => ['args'],
156             function => sub {
157 17     17   24 my $str = '';
158 17         18 my $num;
159 17         28 for (@_) {
160             # % 2**16 is buggy in perl
161 52         99 $num = $_->to_number->value;
162 52 100       183 $num =
163             ($num < 0 ? ceil$num : floor$num)
164             % 2**16 ;
165 52   100     175 $str .= chr($num == $num && $num);
166             # change nan to 0
167             }
168 17         44 JE::String->_new($global, $str);
169             },
170 19         270 }),
171             dontenum => 1,
172             });
173              
174 19         121 my $proto = bless $f->prop({
175             name => 'prototype',
176             dontenum => 1,
177             readonly => 1,
178             }), __PACKAGE__;
179 19         1057 $$$proto{value} = '';
180 19         81 $global->prototype_for('String', $proto);
181              
182             $proto->prop({
183             name => 'toString',
184             value => JE::Object::Function->new({
185             scope => $global,
186             name => 'toString',
187             no_proto => 1,
188             function_args => ['this'],
189             function => sub {
190 12     12   20 my $self = shift;
191 12 100       36 die JE::Object::Error::TypeError->new(
192             $global, add_line_number
193             "Argument to toString is not a " .
194             "String object"
195             ) unless $self->class eq 'String';
196              
197 9 100       33 return $self if ref $self eq 'JE::String';
198 8         29 JE::String->_new($global, $$$self{value});
199             },
200 19         205 }),
201             dontenum => 1,
202             });
203              
204             $proto->prop({
205             name => 'valueOf',
206             value => JE::Object::Function->new({
207             scope => $global,
208             name => 'valueOf',
209             no_proto => 1,
210             function_args => ['this'],
211             function => sub {
212 19     19   27 my $self = shift;
213 19 100       55 die JE::Object::Error::TypeError->new(
214             $global, add_line_number
215             "Argument to valueOf is not a " .
216             "String object"
217             ) unless $self->class eq 'String';
218              
219             # We also deal with plain strings here.
220 16 100       85 ref $self eq 'JE::String'
221             ? $self
222             : JE::String->_new(
223             $global, $$$self{value}
224             );
225             },
226 19         244 }),
227             dontenum => 1,
228             });
229              
230             $proto->prop({
231             name => 'charAt',
232             value => JE::Object::Function->new({
233             scope => $global,
234             name => 'charAt',
235             argnames => ['pos'],
236             no_proto => 1,
237             function_args => ['this','args'],
238             function => sub {
239 12     12   15 my ($self,$pos) = @_;
240            
241 12         41 my $str = $self->to_string->value16;
242 12 50       29 if (defined $pos) {
243 12         32 $pos = int $pos->to_number->[0];
244 12 100       31 $pos = 0 unless $pos == $pos;
245             }
246              
247 12 100 100     85 JE::String->_new($global,
248             $pos < 0 || $pos >= length $str
249             ? ''
250             : substr $str, $pos, 1);
251             },
252 19         280 }),
253             dontenum => 1,
254             });
255              
256             $proto->prop({
257             name => 'charCodeAt',
258             value => JE::Object::Function->new({
259             scope => $global,
260             name => 'charCodeAt',
261             argnames => ['pos'],
262             no_proto => 1,
263             function_args => ['this','args'],
264             function => sub {
265 12     12   18 my ($self,$pos) = @_;
266            
267 12         32 my $str = $self->to_string->value16;
268 12 50       41 if (defined $pos) {
269 12         34 $pos = int $pos->to_number->[0];
270 12 100       26 $pos = 0 unless $pos == $pos;
271             }
272              
273 12 100 100     100 JE::Number->new($global,
274             $pos < 0 || $pos >= length $str
275             ? 'nan'
276             : ord substr $str, $pos, 1);
277             },
278 19         275 }),
279             dontenum => 1,
280             });
281              
282             $proto->prop({
283             name => 'concat',
284             value => JE::Object::Function->new({
285             scope => $global,
286             name => 'concat',
287             length => 1,
288             no_proto => 1,
289             function_args => ['this','args'],
290             function => sub {
291 5     5   7 my $str = '';
292 5         7 for (@_) {
293 16         54 $str .= $_->to_string->value16
294             }
295 5         18 JE::String->_new($global, $str);
296             },
297 19         241 }),
298             dontenum => 1,
299             });
300              
301             $proto->prop({
302             name => 'indexOf',
303             value => JE::Object::Function->new({
304             scope => $global,
305             name => 'indexOf',
306             length => 1,
307             argnames => [qw/searchString position/],
308             no_proto => 1,
309             function_args => ['this','args'],
310             function => sub {
311 18     18   45 my $str = shift->to_string->value16;
312 18 50       62 my $find = defined $_[0]
313             ? $_[0]->to_string->value16
314             : 'undefined';
315 18 100       64 my $start = defined $_[1]
316             ? $_[1]->to_number
317             ->value
318             : 0;
319 18 100       120 JE::Number->new($global,
    100          
320             # In -DDEBUGGING builds of perl (as
321             # of 5.13.2), a $start greater than
322             # the length causes a panick, so we
323             # avoid passing that to index(), as
324             # of version 0.049.
325             $start > length $str
326             ? length $find ? -1 : length $str
327             : index $str, $find, $start
328             );
329             },
330 19         320 }),
331             dontenum => 1,
332             });
333              
334             $proto->prop({
335             name => 'lastIndexOf',
336             value => JE::Object::Function->new({
337             scope => $global,
338             name => 'lastIndexOf',
339             length => 1,
340             argnames => [qw/searchString position/],
341             no_proto => 1,
342             function_args => ['this','args'],
343             function => sub {
344 18     18   46 my $string = shift->to_string->value16;
345 18         48 my $pos = length $string;
346 18 100 100     67 if(defined $_[1] && $_[1]->id ne 'undef') {
347 8         22 my $p = $_[1]->to_number->value;
348 8 100       25 $p < $pos and $pos = $p
349             }
350 18 50       60 JE::Number->new($global, rindex
351             $string,
352             defined $_[0]
353             ? $_[0]->to_string->value16
354             : 'undefined',
355             $pos
356             );
357             },
358 19         295 }),
359             dontenum => 1,
360             });
361              
362             $proto->prop({ # ~~~ I need to figure out how to deal with
363             # locale settings
364             name => 'localeCompare',
365             value => JE::Object::Function->new({
366             scope => $global,
367             name => 'localeCompare',
368             argnames => [qw/that/],
369             no_proto => 1,
370             function_args => ['this','args'],
371             function => sub {
372 0     0   0 my($this,$that) = @_;
373 0 0       0 JE::Number->new($global,
374             $this->to_string->value
375             cmp
376             defined $that
377             ? $that->to_string->value
378             : 'undefined'
379             );
380             },
381 19         267 }),
382             dontenum => 1,
383             });
384              
385             $proto->prop({
386             name => 'match',
387             value => JE::Object::Function->new({
388             scope => $global,
389             name => 'match',
390             argnames => [qw/regexp/],
391             no_proto => 1,
392             function_args => ['this','args'],
393             function => sub {
394 120     120   174 my($str, $re_obj) = @_;
395              
396 120         286 $str = $str->to_string;
397              
398             !defined $re_obj ||
399             (eval{$re_obj->class}||'') ne 'RegExp'
400 120 100 100     355 and do {
      100        
401 20         744 require JE::Object::RegExp;
402 20         85 $re_obj =
403             JE::Object::RegExp->new($global,
404             $re_obj);
405             };
406            
407 120         279 my $re = $re_obj->value;
408              
409             # For non-global patterns and string, reg-
410             # exps, just return the fancy array result-
411             # from a call to String.prototype.exec
412              
413 120 100       337 if (not $re_obj->prop('global')->value) {
414 117         288 return $global
415             ->prototype_for('RegExp')
416             ->prop('exec')
417             ->apply($re_obj, $str);
418             }
419              
420             # For global patterns, I just do the
421             # matching here, since it's faster.
422              
423             # ~~~ Problem: This is meant to call String
424             # .prototype.exec, according to the spec,
425             # which method can, of course, be replaced
426             # with a user-defined function. So much for
427             # this optimisation. (But, then, no one
428             # else follows the spec!)
429            
430 3         12 $str = $str->value16;
431              
432 3         7 my @ary;
433 3         24 while($str =~ /$re/g) {
434 84         328 push @ary, JE::String->_new($global,
435             substr $str, $-[0],
436             $+[0] - $-[0]);
437             }
438            
439 3         19 JE::Object::Array->new($global, \@ary);
440             },
441 19         276 }),
442             dontenum => 1,
443             });
444              
445             $proto->prop({
446             name => 'replace',
447             value => JE::Object::Function->new({
448             scope => $global,
449             name => 'replace',
450             argnames => [qw/searchValue replaceValue/],
451             no_proto => 1,
452             function_args => ['this','args'],
453             function => sub {
454 55     55   87 my($str, $foo, $bar) = @_;
455             # as in s/foo/bar/
456              
457 55         137 $str = $str->to_string->value16;
458              
459 55         85 my $g; # global?
460 55 100 100     429 if(defined $foo && $foo->can('class') &&
      100        
461             $foo->class eq 'RegExp')
462             {
463 35         79 $g = $foo->prop('global')->value;
464 35         73 $foo = $$$foo{value};
465             }
466             else {
467 20         25 $g = !1;
468 20 100       56 $foo = defined $foo
469             ? quotemeta $foo->to_string->value16
470             : 'undefined';
471             }
472              
473 55 100 100     384 if (defined $bar && $bar->can('class') &&
      100        
474             $bar->class eq 'Function') {
475             my $replace = sub {
476 33         84 $global
477             ->prototype_for('RegExp')
478             ->prop('constructor')
479             ->capture_re_vars($str);
480            
481 33         181 $_[0]->call(
482             JE::String->_new($global,
483             substr $str, $-[0],
484             $+[0] - $-[0]),
485             map(JE::String->_new(
486             $global,
487             $JE'Object'RegExp'Match[$_]
488             ), 1..$#+),
489             JE::Number->new($global,
490             $-[0]),
491             $_[1]
492             )->to_string->value16
493 21         128 };
494              
495 21         92 my $je_str = JE::String->_new(
496             $global, $str);
497              
498 21 100       223 $g
499             ? $str =~ s/$foo/
500 19         35 &$replace($bar, $je_str)
501             /ge
502             : $str =~ s/$foo/
503 14         33 &$replace($bar, $je_str)
504             /e
505             }
506             else {
507             # replacement string instead of
508             # function (a little tricky)
509              
510             # We need to use /ee and surround
511             # bar with double quotes, so that
512             # '$1,$2' becomes eval '"$1,$2"'.
513             # And so we also have to quotemeta
514             # the whole string.
515              
516             # I know the indiscriminate
517             # untainting may seem a little
518             # dangerous, but quotemeta takes
519             # care of it.
520             $bar = defined $bar
521 34 100       63 ? do {
522 32         86 $bar->to_string->value16
523             =~ /(.*)/s; # untaint
524 32         119 quotemeta $1
525             }
526             : 'undefined';
527              
528             # now $1, $&, etc have become \$1,
529             # \$\& ...
530              
531 34         80 $bar =~ s/\\\$(?:
532             \\([\$&`'])
533             |
534             ([1-9][0-9]?|0[0-9])
535             )/
536 30 100       127 defined $1 ? $_replace{$1}
537             : "\$JE::Object::RegExp::"
538             . "Match[$2]";
539             /gex;
540              
541 34         59 my $orig_str = $str;
542 101     101   615 no warnings 'uninitialized';
  101         182  
  101         86552  
543 34 100       372 $g ? $str =~ s/$foo/qq'"$bar"'/gee
  25 100       1191  
544 23         1329 : $str =~ s/$foo/qq'"$bar"'/ee
545             and
546             $global
547             ->prototype_for('RegExp')
548             ->prop('constructor')
549             ->capture_re_vars($orig_str);
550             }
551            
552 55         286 JE::String->_new($global, $str);
553             },
554 19         330 }),
555             dontenum => 1,
556             });
557              
558             $proto->prop({
559             name => 'search',
560             value => JE::Object::Function->new({
561             scope => $global,
562             name => 'search',
563             argnames => [qw/regexp/],
564             no_proto => 1,
565             function_args => ['this','args'],
566             function =>
567             sub {
568 40     40   48 my($str, $re) = @_;
569              
570             $re = defined $re ?(eval{$re->class}||'')eq 'RegExp' ? $re->value :
571 40 100 100     122 do {
    100          
572 15         812 require JE::Object::RegExp;
573 15         56 JE::Object::RegExp->new($global, $re)->value
574             } : qr//;
575              
576 40 100       198 return JE::Number->new(
577             $global,
578             ($str = $str->to_string->value16) =~ $re
579             ? scalar(
580             $global->prototype_for('RegExp')
581             ->prop('constructor')
582             ->capture_re_vars($str),
583             $-[0]
584             )
585             :-1
586             );
587             }
588 19         315 }),
589             dontenum => 1,
590             });
591              
592             $proto->prop({
593             name => 'slice',
594             value => JE::Object::Function->new({
595             scope => $global,
596             name => 'slice',
597             argnames => [qw/start end/],
598             no_proto => 1,
599             function_args => ['this','args'],
600             function => sub {
601 24     24   60 my($str, $start, $end) = @_;
602              
603 24         59 $str = $str->to_string->value16;
604 24         61 my $length = length $str;
605              
606 24 100       44 if (defined $start) {
607 23         66 $start = int $start->to_number->value;
608 23   100     94 $start = $start == $start && $start; # change nan to 0
609              
610 23 100       58 $start >= $length and return JE::String->_new($global, '');
611             # $start < 0 and $start = 0;
612             }
613 1         2 else { $start = 0; }
614              
615 23 100 100     71 if (defined $end && $end->id ne 'undef') {
616 15         37 $end = int $end->to_number->value;
617 15   100     51 $end = $end == $end && $end;
618              
619 15 100       54 $end > 0 and $end -= $start + $length * ($start < 0);
620             }
621 8         16 else { $end = $length }
622              
623 23         78 return JE::String->_new($global, substr $str, $start, $end);
624              
625             },
626 19         294 }),
627             dontenum => 1,
628             });
629              
630              
631             =begin split-notes
632              
633             If the separator is a non-empty string, we need to quotemeta it.
634              
635             If we have an empty string, we mustn’t allow a match at the end of the
636             string, so we use qr/(?!\z)/.
637              
638             If we have a regexp, then there are several issues:
639              
640             A successful zero-width match that occurs at the same position as
641             the end of the previous match needs to be turned into a failure
642             (no backtracking after the initial successful match), so as to
643             produce the aardvark result below. We could accomplish this by
644             wrapping it in an atomic group: /(?> ... )/. But then we come
645             to the second issue:
646              
647             To ensure correct (ECMAScript-compliant) capture erasure in cases
648             like 'cbazyx'.split(/(a|(b))+/) (see 15.10-regexps-objects.t), we need to
649             use @JE::Object::RegExp::Match, rather than $1, $2, etc.
650              
651             This precludes the use of perl’s split operator (at least for regexp sepa-
652             rators), so we have to implement it ourselves.
653              
654             We also need to make sure that a null match does not occur at the end of
655             a string. Since a successful match that begins at the end of a string can-
656             not but be a zero-length match, we could conceptually put (?!\z) at the
657             beginning of the match, but qr/...$a_qr_with_embedded_code/ causes weird
658             scoping issues (the embedded code, although it was compiled in a separate
659             package, somehow makes its way into the package that combined it in a
660             larger regexp); hence the somewhat complex logic below.
661              
662              
663             join ',', split /a*?/, 'aardvark' gives ',,r,d,v,,r,k'
664             'aardvark'.split(/a*?/).toString() gives 'a,a,r,d,v,a,r,k'
665              
666             -----
667             JS's 'aardvark'.split('', 3) means (split //, 'aardvark', 4)[0..2]
668              
669             =end split-notes
670              
671             =cut
672              
673              
674             $proto->prop({
675             name => 'split',
676             value => JE::Object::Function->new({
677             scope => $global,
678             name => 'split',
679             argnames => [qw/separator limit/],
680             no_proto => 1,
681             function_args => ['this','args'],
682             function => sub {
683 8     8   15 my($str, $sep, $limit) = @_;
684              
685 8         28 $str = (my $je_str = $str->to_string)
686             ->value16;
687              
688 8 100 66     35 if(!defined $limit ||
    50          
689             $limit->id eq 'undef') {
690 7         11 $limit = -2;
691             }
692             elsif(defined $limit) {
693 1         4 $limit = int($limit->to_number->value)
694             % 2 ** 32;
695 1   33     6 $limit = $limit == $limit && $limit;
696             # Nan --> 0
697             }
698            
699 8 50       17 if (defined $sep) {
700 8 100 66     64 if ($sep->can('class')
    50          
701             && $sep->class eq 'RegExp') {
702 2         9 $sep = $sep->value;
703             }
704             elsif($sep->id eq 'undef') {
705 0         0 return JE::Object::Array->new(
706             $global, $je_str
707             );
708             }
709             else {
710 6         16 $sep = $sep->to_string->value16;
711             }
712             }
713             else {
714 0         0 return JE::Object::Array->new(
715             $global, $je_str
716             );
717             }
718            
719 8         15 my @split;
720              
721 8 100       24 if (!ref $sep) {
722 6 50       19 $sep = length $sep ? quotemeta $sep :
723             qr/(?!\z)/;
724 6         114 @split = split $sep, $str, $limit+1;
725 6         34 goto returne;
726             }
727              
728 2 50 0     8 !length $str and
729             ''=~ $sep || (@split = ''),
730             goto returne;
731            
732 2         3 my$pos = 0;
733 2         15 while($str =~ /$sep/gc) {
734 65 100       179 $pos == pos $str and ++pos $str, next;
735             # That ++pos won’t go past the end of
736             # the string, so it may end up being a
737             # no-op; but the ‘next’ bypasses the
738             # pos assignment below, so perl refuses
739             # to match again at the same position.
740 33 100       73 $-[0] == length $str and last;
741 32         82 push @split,substr($str,$pos,$-[0]-$pos),
742             @JE::Object::RegExp::Match[
743             1..$#JE::Object::RegExp::Match
744             ];
745 32         124 $pos = pos $str = pos $str;
746             # Assigning pos to itself has the same
747             # effect as using an atomic group
748             # with split
749             }
750 2         7 push @split, substr($str, $pos);
751              
752 8 50       62 returne:
    50          
    100          
753             JE::Object::Array->new($global,
754             $limit == -2 ? @split : @split ? @split[
755             0..(@split>$limit?$limit-1:$#split)
756             ] : @split);
757              
758             },
759 19         323 }),
760             dontenum => 1,
761             });
762              
763             $proto->prop({
764             name => 'substring',
765             value => JE::Object::Function->new({
766             scope => $global,
767             name => 'substring',
768             argnames => [qw/start end/],
769             no_proto => 1,
770             function_args => ['this','args'],
771             function => sub {
772 81     81   98 my($str, $start, $end) = @_;
773              
774 81         186 $str = $str->to_string->value16;
775 81         156 my $length = length $str;
776              
777              
778 81 50       137 if (defined $start) {
779 81         220 $start = int $start->to_number->value;
780 81 50       190 $start >= 0 or $start = 0;
781             }
782 0         0 else { $start = 0; }
783              
784              
785 81 100 66     269 if (!defined $end || $end->id eq 'undef') {
786 5         8 $end = $length;
787             }
788             else {
789 76         169 $end = int $end->to_number->value;
790 76 50       160 $end >= 0 or $end = 0;
791             }
792              
793 81 50       218 $start > $end and ($start,$end) = ($end,$start);
794              
795 101     101   560 no warnings 'substr'; # in case start > length
  101         671  
  101         45226  
796 81         181 my $x= substr $str, $start, $end-$start;
797 81 50       293 return JE::String->_new($global, defined $x ? $x : '');
798              
799             },
800 19         318 }),
801             dontenum => 1,
802             });
803              
804             $proto->prop({
805             name => 'toLowerCase',
806             value => JE::Object::Function->new({
807             scope => $global,
808             name => 'toLowerCase',
809             no_proto => 1,
810             function_args => ['this'],
811             function => sub {
812 0     0   0 my $str = shift;
813              
814 0         0 JE::String->_new($global,
815             lc $str->to_string->value16);
816             },
817 19         275 }),
818             dontenum => 1,
819             });
820              
821             $proto->prop({
822             name => 'toLocaleLowerCase',
823             value => JE::Object::Function->new({
824             scope => $global,
825             name => 'toLocaleLowerCase',
826             no_proto => 1,
827             function_args => ['this'],
828             function => sub { # ~~~ locale settings?
829 0     0   0 my $str = shift;
830              
831 0         0 JE::String->_new($global,
832             lc $str->to_string->value);
833             },
834 19         224 }),
835             dontenum => 1,
836             });
837              
838             $proto->prop({
839             name => 'toUpperCase',
840             value => JE::Object::Function->new({
841             scope => $global,
842             name => 'toUpperCase',
843             no_proto => 1,
844             function_args => ['this'],
845             function => sub {
846 0     0   0 my $str = shift;
847              
848 0         0 JE::String->_new($global,
849             uc $str->to_string->value16);
850             },
851 19         223 }),
852             dontenum => 1,
853             });
854              
855             $proto->prop({
856             name => 'toLocaleUpperCase',
857             value => JE::Object::Function->new({
858             scope => $global,
859             name => 'toLocaleUpperCase',
860             no_proto => 1,
861             function_args => ['this'],
862             function => sub { # ~~~ locale settings?
863 0     0   0 my $str = shift;
864              
865 0         0 JE::String->_new($global,
866             uc $str->to_string->value);
867             },
868 19         225 }),
869             dontenum => 1,
870             });
871              
872             $proto->prop({
873             name => 'substr',
874             value => JE::Object::Function->new({
875             scope => $global,
876             name => 'substr',
877             argnames => [qw/start length/],
878             no_proto => 1,
879             function_args => ['this','args'],
880             function => sub {
881 4     4   6 my($str, $start, $len) = @_;
882              
883 4         10 $str = $str->to_string->value16;
884              
885 4 50       8 if (defined $start) {
886 4         14 $start = int $start->to_number->value;
887             }
888 0         0 else { $start = 0; }
889              
890              
891 4 50 33     16 if (!defined $len || $len->id eq 'undef') {
892 0         0 $len = undef;
893             }
894             else {
895 4         9 $len = int $len->to_number->value;
896             }
897              
898 4 50       21 return JE::String->_new($global, defined $len ?
899             (substr $str, $start, $len) :
900             (substr $str, $start)
901             );
902              
903             },
904 19         250 }),
905             dontenum => 1,
906             });
907              
908 19         215 $f;
909             }
910              
911              
912              
913             return "a true value";
914              
915             =back
916              
917             =head1 SEE ALSO
918              
919             =over 4
920              
921             =item JE
922              
923             =item JE::Types
924              
925             =item JE::String
926              
927             =item JE::Object
928              
929             =back
930              
931             =cut
932              
933              
934              
935