Dont warn character 0x00 in Expat Encoding Handler
[idzebra-moved-to-github.git] / perl / demo / pod.pm
1 #!/usr/bin/perl
2 use strict;
3 # ----------------------------------------------------------------------------
4 # A dummy example to demonstrate perl filters for zebra. This is going to
5 # extract information from the .pm perl module files.
6 # ----------------------------------------------------------------------------
7 package pod;
8
9 use IDZebra::Filter;
10 use IDZebra::Data1;
11 use Pod::Text;
12 use Symbol qw(gensym);
13 our @ISA=qw(IDZebra::Filter);
14 1;
15
16
17 sub init {
18     # Initialization code may come here
19 }
20
21 sub process {
22     my ($self, $d1) = @_;
23
24     my $tempfile_in = "/tmp/strucc.in";
25     my $tempfile_out = "/tmp/strucc.out";
26     my $parser = Pod::Text->new (sentence => 0, width => 78);
27
28     my $r1=$d1->mk_root('pod');    
29     my $root=$d1->mk_tag($r1,'pod');
30
31     # Get the input "file handle"
32     my $inf = $self->get_fh;
33
34     # Create a funny output "file handle"
35     my $outf = gensym;
36     tie (*$outf,'MemFile');
37
38     $parser->parse_from_filehandle ($inf, $outf);
39
40     my $section;
41     my $data;
42     while(<$outf>) {
43         chomp;
44         if (/^([A-Z]+)\s*$/) {
45             my $ss = $1;
46             if ($section) {
47                 my $tag = $d1->mk_tag($root,$section);
48                 $d1->mk_text($tag,$data) if ($data);
49             }
50             $section = $ss;
51             $data = "";
52             next;
53         }
54         s/^\s+|\s+$//g;
55         $data.="$_\n";
56     }
57
58     if ($section) { 
59         my $tag = $d1->mk_tag($root,$section);
60         $d1->mk_text($tag,$data) if ($data);
61     }
62     return ($r1);
63 }
64
65 # ----------------------------------------------------------------------------
66 # Package to collect data as an output file from stupid modules, who can only
67 # write to files...
68 # ----------------------------------------------------------------------------
69 package MemFile;
70
71 sub TIEHANDLE {
72     my $class = shift;
73     my $self = {};
74     bless ($self,$class);
75     $self->{buff} = "";
76     return ($self);
77 }
78
79 sub PRINT {
80     my $self = shift;
81     for (@_) {
82         $self->{buff} .= $_;
83     }
84 }
85
86 sub READLINE {
87     my $self = shift;
88     my $res;
89     return (undef) unless ($self->{buff});
90     ($res,$self->{buff}) = split (/\n/,$self->{buff},2);
91     return ($res."\n");
92 }