home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl5 / XML / XPath / Expr.pm < prev    next >
Encoding:
Perl POD Document  |  2003-01-26  |  18.4 KB  |  620 lines
  1. # $Id: Expr.pm,v 1.20 2003/01/26 19:33:24 matt Exp $
  2.  
  3. package XML::XPath::Expr;
  4. use strict;
  5.  
  6. sub new {
  7.     my $class = shift;
  8.     my ($pp) = @_;
  9.     bless { predicates => [], pp => $pp }, $class;
  10. }
  11.  
  12. sub as_string {
  13.     my $self = shift;
  14.     local $^W; # Use of uninitialized value! grrr
  15.     my $string = "(" . $self->{lhs}->as_string;
  16.     $string .= " " . $self->{op} . " " if defined $self->{op};
  17.     $string .= $self->{rhs}->as_string if defined $self->{rhs};
  18.     $string .= ")";
  19.     foreach my $predicate (@{$self->{predicates}}) {
  20.         $string .= "[" . $predicate->as_string . "]";
  21.     }
  22.     return $string;
  23. }
  24.  
  25. sub as_xml {
  26.     my $self = shift;
  27.     local $^W; # Use of uninitialized value! grrr
  28.     my $string;
  29.     if (defined $self->{op}) {
  30.         $string .= $self->op_xml();
  31.     }
  32.     else {
  33.         $string .= $self->{lhs}->as_xml();
  34.     }
  35.     foreach my $predicate (@{$self->{predicates}}) {
  36.         $string .= "<Predicate>\n" . $predicate->as_xml() . "</Predicate>\n";
  37.     }
  38.     return $string;
  39. }
  40.  
  41. sub op_xml {
  42.     my $self = shift;
  43.     my $op = $self->{op};
  44.  
  45.     my $tag;    
  46.     for ($op) {
  47.         /^or$/    && do {
  48.                     $tag = "Or";
  49.                 };
  50.         /^and$/    && do {
  51.                     $tag = "And";
  52.                 };
  53.         /^=$/    && do {
  54.                     $tag = "Equals";
  55.                 };
  56.         /^!=$/    && do {
  57.                     $tag = "NotEquals";
  58.                 };
  59.         /^<=$/    && do {
  60.                     $tag = "LessThanOrEquals";
  61.                 };
  62.         /^>=$/    && do {
  63.                     $tag = "GreaterThanOrEquals";
  64.                 };
  65.         /^>$/    && do {
  66.                     $tag = "GreaterThan";
  67.                 };
  68.         /^<$/    && do {
  69.                     $tag = "LessThan";
  70.                 };
  71.         /^\+$/    && do {
  72.                     $tag = "Plus";
  73.                 };
  74.         /^-$/    && do {
  75.                     $tag = "Minus";
  76.                 };
  77.         /^div$/    && do {
  78.                     $tag = "Div";
  79.                 };
  80.         /^mod$/    && do {
  81.                     $tag = "Mod";
  82.                 };
  83.         /^\*$/    && do {
  84.                     $tag = "Multiply";
  85.                 };
  86.         /^\|$/    && do {
  87.                     $tag = "Union";
  88.                 };
  89.     }
  90.     
  91.     return "<$tag>\n" . $self->{lhs}->as_xml() . $self->{rhs}->as_xml() . "</$tag>\n";
  92. }
  93.  
  94. sub set_lhs {
  95.     my $self = shift;
  96.     $self->{lhs} = $_[0];
  97. }
  98.  
  99. sub set_op {
  100.     my $self = shift;
  101.     $self->{op} = $_[0];
  102. }
  103.  
  104. sub set_rhs {
  105.     my $self = shift;
  106.     $self->{rhs} = $_[0];
  107. }
  108.  
  109. sub push_predicate {
  110.     my $self = shift;
  111.     
  112.     die "Only 1 predicate allowed on FilterExpr in W3C XPath 1.0"
  113.             if @{$self->{predicates}};
  114.     
  115.     push @{$self->{predicates}}, $_[0];
  116. }
  117.  
  118. sub get_lhs { $_[0]->{lhs}; }
  119. sub get_rhs { $_[0]->{rhs}; }
  120. sub get_op { $_[0]->{op}; }
  121.  
  122. sub evaluate {
  123.     my $self = shift;
  124.     my $node = shift;
  125.     
  126.     # If there's an op, result is result of that op.
  127.     # If no op, just resolve Expr
  128.     
  129. #    warn "Evaluate Expr: ", $self->as_string, "\n";
  130.     
  131.     my $results;
  132.     
  133.     if ($self->{op}) {
  134.         die ("No RHS of ", $self->as_string) unless $self->{rhs};
  135.         $results = $self->op_eval($node);
  136.     }
  137.     else {
  138.         $results = $self->{lhs}->evaluate($node);
  139.     }
  140.     
  141.     if (my @predicates = @{$self->{predicates}}) {
  142.         if (!$results->isa('XML::XPath::NodeSet')) {
  143.             die "Can't have predicates execute on object type: " . ref($results);
  144.         }
  145.         
  146.         # filter initial nodeset by each predicate
  147.         foreach my $predicate (@{$self->{predicates}}) {
  148.             $results = $self->filter_by_predicate($results, $predicate);
  149.         }
  150.     }
  151.     
  152.     return $results;
  153. }
  154.  
  155. sub op_eval {
  156.     my $self = shift;
  157.     my $node = shift;
  158.     
  159.     my $op = $self->{op};
  160.     
  161.     for ($op) {
  162.         /^or$/    && do {
  163.                     return op_or($node, $self->{lhs}, $self->{rhs});
  164.                 };
  165.         /^and$/    && do {
  166.                     return op_and($node, $self->{lhs}, $self->{rhs});
  167.                 };
  168.         /^=$/    && do {
  169.                     return op_equals($node, $self->{lhs}, $self->{rhs});
  170.                 };
  171.         /^!=$/    && do {
  172.                     return op_nequals($node, $self->{lhs}, $self->{rhs});
  173.                 };
  174.         /^<=$/    && do {
  175.                     return op_le($node, $self->{lhs}, $self->{rhs});
  176.                 };
  177.         /^>=$/    && do {
  178.                     return op_ge($node, $self->{lhs}, $self->{rhs});
  179.                 };
  180.         /^>$/    && do {
  181.                     return op_gt($node, $self->{lhs}, $self->{rhs});
  182.                 };
  183.         /^<$/    && do {
  184.                     return op_lt($node, $self->{lhs}, $self->{rhs});
  185.                 };
  186.         /^\+$/    && do {
  187.                     return op_plus($node, $self->{lhs}, $self->{rhs});
  188.                 };
  189.         /^-$/    && do {
  190.                     return op_minus($node, $self->{lhs}, $self->{rhs});
  191.                 };
  192.         /^div$/    && do {
  193.                     return op_div($node, $self->{lhs}, $self->{rhs});
  194.                 };
  195.         /^mod$/    && do {
  196.                     return op_mod($node, $self->{lhs}, $self->{rhs});
  197.                 };
  198.         /^\*$/    && do {
  199.                     return op_mult($node, $self->{lhs}, $self->{rhs});
  200.                 };
  201.         /^\|$/    && do {
  202.                     return op_union($node, $self->{lhs}, $self->{rhs});
  203.                 };
  204.         
  205.         die "No such operator, or operator unimplemented in ", $self->as_string, "\n";
  206.     }
  207. }
  208.  
  209. # Operators
  210.  
  211. use XML::XPath::Boolean;
  212.  
  213. sub op_or {
  214.     my ($node, $lhs, $rhs) = @_;
  215.     if($lhs->evaluate($node)->to_boolean->value) {
  216.         return XML::XPath::Boolean->True;
  217.     }
  218.     else {
  219.         return $rhs->evaluate($node)->to_boolean;
  220.     }
  221. }
  222.  
  223. sub op_and {
  224.     my ($node, $lhs, $rhs) = @_;
  225.     if( ! $lhs->evaluate($node)->to_boolean->value ) {
  226.         return XML::XPath::Boolean->False;
  227.     }
  228.     else {
  229.         return $rhs->evaluate($node)->to_boolean;
  230.     }
  231. }
  232.  
  233. sub op_equals {
  234.     my ($node, $lhs, $rhs) = @_;
  235.  
  236.     my $lh_results = $lhs->evaluate($node);
  237.     my $rh_results = $rhs->evaluate($node);
  238.     
  239.     if ($lh_results->isa('XML::XPath::NodeSet') &&
  240.             $rh_results->isa('XML::XPath::NodeSet')) {
  241.         # True if and only if there is a node in the
  242.         # first set and a node in the second set such
  243.         # that the result of performing the comparison
  244.         # on the string-values of the two nodes is true.
  245.         foreach my $lhnode ($lh_results->get_nodelist) {
  246.             foreach my $rhnode ($rh_results->get_nodelist) {
  247.                 if ($lhnode->string_value eq $rhnode->string_value) {
  248.                     return XML::XPath::Boolean->True;
  249.                 }
  250.             }
  251.         }
  252.         return XML::XPath::Boolean->False;
  253.     }
  254.     elsif (($lh_results->isa('XML::XPath::NodeSet') ||
  255.             $rh_results->isa('XML::XPath::NodeSet')) &&
  256.             (!$lh_results->isa('XML::XPath::NodeSet') ||
  257.              !$rh_results->isa('XML::XPath::NodeSet'))) {
  258.         # (that says: one is a nodeset, and one is not a nodeset)
  259.         
  260.         my ($nodeset, $other);
  261.         if ($lh_results->isa('XML::XPath::NodeSet')) {
  262.             $nodeset = $lh_results;
  263.             $other = $rh_results;
  264.         }
  265.         else {
  266.             $nodeset = $rh_results;
  267.             $other = $lh_results;
  268.         }
  269.         
  270.         # True if and only if there is a node in the
  271.         # nodeset such that the result of performing
  272.         # the comparison on <type>(string_value($node))
  273.         # is true.
  274.         if ($other->isa('XML::XPath::Number')) {
  275.             foreach my $node ($nodeset->get_nodelist) {
  276.                 if ($node->string_value == $other->value) {
  277.                     return XML::XPath::Boolean->True;
  278.                 }
  279.             }
  280.         }
  281.         elsif ($other->isa('XML::XPath::Literal')) {
  282.             foreach my $node ($nodeset->get_nodelist) {
  283.                 if ($node->string_value eq $other->value) {
  284.                     return XML::XPath::Boolean->True;
  285.                 }
  286.             }
  287.         }
  288.         elsif ($other->isa('XML::XPath::Boolean')) {
  289.             if ($nodeset->to_boolean->value == $other->value) {
  290.                 return XML::XPath::Boolean->True;
  291.             }
  292.         }
  293.  
  294.         return XML::XPath::Boolean->False;
  295.     }
  296.     else { # Neither is a nodeset
  297.         if ($lh_results->isa('XML::XPath::Boolean') ||
  298.             $rh_results->isa('XML::XPath::Boolean')) {
  299.             # if either is a boolean
  300.             if ($lh_results->to_boolean->value == $rh_results->to_boolean->value) {
  301.                 return XML::XPath::Boolean->True;
  302.             }
  303.             return XML::XPath::Boolean->False;
  304.         }
  305.         elsif ($lh_results->isa('XML::XPath::Number') ||
  306.                 $rh_results->isa('XML::XPath::Number')) {
  307.             # if either is a number
  308.             local $^W; # 'number' might result in undef
  309.             if ($lh_results->to_number->value == $rh_results->to_number->value) {
  310.                 return XML::XPath::Boolean->True;
  311.             }
  312.             return XML::XPath::Boolean->False;
  313.         }
  314.         else {
  315.             if ($lh_results->to_literal->value eq $rh_results->to_literal->value) {
  316.                 return XML::XPath::Boolean->True;
  317.             }
  318.             return XML::XPath::Boolean->False;
  319.         }
  320.     }
  321. }
  322.  
  323. sub op_nequals {
  324.     my ($node, $lhs, $rhs) = @_;
  325.     if (op_equals($node, $lhs, $rhs)->value) {
  326.         return XML::XPath::Boolean->False;
  327.     }
  328.     return XML::XPath::Boolean->True;
  329. }
  330.  
  331. sub op_le {
  332.     my ($node, $lhs, $rhs) = @_;
  333.     op_gt($node, $rhs, $lhs);
  334. }
  335.  
  336. sub op_ge {
  337.     my ($node, $lhs, $rhs) = @_;
  338.  
  339.     my $lh_results = $lhs->evaluate($node);
  340.     my $rh_results = $rhs->evaluate($node);
  341.     
  342.     if ($lh_results->isa('XML::XPath::NodeSet') &&
  343.         $rh_results->isa('XML::XPath::NodeSet')) {
  344.  
  345.         foreach my $lhnode ($lh_results->get_nodelist) {
  346.             foreach my $rhnode ($rh_results->get_nodelist) {
  347.                 my $lhNum = XML::XPath::Number->new($lhnode->string_value);
  348.                 my $rhNum = XML::XPath::Number->new($rhnode->string_value);
  349.                 if ($lhNum->value >= $rhNum->value) {
  350.                     return XML::XPath::Boolean->True;
  351.                 }
  352.             }
  353.         }
  354.         return XML::XPath::Boolean->False;
  355.     }
  356.     elsif (($lh_results->isa('XML::XPath::NodeSet') ||
  357.             $rh_results->isa('XML::XPath::NodeSet')) &&
  358.             (!$lh_results->isa('XML::XPath::NodeSet') ||
  359.              !$rh_results->isa('XML::XPath::NodeSet'))) {
  360.         # (that says: one is a nodeset, and one is not a nodeset)
  361.  
  362.         my ($nodeset, $other);
  363.         my ($true, $false);
  364.         if ($lh_results->isa('XML::XPath::NodeSet')) {
  365.             $nodeset = $lh_results;
  366.             $other = $rh_results;
  367.             # we do this because unlike ==, these ops are direction dependant
  368.             ($false, $true) = (XML::XPath::Boolean->False, XML::XPath::Boolean->True);
  369.         }
  370.         else {
  371.             $nodeset = $rh_results;
  372.             $other = $lh_results;
  373.             # ditto above comment
  374.             ($true, $false) = (XML::XPath::Boolean->False, XML::XPath::Boolean->True);
  375.         }
  376.         
  377.         # True if and only if there is a node in the
  378.         # nodeset such that the result of performing
  379.         # the comparison on <type>(string_value($node))
  380.         # is true.
  381.         foreach my $node ($nodeset->get_nodelist) {
  382.             if ($node->to_number->value >= $other->to_number->value) {
  383.                 return $true;
  384.             }
  385.         }
  386.         return $false;
  387.     }
  388.     else { # Neither is a nodeset
  389.         if ($lh_results->isa('XML::XPath::Boolean') ||
  390.             $rh_results->isa('XML::XPath::Boolean')) {
  391.             # if either is a boolean
  392.             if ($lh_results->to_boolean->to_number->value
  393.                     >= $rh_results->to_boolean->to_number->value) {
  394.                 return XML::XPath::Boolean->True;
  395.             }
  396.         }
  397.         else {
  398.             if ($lh_results->to_number->value >= $rh_results->to_number->value) {
  399.                 return XML::XPath::Boolean->True;
  400.             }
  401.         }
  402.         return XML::XPath::Boolean->False;
  403.     }
  404. }
  405.  
  406. sub op_gt {
  407.     my ($node, $lhs, $rhs) = @_;
  408.  
  409.     my $lh_results = $lhs->evaluate($node);
  410.     my $rh_results = $rhs->evaluate($node);
  411.     
  412.     if ($lh_results->isa('XML::XPath::NodeSet') &&
  413.         $rh_results->isa('XML::XPath::NodeSet')) {
  414.  
  415.         foreach my $lhnode ($lh_results->get_nodelist) {
  416.             foreach my $rhnode ($rh_results->get_nodelist) {
  417.                 my $lhNum = XML::XPath::Number->new($lhnode->string_value);
  418.                 my $rhNum = XML::XPath::Number->new($rhnode->string_value);
  419.                 if ($lhNum->value > $rhNum->value) {
  420.                     return XML::XPath::Boolean->True;
  421.                 }
  422.             }
  423.         }
  424.         return XML::XPath::Boolean->False;
  425.     }
  426.     elsif (($lh_results->isa('XML::XPath::NodeSet') ||
  427.             $rh_results->isa('XML::XPath::NodeSet')) &&
  428.             (!$lh_results->isa('XML::XPath::NodeSet') ||
  429.              !$rh_results->isa('XML::XPath::NodeSet'))) {
  430.         # (that says: one is a nodeset, and one is not a nodeset)
  431.  
  432.         my ($nodeset, $other);
  433.         my ($true, $false);
  434.         if ($lh_results->isa('XML::XPath::NodeSet')) {
  435.             $nodeset = $lh_results;
  436.             $other = $rh_results;
  437.             # we do this because unlike ==, these ops are direction dependant
  438.             ($false, $true) = (XML::XPath::Boolean->False, XML::XPath::Boolean->True);
  439.         }
  440.         else {
  441.             $nodeset = $rh_results;
  442.             $other = $lh_results;
  443.             # ditto above comment
  444.             ($true, $false) = (XML::XPath::Boolean->False, XML::XPath::Boolean->True);
  445.         }
  446.         
  447.         # True if and only if there is a node in the
  448.         # nodeset such that the result of performing
  449.         # the comparison on <type>(string_value($node))
  450.         # is true.
  451.         foreach my $node ($nodeset->get_nodelist) {
  452.             if ($node->to_number->value > $other->to_number->value) {
  453.                 return $true;
  454.             }
  455.         }
  456.         return $false;
  457.     }
  458.     else { # Neither is a nodeset
  459.         if ($lh_results->isa('XML::XPath::Boolean') ||
  460.             $rh_results->isa('XML::XPath::Boolean')) {
  461.             # if either is a boolean
  462.             if ($lh_results->to_boolean->value > $rh_results->to_boolean->value) {
  463.                 return XML::XPath::Boolean->True;
  464.             }
  465.         }
  466.         else {
  467.             if ($lh_results->to_number->value > $rh_results->to_number->value) {
  468.                 return XML::XPath::Boolean->True;
  469.             }
  470.         }
  471.         return XML::XPath::Boolean->False;
  472.     }
  473. }
  474.  
  475. sub op_lt {
  476.     my ($node, $lhs, $rhs) = @_;
  477.     op_gt($node, $rhs, $lhs);
  478. }
  479.  
  480. sub op_plus {
  481.     my ($node, $lhs, $rhs) = @_;
  482.     my $lh_results = $lhs->evaluate($node);
  483.     my $rh_results = $rhs->evaluate($node);
  484.     
  485.     my $result =
  486.         $lh_results->to_number->value
  487.             +
  488.         $rh_results->to_number->value
  489.             ;
  490.     return XML::XPath::Number->new($result);
  491. }
  492.  
  493. sub op_minus {
  494.     my ($node, $lhs, $rhs) = @_;
  495.     my $lh_results = $lhs->evaluate($node);
  496.     my $rh_results = $rhs->evaluate($node);
  497.     
  498.     my $result =
  499.         $lh_results->to_number->value
  500.             -
  501.         $rh_results->to_number->value
  502.             ;
  503.     return XML::XPath::Number->new($result);
  504. }
  505.  
  506. sub op_div {
  507.     my ($node, $lhs, $rhs) = @_;
  508.     my $lh_results = $lhs->evaluate($node);
  509.     my $rh_results = $rhs->evaluate($node);
  510.  
  511.     my $result = eval {
  512.         $lh_results->to_number->value
  513.             /
  514.         $rh_results->to_number->value
  515.             ;
  516.     };
  517.     if ($@) {
  518.         # assume divide by zero
  519.         # This is probably a terrible way to handle this! 
  520.         # Ah well... who wants to live forever...
  521.         return XML::XPath::Literal->new('Infinity');
  522.     }
  523.     return XML::XPath::Number->new($result);
  524. }
  525.  
  526. sub op_mod {
  527.     my ($node, $lhs, $rhs) = @_;
  528.     my $lh_results = $lhs->evaluate($node);
  529.     my $rh_results = $rhs->evaluate($node);
  530.     
  531.     my $result =
  532.         $lh_results->to_number->value
  533.             %
  534.         $rh_results->to_number->value
  535.             ;
  536.     return XML::XPath::Number->new($result);
  537. }
  538.  
  539. sub op_mult {
  540.     my ($node, $lhs, $rhs) = @_;
  541.     my $lh_results = $lhs->evaluate($node);
  542.     my $rh_results = $rhs->evaluate($node);
  543.     
  544.     my $result =
  545.         $lh_results->to_number->value
  546.             *
  547.         $rh_results->to_number->value
  548.             ;
  549.     return XML::XPath::Number->new($result);
  550. }
  551.  
  552. sub op_union {
  553.     my ($node, $lhs, $rhs) = @_;
  554.     my $lh_result = $lhs->evaluate($node);
  555.     my $rh_result = $rhs->evaluate($node);
  556.     
  557.     if ($lh_result->isa('XML::XPath::NodeSet') &&
  558.             $rh_result->isa('XML::XPath::NodeSet')) {
  559.         my %found;
  560.         my $results = XML::XPath::NodeSet->new;
  561.         foreach my $lhnode ($lh_result->get_nodelist) {
  562.             $found{"$lhnode"}++;
  563.             $results->push($lhnode);
  564.         }
  565.         foreach my $rhnode ($rh_result->get_nodelist) {
  566.             $results->push($rhnode)
  567.                     unless exists $found{"$rhnode"};
  568.         }
  569.                 $results->sort;
  570.         return $results;
  571.     }
  572.     die "Both sides of a union must be Node Sets\n";
  573. }
  574.  
  575. sub filter_by_predicate {
  576.     my $self = shift;
  577.     my ($nodeset, $predicate) = @_;
  578.     
  579.     # See spec section 2.4, paragraphs 2 & 3:
  580.     # For each node in the node-set to be filtered, the predicate Expr
  581.     # is evaluated with that node as the context node, with the number
  582.     # of nodes in the node set as the context size, and with the
  583.     # proximity position of the node in the node set with respect to
  584.     # the axis as the context position.
  585.     
  586.     if (!ref($nodeset)) { # use ref because nodeset has a bool context
  587.         die "No nodeset!!!";
  588.     }
  589.     
  590. #    warn "Filter by predicate: $predicate\n";
  591.     
  592.     my $newset = XML::XPath::NodeSet->new();
  593.     
  594.     for(my $i = 1; $i <= $nodeset->size; $i++) {
  595.         # set context set each time 'cos a loc-path in the expr could change it
  596.         $self->{pp}->set_context_set($nodeset);
  597.         $self->{pp}->set_context_pos($i);
  598.         my $result = $predicate->evaluate($nodeset->get_node($i));
  599.         if ($result->isa('XML::XPath::Boolean')) {
  600.             if ($result->value) {
  601.                 $newset->push($nodeset->get_node($i));
  602.             }
  603.         }
  604.         elsif ($result->isa('XML::XPath::Number')) {
  605.             if ($result->value == $i) {
  606.                 $newset->push($nodeset->get_node($i));
  607.             }
  608.         }
  609.         else {
  610.             if ($result->to_boolean->value) {
  611.                 $newset->push($nodeset->get_node($i));
  612.             }
  613.         }
  614.     }
  615.     
  616.     return $newset;
  617. }
  618.  
  619. 1;
  620.