Changeset 355

Show
Ignore:
Timestamp:
03/17/08 16:52:29 (2 months ago)
Author:
ingy
Message:
v0.05
Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/src/ingy/pQuery/Changes

    r354 r355  
     1--- 
     2version: 0.05 
     3date:    Mon Mar 17 18:30:04 CDT 2008 
     4changes: 
     5- Implement most selectors 
     6 
    17--- 
    28version: 0.04 

  • trunk/src/ingy/pQuery/MANIFEST

    r354 r355  
    3131t/ideas 
    3232t/misc.t 
     33t/selectors.t 
     34t/spreadily.html 
    3335t/TestpQuery.pm 
    3436t/text.t 

  • trunk/src/ingy/pQuery/lib/pQuery.pm

    r354 r355  
    99use base 'Exporter'; 
    1010 
    11 our $VERSION = '0.04'; 
     11our $VERSION = '0.05'; 
    1212 
    1313our @EXPORT = qw(pQuery PQUERY); 
    …… 
    9191                my $html = do {local $/; <FILE>}; 
    9292                close FILE; 
    93                 $selector = [pQuery::DOM->fromHTML($html)]; 
     93                $selector = [$document = pQuery::DOM->fromHTML($html)]; 
    9494            } 
    9595            else { 
     96                $context ||= $document; 
    9697                return pQuery($context)->find($selector); 
    9798            } 
    …… 
    107108 
    108109sub size { return $#{$_[0]} + 1 } 
    109 sub length { return $#{$_[0]} + 1 } 
    110110 
    111111sub get { 
    …… 
    136136 
    137137# Not needed in Perl 
    138 # sub _setArray { 
    139 #     my ($this, $elems) = @_; 
    140 #     @$this = @$elems; 
    141 #     return $this; 
    142 # } 
     138# sub _setArray {} 
    143139 
    144140sub each { 
    …… 
    149145} 
    150146 
    151 sub index { 
    152     my ($this, $elem) = @_; 
    153     my $ret = -1; 
    154     $this->each(sub { 
    155         $ret = shift 
    156             if (ref($_) && ref($elem)) ? ($_ == $elem) : ($_ eq $elem); 
    157     }); 
    158     return $ret; 
    159 } 
    160  
    161147sub attr { # (name, value, type) 
    162148    # TODO - Get/set a named attribute 
    …… 
    178164 
    179165    $text =~ s/\s+/ /g; 
    180     $text =~ s/\s$//; 
     166    $text =~ s/^\s+|\s+$//g; 
    181167 
    182168    return $text; 
    …… 
    216202} 
    217203 
    218 # XXX - Not really ported yet. 
    219204sub find { 
    220     my $this = shift; 
    221     my $selector = shift or return; 
     205    my ($this, $selector) = @_; 
    222206    my $elems = []; 
    223     $this->each(sub { 
    224         _find_elems($_, $selector, $elems); 
    225     }); 
    226     return $this->pushStack($elems); 
    227 } 
    228  
    229 # sub find { 
    230 #     my ($this, $selector) = @_; 
    231 #     my $elems = pQuery::map($this, sub { 
    232  
    233  
     207 
     208    for (my $i = 0; $i < @$this; $i++) { 
     209        push @$elems, @{$this->_find($selector, $this->[$i])}; 
     210    } 
     211 
     212    return $this->pushStack( 
     213        $selector =~ /[^+>] [^+>]/ 
     214        ? $this->_unique($elems) 
     215        : $elems 
     216    ) 
     217} 
    234218 
    235219sub clone { # (events) 
    …… 
    239223sub filter { # (selector) 
    240224    # TODO - A kind of grep 
    241 } 
    242  
    243 sub not { # (selector) 
    244     # TODO - An anti-grep?? 
    245225} 
    246226 
    …… 
    325305    my $elems; 
    326306    return $this->each(sub { 
    327         if (! defined $elems) { 
     307        if (not defined $elems) { 
    328308            $elems = $args; 
    329309            @$elems = reverse @$elems 
    …… 
    343323# sub isXMLdoc {} 
    344324# sub globalEval {} 
    345 # sub nodeName {} 
     325 
     326sub _nodeName { 
     327    my ($this, $elem, $name) = @_; 
     328    return $elem->nodeName && 
     329        uc($elem->nodeName) eq uc($name); 
     330} 
     331 
     332 
    346333# sub cache {} 
    347334# sub data {} 
    …… 
    355342# sub clean {} 
    356343# sub attr {} 
    357 # sub trim {} 
     344 
     345sub _trim { 
     346    (my $string = $_[1]) =~ s/^\s+|\s+$//g; 
     347    return $string; 
     348} 
     349 
    358350# sub makeArray {} 
    359351# sub inArray {} 
    360 # sub merge {} 
    361 # sub unique {} 
    362 # sub grep {} 
     352 
     353sub _merge { 
     354    push @{$_[1]}, @{$_[2]}; 
     355    return $_[1]; 
     356} 
     357 
     358sub _unique { 
     359    my $seen = {}; 
     360    return [ grep {not $seen->{$_}++} @{$_[1]} ]; 
     361} 
     362 
     363sub _grep { 
     364    my ($this, $elems, $callback, $inv) = @_; 
     365    my $ret = []; 
     366 
     367    for (my ($i, $length) = (0, scalar(@$elems)); $i < $length; $i++) { 
     368        push @$ret, $elems->[$i] 
     369            if (not $inv and &$callback($elems->[$i], $i)) or 
     370               ($inv and not &$callback($elems->[$i], $i)); 
     371    } 
     372 
     373    return $ret; 
     374} 
     375 
    363376# sub map {} 
    364 # sub unique {} 
    365377 
    366378################################################################################ 
    367379# Selector functions 
    368380################################################################################ 
    369  
     381my $chars = '(?:[\w\x{128}-\x{FFFF}_-]|\\.)'; 
     382my $quickChild = qr/^>\s*($chars+)/; 
     383my $quickId = qr/^($chars+)(#)($chars+)/; 
     384my $quickClass = qr/^(([#.]?)($chars*))/; 
     385sub _find { 
     386    my ($this, $t, $context) = @_; 
     387 
     388    return [ $t ] 
     389        if ref($t); 
     390 
     391    return [] 
     392        unless ref($context) and 
     393        $context->can('nodeType') and 
     394        $context->nodeType == 1; 
     395 
     396    $context ||= $document or return []; 
     397 
     398    my ($ret, $done, $last, $nodeName) = ([$context], [], '', ''); 
     399 
     400    while ($t and $last ne $t) { 
     401        my $r = []; 
     402        $last = $t; 
     403 
     404        $t = $this->_trim($t); 
     405 
     406        my $foundToken = 0; 
     407 
     408        my $re = $quickChild; 
     409 
     410        if ($t =~ $re) { 
     411            $nodeName = uc($1); 
     412            for (my $i = 0; $ret->[$i]; $i++) { 
     413                for (my $c = $ret->[$i]; $c; $c = $c->nextSiblingRef) { 
     414                    if ($c->nodeType == 1 and 
     415                        ( 
     416                            $nodeName eq "*" or 
     417                            uc($c->nodeName) eq $nodeName 
     418                        ) 
     419                    ) { push @$r, $c } 
     420                } 
     421            } 
     422        } 
     423        else { 
     424            if ($t =~ s/^([>+~])\s*(\w*)//) { 
     425                $r = []; 
     426                 
     427                my $merge = {}; 
     428                $nodeName = uc($2); 
     429                my $m = $1; 
     430 
     431                for (my ($j, $rl) = (0, scalar(@$ret)); $j < $rl; $j++) { 
     432                    my $n = ($m eq "~" or $m eq "+") 
     433                        ? $ret->[$j]->nextSiblingRef 
     434                        : $ret->[$j]->firstChild; 
     435                    for (; $n; $n = $n->nextSiblingRef) { 
     436                        if ($n->nodeType == 1) { 
     437                            my $id = jQuery->data($n); 
     438                            last if ($m eq "~" and $merge->{$id}); 
     439                            if (not $nodeName or 
     440                                uc($n->nodeName) eq $nodeName 
     441                            ) { 
     442                                $merge->{$id} = 1 if $m eq "~"; 
     443                                push @$r, $n; 
     444                            } 
     445                            last if $m eq "+"; 
     446                        } 
     447                    } 
     448                } 
     449                $ret = $r; 
     450 
     451                $t = $this.trim($t); 
     452                $foundToken = 1; 
     453            } 
     454        } 
     455 
     456        my $m; 
     457        if ($t and not $foundToken) { 
     458            if ($t =~ s/^,//) { 
     459                shift @$ret if $context == $ret->[0]; 
     460 
     461                $done = $this._merge($done, $ret); 
     462 
     463                $r = $ret = [$context];       
     464 
     465                $t = " $t"; 
     466            } 
     467            else { 
     468                if ($t =~ s/$quickId//) { 
     469                    $m = [0, $2, $3, $1]; 
     470                } 
     471                else { 
     472                    if ($t =~ s/$quickClass//) { 
     473                        $m = [$1, $2, $3]; 
     474                    } 
     475                } 
     476                $m->[2] =~s/\\//g; 
     477 
     478                my $elem = $ret->[-1]; 
     479 
     480                my $oid; 
     481                if ($m->[1] eq "#" and 
     482                    $elem and 
     483                    $elem->can('getElementById') 
     484                ) { 
     485                    $oid = $elem->getElementById($m->[2]); 
     486                    $ret = $r = ( 
     487                        $oid && 
     488                        (not $m->[3] or $this->_nodeName($oid, $m->[3])) 
     489                    ) ? [$oid] : []; 
     490                } 
     491                else { 
     492                    for (my $i = 0; $ret->[$i]; $i++) { 
     493                        my $tag = ($m->[1] eq "#" and $m->[3]) 
     494                            ? $m->[3] 
     495                            : ($m->[1] ne "" or $m->[0] eq "") 
     496                                ? "*" 
     497                                : $m->[2]; 
     498                        $r = $this->_merge( 
     499                            $r, 
     500                            $ret->[$i]->getElementsByTagName($tag) 
     501                        ); 
     502                    } 
     503                     
     504                    $r = $this->_classFilter($r, $m->[2]) 
     505                        if ($m->[1] eq "."); 
     506 
     507                    if ($m->[1] eq "#") { 
     508                        my $tmp = []; 
     509 
     510                        for (my $i = 0; $r->[$i]; $i++) { 
     511                            if ($r->[$i]->getAttribute("id") eq $m->[2]) { 
     512                                $tmp = [ $r->[$i] ]; 
     513                                last; 
     514                            } 
     515                        } 
     516                        $r = $tmp; 
     517                    } 
     518 
     519                    $ret = $r; 
     520                } 
     521            } 
     522        } 
     523 
     524        if ($t) { 
     525            my $val = $this->_filter($t, $r); 
     526            $ret = $r = $val->{r}; 
     527            $t = $this->_trim($val->{t}); 
     528        } 
     529    } 
     530#     $ret = [] if $t; 
     531    die "selector error" if $t; 
     532 
     533    shift(@$ret) if $ret and @$ret and $context == $ret->[0]; 
     534 
     535    $done = $this->_merge($done, $ret); 
     536 
     537    return $done; 
     538} 
     539 
     540sub _classFilter { 
     541    my ($this, $r, $m, $not) = @_; 
     542    $m = " $m "; 
     543    my $tmp = []; 
     544    for (my $i = 0; $r->[$i]; $i++) { 
     545        my $pass = CORE::index((" " . $r->[$i]->className . " "), $m) >= 0; 
     546        push @$tmp, $r->[$i] 
     547            if not $not and $pass or $not and not $pass; 
     548    } 
     549    return $tmp; 
     550} 
     551 
     552# The regular expressions that power the parsing engine 
     553my $parse = [ 
     554    # Match: [@value='test'], [@foo] 
     555    qr/^(\[) *@?([\w-]+) *([!*$^~=]*) *('?"?)(.*?)\4 *\]/, 
     556 
     557    # Match: :contains('foo') 
     558    qr/^(:)([\w-]+)\("?'?(.*?(\(.*?\))?[^(]*?)"?'?\)/, 
     559 
     560    # Match: :even, :last-chlid, #id, .class 
     561    qr/^([:.#]*)($chars+)/, 
     562]; 
     563 
     564my $expr = { 
     565    ":" => { 
     566        lt => sub { return $_[1] < $_[2][3] }, 
     567        gt => sub { return $_[1] > $_[2][3] }, 
     568        eq => sub { return $_[2][3] == $_[1] }, 
     569        first => sub { return $_[1] == 0 }, 
     570        last => sub { return $_[1] == $#{$_[3]} }, 
     571        even => sub { return $_[1] % 2 == 0 }, 
     572        odd => sub { return $_[1] % 2 }, 
     573 
     574        contains => sub { index(pQuery($_[0])->text, $_[2][3]) >= 0 }, 
     575    }, 
     576}; 
     577 
     578sub _filter { 
     579    my ($this, $t, $r, $not) = @_; 
     580 
     581    my $last = ''; 
     582 
     583    while ($t and $t ne $last) { 
     584        $last = $t; 
     585 
     586        my ($p, $m) = ($parse); 
     587 
     588        for (my $i = 0; $p->[$i]; $i++) { 
     589            my $re = $p->[$i]; 
     590            if ($t =~ s/$re//) { 
     591                $m = [0, $1, $2, $3, $4, $5]; 
     592                $m->[2] =~ s/\\//g; 
     593                last; 
     594            } 
     595        } 
     596 
     597        last 
     598            if not $m; 
     599 
     600        if ( $m->[1] eq ":" && $m->[2] eq "not") { 
     601            $r = ($m->[3] =~ $isSimple) 
     602                ? $this->_filter($m->[3], $r, 1)->{r} 
     603                : pQuery($r)->not($m->[3]); 
     604        } 
     605        elsif ($m->[1] eq ".") { 
     606            $r = $this->_classFilter($r, $m->[2], $not); 
     607        } 
     608        elsif ($m->[1] eq "[") { 
     609            my ($tmp, $type) = ([], $m->[3]); 
     610 
     611            for (my ($i, $rl) = (0, scalar(@$r)); $i < $rl; $i++) { 
     612                my ($a, $z) = ($r->[$i], $this->_props->[$m->[2]] || $m->[2]); 
     613 
     614                if (not defined $z or $m->[2] =~ /href|src|selected/) { 
     615                    $z = $this->attr($a, $m->[2]) || ''; 
     616                } 
     617 
     618                if ( 
     619                    ( 
     620                        $type eq "" and $z or 
     621                        $type eq "=" and $z eq $m->[5] or 
     622                        $type eq "!=" and $z ne $m->[5] or 
     623                        $type eq "^=" and not index($z, $m->[5]) or 
     624                        $type eq '$=' and substr($z, (0-length($m->[5]))) or 
     625                        ($type eq "*=" or $type eq "~=") and 
     626                            index($z, $m->[5]) >= 0 
     627                    ) ^ $not 
     628                ) { push @$tmp, $a } 
     629            } 
     630 
     631            $r = $tmp; 
     632        } 
     633        elsif ($m->[1] eq ":" && $m->[2] eq "nth-child") { 
     634            # XXX - Finish porting this! 
     635        } 
     636        else { 
     637            my $fn = $expr->{$m->[1]}; 
     638            if (ref($fn) eq "HASH") { 
     639                $fn = $fn->{ $m->[2] }; 
     640            } 
     641#                if ( typeof fn == "string" ) 
     642#                    fn = eval("false||function(a,i){return " + fn + ";}"); 
     643            $fn = sub { 0 } 
     644                if ref($fn) ne 'CODE'; 
     645            $r = $this->_grep( 
     646                $r, 
     647                sub { 
     648                    return &$fn($_[0], $_[1], $m, $r); 
     649                }, 
     650                $not 
     651            ); 
     652        } 
     653    } 
     654    return { r => $r, t => $t }; 
     655} 
     656 
     657################################################################################ 
     658# These methods need to go down here because they are Perl builtins. 
     659################################################################################ 
     660sub length { return $#{$_[0]} + 1 } 
     661 
     662sub index { 
     663    my ($this, $elem) = @_; 
     664    my $ret = -1; 
     665    $this->each(sub { 
     666        $ret = shift 
     667            if (ref($_) && ref($elem)) ? ($_ == $elem) : ($_ eq $elem); 
     668    }); 
     669    return $ret; 
     670} 
     671 
     672sub not { # (selector) 
     673    # TODO - An anti-grep?? 
     674} 
    370675 
    371676################################################################################ 

  • trunk/src/ingy/pQuery/lib/pQuery/DOM.pm

    r351 r355  
    159159    my ($self, $tag) = @_; 
    160160    my $found = []; 
    161     _find($self, $found, sub { $_->{_tag} eq $tag}); 
    162     return wantarray ? @$found : $found->[0]; 
     161    _find($self, $found, sub { $_->{_tag} eq $tag or $tag eq "*" }); 
     162    return $found; 
    163163} 
    164164 
    …… 
    213213        return $_[0]->setAttribute(class => $_[1]); 
    214214    } 
    215     $_[0]->getAttribute("class"); 
     215    my $className = $_[0]->getAttribute("class"); 
     216    return defined $className 
     217        ? $className 
     218        : ''; 
    216219} 
    217220 

  • trunk/src/ingy/pQuery/t/document1.html

    r328 r355  
    66    <h2>Welcome to the sample document</h2> 
    77    <p id="text" class="para"> 
    8         This is an example 
     8    This is an <i>example</i> 
    99        paragraph. 
    1010    </p> 

  • trunk/src/ingy/pQuery/t/dom.t

    r354 r355  
    3232is $span->tagName, "SPAN", 'tagName works'; 
    3333 
    34 my @spans = $dom->getElementsByTagName('span'); 
    35 is scalar(@spans), 3, "Found 3 spans"; 
    36 is $spans[0]->innerHTML, "Foo", '1st value is correct'; 
    37 is $spans[1]->innerHTML, "Bar", '2nd value is correct'; 
     34my $spans = $dom->getElementsByTagName('span'); 
     35is scalar(@$spans), 3, "Found 3 spans"; 
     36is $spans->[0]->innerHTML, "Foo", '1st value is correct'; 
     37is $spans->[1]->innerHTML, "Bar", '2nd value is correct'; 
    3838 
    3939$span->setAttribute('Foo', 'Bar'); 

  • trunk/src/ingy/pQuery/t/each.t

    r354 r355  
    33use pQuery; 
    44 
    5 open FILE, 't/document1.html' or die $!; 
    6 my $html = do {local $/; <FILE>}; 
    7 close FILE; 
    8 chomp $html; 
    9  
    105my $output = ''; 
    11 pQuery($html)->find('li')->each(sub { 
     6pQuery('t/document1.html')->find('li')->each(sub { 
    127    my $i = shift; 
    138    my $text = pQuery($_)->text(); 

  • trunk/src/ingy/pQuery/t/end.t

    r353 r355  
    1 use t::TestpQuery tests => 3; 
     1use t::TestpQuery tests => 2; 
    22 
    33use pQuery; 

  • trunk/src/ingy/pQuery/t/find.t

    r354 r355  
    1 use t::TestpQuery tests => 2; 
     1use t::TestpQuery tests => 6; 
    22 
    33use pQuery; 
    44 
    5 open FILE, 't/document1.html' or die $!; 
    6 my $html = do {local $/; <FILE>}; 
    7 close FILE; 
    8 chomp $html; 
     5my $pquery; 
    96 
    10 my $pquery = pQuery($html)->find('li'); 
     7$pquery = pQuery('t/document1.html')->find('li'); 
    118 
    129is scalar(@$pquery), 5, 'Found 5 LI elements'; 
    1310 
    14 $pquery = pQuery($html)->find('xxx'); 
     11$pquery = pQuery('t/document1.html')->find('xxx'); 
    1512 
    1613is scalar(@$pquery), 0, 'Found 0 XXX elements'; 
     14 
     15$pquery = pQuery('t/document1.html'); 
     16 
     17$pquery->find('#text')->each(sub { 
     18    is $_->nodeName, 'P', 'find by id works'; 
     19}); 
     20$pquery->find('.para')->each(sub { 
     21    is $_->nodeName, 'P', 'find by class works'; 
     22}); 
     23 
     24is $pquery->find('body p i')->text, 'example', 'multiple nested tags works'; 
     25 
     26is $pquery->find('li:eq(4)')->text, 'three', ':eq works';