File Coverage

blib/lib/jQuery.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package jQuery;

use warnings;
use strict;
use XML::LibXML 1.70;
use HTML::Entities;
use Encode;
use Carp;

use base qw/jQuery::Functions Exporter/;
our @EXPORT = qw(jquery jQuery this);

use vars qw/$DOC $PARSER $VERSION/;
$VERSION = "0.004";

my $obj_class = 'jQuery::Obj';
sub this { 'jQuery::Functions'->this(@_) }

sub new {
    my $class = shift;
    my $string = shift;
    my $parser;
    my $doc;
    if (!$PARSER){
        $parser = XML::LibXML->new();
        $parser->recover(1);
        $parser->recover_silently(1);
        $parser->keep_blanks(1);
        $parser->expand_entities(1);
        $parser->no_network(1);
        local $XML::LibXML::skipXMLDeclaration = 1;
        local $XML::LibXML::skipDTD = 1;
        local $XML::LibXML::setTagCompression = 1;
        $PARSER = $parser;
    } else {
        $parser = $PARSER;
    }

    if ($string){
        if ($string =~ /^http/){
            $string = $class->get($string);
        } elsif ($string =~ /^<\?xml/) {
            $doc = $parser->parse_string($string);
        } else {
            $doc = $parser->parse_html_string($string);
        }
        $DOC = $doc;
    }

    return bless({
        document => $doc
    }, __PACKAGE__);
}

*jQuery = \&jquery;
sub jquery {
    my ($selector, $context) = (shift,shift);
    my $this;
    my $c;

    if ( ref ($selector) eq __PACKAGE__ ){
        $this->{document} = $selector->{document};
        $selector = $context;
        $context = shift;
    } else {
        $this->{document} = $DOC;
    }

    if ($context){
        if (@_){
            $context = bless([$context,@_], ref $context);
        }
        return jQuery($context)->find($selector);
    }

    if ( ref($selector) eq $obj_class ){
        return $selector;
    }

    bless($this, $obj_class);
    $this->{nodes} = [];
    return $this if !$selector;

    my $nodes;
    if ( ref($selector) =~ /XML::/i ){
        if ($selector->isa('ARRAY')){
            $nodes = $selector;
        } else {
            $nodes = [$selector];
        }
    } elsif ( ref ($selector) eq 'ARRAY' ){
        $nodes = $selector;
    } elsif ($this->is_HTML($selector)) {
        $nodes = $this->createNode($selector);
    } else {
        $nodes = $this->_find($selector);
        ##another try to create html fragment
        if (!$nodes->[0]){
            $nodes = $this->createNode($selector);
        }
    }

    return $this->pushStack(@$nodes);
}

##something like pushStack in jquery
sub pushStack {
    my $self = shift;
    my @elements;

    return jQuery($self,@_) unless $self->isa('HASH') and
    ref $self eq $obj_class;
    @elements = ref $_[0] eq 'ARRAY'
    ?   @{$_[0]}
    :   @_;

    #save old object
    $self->{prevObject} = $self->{nodes};

    #$self = bless ([@elements], $obj_class);
    $self->{nodes} = \@elements;
    return $self;
}

sub toArray {
    my $self = shift;
    my @nodes;
    if ($self->isa('ARRAY')) {
        @nodes = @{$self};
    } elsif ($self->isa('HASH')) {
        @nodes = @{$self->{nodes}};
    } else {
        @nodes = ($self);
    }

    return wantarray ?
    @nodes
    : \@nodes;
}

sub getNodes {
    my $self = shift;
    my @nodes;
    if ($self->isa('ARRAY')) {
        @nodes = @{$self};
    } elsif ($self->isa('HASH')) {
        @nodes = @{$self->{nodes}};
    } else {
        @nodes = ($self);
    }
    return wantarray ? @nodes : bless(\@nodes, $obj_class);
}


