view release on metacpan or  search on metacpan

lib/App/Xml_grep2.pm  view on Meta::CPAN

          { my $set= $self->grep_text( $xpath, $file) or next;
            if( @$set)
              { 
                if( $need_filename) { foreach (@$set) { s{^}{$file:} } } # add filename
                print @$set;
              }
          }
        elsif( $self->{count})
          { my $nb= $self->grep_nb( $xpath, $file);
            if( !defined $nb) { next; }
            print $need_filename ? "$file:$nb\n" : "$nb\n"; 
          }
        else
          { # regular mode
            my $nodes= $self->grep_nodes( $xpath, $file) or next;
            if( @$nodes)
              { if( $header) 
                  { if( $self->{original_encoding}) 
                      { my $encoding= $nodes->[0]->ownerDocument->encoding;
                        if( $encoding) { $header=~ s{UTF-8}{$encoding}; }
                      }
                    print $header; 
                    $header= '';
                  }

                if( $need_file_wrapper)
                  { print $self->file_header( $file);
                    $self->_print_hits_in_file( 2 => $nodes);
                    print $self->file_footer(),
                          ;
                  }
                else
                  { $self->_print_hits_in_file( 1 => $nodes); }

                $got_result=1;
              }
          }         
      }
    
    if( $self->{quiet}) { return -1; }
    
    if( $header && $self->{generate_empty_set})                  { print $header; } # in case no result was found
    if( $footer && ($got_result || $self->{generate_empty_set})) { print $footer; }
    
    return 0;
  }

# the print is done here to avoid passing a potentially pretty big string around
sub _print_hits_in_file
  { my( $self, $format, $nodes)= @_;
    print map( { $self->{format} ? $self->indented_xml( $_->toString( $self->{format}, $self->{original_encoding}), $format)  . "\n"
                                                 : $_->toString( 0, $self->{original_encoding}) . "\n"
                               } @$nodes
                              );
  } 
      
sub file_list
  { my $self= shift;
    my $rules= File::Find::Rule->new;
    if( $self->{include}) { $rules->name( $self->{include});     }
    if( $self->{exclude}) { $rules->not_name( $self->{exclude}); }
    unless( $self->{recursive})   { $rules->maxdepth( 0);                }
    $rules->not_directory();
    my @files= $rules->in( @_);
    return @files;
  }


sub grep_nodes
  { my( $self, $xpath, $file)= @_;
    my( undef, @nodes)= $self->findnodes( $file => $xpath) or return ;
    if( $self->{max_count }&& (@nodes >= $self->{max_count})) { $#nodes= $self->{max_count }-1; }
    return \@nodes;
  }

sub grep_v
  { my( $self, $xpath, $file)= @_;
    my( $doc, @nodes)= $self->findnodes( $file => $xpath) or return ;
    foreach my $node (@nodes)
      { my $parent= $node->parentNode or return;
        $parent->removeChild( $node);
      }
    return $doc;
  }


sub findnodes
  { my( $self, $file, $xpath)= @_;

    my $doc;


    if( defined $file)
      { # need to test this instead of calling parse_*_file, or we get an untrappable "I/O error : Permission denied" 
        # message from XML::LibXML
        if( ! -e $file) 
          { $self->mwarn( "xml_grep2: $file: No such file or directory"); 
            return;
          } 
        elsif( ! -r $file) 
          { $self->mwarn( "xml_grep2: $file: Permission denied"); 
            return;
          } 
      }

    my( $method, @parse_args);

    if( $XML::LibXML::VERSION > 1.70 && ! $self->{xl})
      { $method    = $self->{html} ? 'load_html' : 'load_xml';
        @parse_args = defined $file ? ( location => $file) : ( IO => \*STDIN);
      }
    else
      { $method = $self->{html} ? 'parse_html' : 'parse'; 
        $method .= defined $file ? '_file' : '_fh'      ;
        @parse_args = defined $file ? $file : \*STDIN;
      }
        
    eval { $doc= $self->{parser}->$method( @parse_args); };
    if( $@) 
      { if( !$self->{no_messages}) 
          { $self->parsing_exception( $@); }
        return;
      }