sub _find {
    my ($this, $selector, $context ) = @_;
    $context ||= $this->document;
    my @nodes;
    eval {
        if ($selector !~ m/\//){
            $selector = $this->_translate_css_to_xpath($selector,$context->nodePath);
        }
        @nodes = $context->findnodes($selector) if $selector;
    };

    if ($@){
        croak $@;
    }
    return wantarray
    ? @nodes
    : \@nodes;
}

#Should I use HTML::Selector::XPath and port some jquery selectors by hand ??
#it's well maintained
#this is faster but not easy to maintain and not quiet mature
sub _translate_css_to_xpath {
    my $self = shift;
    my $start_query = shift;
    my $old_query = shift;
    my $custompath = shift || '';
    my @args;
    $start_query =~ s/\((.*?),(.*?)\)/\($1$2\)/g;
    my @queries = split(/\,/,$start_query);
    my $this_query = 0;

    foreach my $query (@queries){
        $query =~ s//,/g;
        #remove all leading and ending whitespaces
        $query =~ s/^\s+|\s+$//g;
        $query =~ s/\s+/
        ##add one whitespace at the beginning
        $query = " ".$query;

        my $selector;
        $selector = $old_query if $old_query;

        my $pos = 0;
        my $directpath = 0;
        my $empty_path =0;
        my $single = 0;

        ##setting starting search path custom path is // which search down all elements
        my $path = '//';
        $path = $custompath if $custompath;

        ##I wrote this some while ago, I feel dizzy when I try to read it again
        while ($query =~ /([\s|\.|\:|\#]?)((\[.*?\])|(~)|(\+)|(\>)|(\<)|(\*)|([\w\-]+(\(.*?\))?))/g){

            my $type = $1;
            my $value = $2;
            my $pos2 = 0;

            ##set empty starting path
            if ($custompath eq 'empty' && $pos2 eq '0'){
                $path = '';
                ###if we want to search direct childrens
            }   elsif ($directpath || $empty_path){
                $path = '/';
                $path = '//' if $directpath eq '2';
                $path = '' if $empty_path;
                if (($type =~ /(\:|\.|\#)/ || $value =~ /\[.*?\]/)){
                    $selector .= $path.'*';
                }

                #reset direct path
                $directpath = 0;
                ##reset empty path
                $empty_path = 0;
            }   else {
                $path = '//';
            }

            $type =~ s/\s+//;
            $value =~ s/\s+//;
            if ($pos == 0){
                $path = $custompath if $custompath && $custompath ne 'empty';
                if (($type =~ /(\:|\.|\#)/ || $value =~ /\[.*?\]/)){
                    $selector .= $path.'*';
                }
            }

            if ($value eq '*'){
                $selector .= $path.'*';
            } elsif ($value eq '>'){
                $directpath = 1;
            }   elsif ($value eq '<'){
                $directpath = 2;
            } elsif ($value eq '+'){
                $selector .= '/following-sibling::';
                $empty_path = 1;
                $single = 1;
            } elsif ($value eq '~'){
                $selector .= '/following-sibling::';
                $empty_path = 1;
            } elsif ($value =~ /\[(.*?)\]/){

                my ($name, $value) = split(/\s*=\s*/, $1, 2);
                if (defined $value) {
                    for ($value) {
                        s/^['"]//;
                        s/['"]$//;
                    }

                    if ($name =~ s/\^$//){
                        $selector .= "[starts-with (\@$name,'$value')]";
                    } elsif ($name =~ s/\$$//){
                        #$selector .= "[ends-with (\@$name,'$value')]";
                        $selector .= "[substring(\@$name, string-length(\@$name) - string-length('$value')+ 1, string-length(\@$name))= '$value']";
                    } elsif ($name =~ s/\*$//){
                        $selector .= "[contains (\@$name,'$value')]";
                    } elsif ($name =~ s/\|$//){
                        $selector .= "[\@$name ='$value'"." or "."starts-with(\@$name,'$value".'-'."')]";
                    } else {
                        $selector .= "[\@$name='$value']";
                    }

                } else {
                    $selector .= "[\@$name]";
                }

            ##this is tag
            } elsif (!$type){
                $selector .= $path.$value;
            ##this is class
            } elsif ($type eq "."){
                ##finally found a good solution from
                ##http://plasmasturm.org/log/444/
                $selector .= '[ contains(concat( " ", @class, " " ),concat( " ", "'.$value.'", " " )) ]';

            ##id selector
            } elsif ($type eq '#'){
                $selector .= '[@id="'.$value.'"]';
            }

            ###pseduo-class
            elsif ($type eq ':'){

                if ($value eq "first-child"){
                    $selector .= '[1]';
                } elsif ($value eq "first"){
                    #$selector = "getIndex($selector,'eq','0')";
                    $selector .= '[position() = 1]'; ##this doesn't really do the job exactly as jQuery
                } elsif ($value eq "odd"){
                    #$selector = 'getOdd('.$selector.')';
                    $selector .= '[position() mod 2 != 1]'; ##this doesn't do the job exactly as jQuery
                } elsif ($value eq "even"){
                    #$selector = 'getEven('.$selector.')';
                    $selector .= '[position() mod 2 != 0]'; ##this doesn't do the job exactly as jQuery
                } elsif ($value =~ /(gt|lt|eq)\((.*?)\)/){
                    $selector = "getIndex($selector,'$1','$2')";
                } elsif ($value =~ /nth-child\((.*?)\)/){
                    $selector .= "[position() = $1]";
                } elsif ($value =~ /has\((.*?)\)/){
                    $selector = "getHas($selector,'$1')";
                } elsif ($value =~ /not\((.*?)\)/){
                    $selector = "getNot($selector,'$1')";
                } elsif ($value eq "button"){
                    #$selector .= '[@type="button"]';
                    $selector = "getButton($selector)";
                } elsif ($value =~ /(checkbox|file|hidden|image|text|submit|radio|password|reset)/){
                    $selector .= "[\@type='$value']";
                } elsif ($value eq "checked"){
                    $selector .= '[@checked="checked"]';
                } elsif ($value eq "selected"){
                    $selector .= '[@selected="selected"]';
                } elsif ($value eq "disabled"){
                    $selector .= '[@disabled]';
                } elsif ($value eq "enabled"){
                    $selector .= '[not(@disabled)]';
                } elsif ($value =~ /contains\((.*?)\)/){
                    my $str = $1;
                    for ($str) {
                        s/^['"]//;
                        s/['"]$//;
                    }
                    $selector .= "[contains(.,'$str')]";
                } elsif ($value eq "empty"){
                    $selector .= '[not(node())]';
                } elsif ($value eq "only-child"){

                    my ($str1, $str2) = $selector =~ /(.*)\/(.*)/;
                    if ($str1 =~ s/\/$//){
                        $str2 = '/'.$str2;
                        $selector = $str1.'//child::*/parent::*[count(*)=1]'.'/'.$str2;
                    } else{
                        $selector = $str1.'/child::*/parent::*[count(*)=1]'.'/'.$str2;
                    }

                } elsif ($value eq "header"){
                    $selector = "getHeaders($selector)";
                } elsif ($value eq "parent"){
                    $selector .= '[(node())]';
                } elsif ($value eq "last"){
                    #$selector = "getLast($selector)";
                    $selector .= '[position()=last()]';
                } elsif ($value eq "last-child"){
                    $selector .= "[last()]";
                }
            }
            $pos++; $pos2++;
        }
        if ($single){
            $selector .= '[1]';
            $single = 0;
        }
        $this_query++;
        push (@args,$selector);
    }
    return join(' | ',@args);
}

sub as_HTML {
    my $self = shift;
    my $doc = $self->document;
    if (ref($doc) eq 'XML::LibXML::Document' ){
        my $html = $doc->serialize_html();
        if ($html =~ m//g){
            $html =~ s/(?:.*?)(.*)<\/div>(?:.*)/$1/s;
        }
        return $html;
    }
    return $doc->getDocumentElement->html();
}

sub as_XML {
    my $doc = $_[0]->document;
    if ($$DOC ne $$doc){
        if (ref($doc) eq 'XML::LibXML::Document' ){
            my $xml = $doc->serialize();
            if ($xml =~ m//g){
                $xml =~ s/(?:.*?)(.*)<\/div>(?:.*)/$1/s;
            }
            return $xml;
        }
        return $doc->getDocumentElement->html();
    }

    return $doc->serialize();
}


sub is_HTML {
    my ($self,$html) = @_;
    ### very permative solution but it seems
    ### to work with all tests so far
    if ($html =~ /<.*>/g){
        return 1;
    }
    return 0;
}

sub createNode {
    my ($self,$html) = @_;
    my $node;
    if (!$PARSER){ $self->new(); }
    $html = "".$html."";
    if ($html =~ /^<\?xml/) {
        $node = $PARSER->parse_string($html);
    } else{
        $node = $PARSER->parse_html_string($html);
    }

    $DOC = $node if !$DOC;
    $node->removeInternalSubset;
    my $nodes = $node->getDocumentElement->findnodes("//*[\@class='REMOVE_THIS_ELEMENT']")->[0]->childNodes;
    return $nodes;
}

sub createNode2 {
    my ($self,$html) = @_;
    $html = "".$html."";
    my $new = $self->new($html);
    return $new->jQuery('.REMOVE_THIS_ELEMENT *');
}

##detect node parent document
sub document {
    my $self = shift;
    my $doc;
    if ($self->isa('ARRAY') && $self->[0]){
        $doc = $self->[0]->ownerDocument;
    } elsif ($self->isa('HASH') && $self->{document}){
        $doc = $self->{document};
    }
    return $doc ? $doc : $DOC;
}

sub cloneDOC {
    my $self = shift;
    my $clone = $self->document->cloneNode(1);
    return bless([$clone], __PACKAGE__);
}

sub decode_html { return decode_entities($_[1]); }
sub parser { return shift->{parser}; }

###custom internal functions
###copied from jQuery.js
sub body { return shift->getElementsByTagName('body'); }

sub makeArray {
    my ( $array, $results ) = @_;
    my $ret = $results || [];
    if ( ref $array eq 'ARRAY' ) {
	push @{$ret}, @{$array};
    }
    else { $ret = \@_; }
    return wantarray
    ? @$ret
    : $ret;
}

sub merge {
    my ( $first, $second ) = @_;
    my $i = _length($first);
    my $j = 0;
    if ( _length($second) ) {
	for ( my $l = _length($second); $j < $l; $j++ ) {
	    $first->[ $i++ ] = $second->[ $j ];
	}
    } else {
	while ( $second->[$j] ) {
            $first->[ $i++ ] = $second->[ $j++ ];
	}
    }
    $i = _length($first);
    return wantarray
    ? @$first
    : $first ;
}

sub _length {
    if (ref $_[0] eq 'ARRAY'){
        @_ = @{$_[0]};
    }
    return $#_ + 1;
}

sub isDisconnected {
    my $node = shift;
    return !$node || !$node->parentNode || $node->parentNode->nodeType == 11;
}

sub unique {
    my %hash;
    my @ele = grep{!$hash{$$_}++} @_;
    return @ele;
}

sub nodeName  {
    my ( $elem, $name ) = @_;
    return $elem->nodeName && uc $elem->nodeName eq uc $name;
}

package jQuery::Obj;
use base 'jQuery';

##hack Libxml modules to use jQuery as base module
##is this a bad practice?
package XML::LibXML::NodeList;
use base 'jQuery::Obj';

package XML::LibXML::Node;
use base 'jQuery::Obj';

package XML::LibXML::Element;
use base 'jQuery::Obj';

package XML::LibXML::Text;
use base 'jQuery::Obj';
use base 'XML::LibXML::Element';

1;

__END__