[Bio] / KBaseTutorials / index_dbd_terms.pl Repository:
ViewVC logotype

Diff of /KBaseTutorials/index_dbd_terms.pl

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1, Tue Jun 12 18:30:20 2012 UTC revision 1.2, Wed Jun 13 21:09:01 2012 UTC
# Line 1  Line 1 
1  use strict;  use strict;
2  use Data::Dumper;  use Data::Dumper;
3    use File::Copy;
4  use Getopt::Long;  use Getopt::Long;
5  use XML::LibXML;  use XML::LibXML;
6    use HTML::TreeBuilder;
7    
8  #/home/parrello/CdmiData/Published/KSaplingDBD.xml  #/home/parrello/CdmiData/Published/KSaplingDBD.xml
9    
# Line 32  Line 33 
33    
34  my $term_ctr = 1;  my $term_ctr = 1;
35    
36    my $terms_re = join("|", map { my $x = quotemeta $_; "(?:$x)"  } sort { length($b) <=> length($a) }  keys %terms);
37    
38  open(ORDER, "<", "ORDER") or die "cannot open ORDER: $!";  open(ORDER, "<", "ORDER") or die "cannot open ORDER: $!";
39    
# Line 39  Line 41 
41  chomp @dirs;  chomp @dirs;
42  close(ORDER);  close(ORDER);
43    
44    copy("ORDER", "$dest/ORDER");
45    
46  my @files;  my @files;
47    
48  for my $dir (@dirs) {  for my $dir (@dirs) {
49          unless(-d "$dest/$dir"){          unless(-d "$dest/$dir"){
50              mkdir "$dest/$dir" or die "cannot make dir $dir: $!";              mkdir "$dest/$dir" or die "cannot make dir $dir: $!";
# Line 47  Line 52 
52    
53          @files = find_files($dir);          @files = find_files($dir);
54    
55        my %seen;
56          for my $html (@files) {          for my $html (@files) {
57    
58            my $tree = HTML::TreeBuilder->new;
59            $tree->parse_file("$dir/$html");
60            $tree->objectify_text;
61    
62            my $title;
63            my $cur_h2 = "Here";
64            $tree->root->traverse([sub {
65                my($h) = @_;
66    
67                if (!ref($h))
68                {
69                    return 0;
70                }
71                if ($h->tag eq 'h1')
72                {
73                    my $hx = $h->clone;
74                    $hx->deobjectify_text;
75                    $title = $hx->as_text;
76                    $hx->delete;
77                    return 0;
78                }
79    
80                if ($h->tag eq 'h2')
81                {
82                    my $hx = $h->clone;
83                    $hx->deobjectify_text;
84                    $cur_h2 = $hx->as_text;
85                    $hx->delete;
86                    # print STDERR "got h2 $cur_h2\n";
87    
88                    return 0;
89                }
90                elsif ($h->tag ne '~text')
91                {
92                    return 1;
93                }
94    
95                if ($h->parent->tag =~ /^(pre|h)/)
96                {
97                    return 0;
98                }
99                my $t = $h->attr("text");
100                # print STDERR "Process '$t'\n";
101    
102                #
103                # We need to process names inside links specially. Here,
104                # we just add name= to the link instead of replacing the text.
105                #
106                my $inside_link;
107                if ($h->parent->tag eq 'a')
108                {
109                    $inside_link = 1;
110                }
111    
112                my @new;
113                my $last = 0;
114                while ($t =~ /\b($terms_re)\b/gc)
115                {
116                    my $term = $1;
117                    # print "'$1'\n";
118                    my $ms = $-[0];
119                    my $me = $+[0];
120                    my $xx = substr($t, $last, ($ms - $last));
121                    $last = $me;
122                    # print "$ms $me '$xx'\n";
123    
124                    my $v = $term_ctr++;
125    
126                    if ($inside_link)
127                    {
128                        $h->parent->attr(name => "$term$v");
129                    }
130                    else
131                    {
132                        my $ne = HTML::Element->new("~text", text => $xx);
133                        push(@new, $ne);
134                        my $ne = HTML::Element->new("a", name => "$term$v");
135                        $ne->push_content($term);
136                        push(@new, $ne);
137                    }
138                    print join("\t", $title, "$dir/$html", $cur_h2, $term, "$term$v"), "\n";
139                }
140                my $xx = substr($t, $last);
141                #print "'$xx'\n";
142                if (!$inside_link)
143                {
144                    if ($xx)
145                    {
146                        my $ne = HTML::Element->new("~text", text => $xx);
147                        push(@new, $ne);
148                    }
149                    $h->replace_with(@new);
150                }
151                return 0;
152            }, undef]);
153    
154            if (0) {
155            for my $h ($tree->look_down('_tag', '~text'))
156            {
157                if ($h->parent->tag =~ /^(pre|h)/)
158                {
159                    next;
160                }
161                my $t = $h->attr("text");
162                # print STDERR "Process '$t'\n";
163    
164                my $h2_txt = "Here";
165                my $h2 = $h->look_up('_tag', 'h2');
166                if ($h2)
167                {
168                    $h2 = $h2->clone;
169                    $h2->deobjectify_text;
170                    $h2_txt = $h2->as_text;
171                    #$h2->dump(\*STDERR);
172                    #print STDERR "got h2 txt $h2_txt\n";
173                }
174                else
175                {
176                    print STDERR "No h2 for $html ";
177                    $h->dump(\*STDERR);
178                }
179    
180                my @new;
181                my $last = 0;
182                while ($t =~ /\b($terms_re)\b/gc)
183                {
184                    my $term = $1;
185                    # print "'$1'\n";
186                    my $ms = $-[0];
187                    my $me = $+[0];
188                    my $xx = substr($t, $last, ($ms - $last));
189                    $last = $me;
190                    # print "$ms $me '$xx'\n";
191    
192                    my $ne = HTML::Element->new("~text", text => $xx);
193                    push(@new, $ne);
194                    my $v = $term_ctr++;
195                    my $ne = HTML::Element->new("a", name => "$term$v");
196                    $ne->push_content($term);
197                    push(@new, $ne);
198                    print join("\t", $title, "$dir/$html", $h2_txt, $term, "$term$v"), "\n";
199                }
200                my $xx = substr($t, $last);
201                #print "'$xx'\n";
202                if ($xx)
203                {
204                    my $ne = HTML::Element->new("~text", text => $xx);
205                    push(@new, $ne);
206                }
207                $h->replace_with(@new);
208            }}
209            $tree->deobjectify_text();
210    
211            open (T, ">", "$dest/$dir/$html") or die "cannot open $html: $!";
212    
213            my $body = $tree->look_down("_tag", "body");
214            if ($body)
215            {
216                for my $c ($body->content_list)
217                {
218                    if (ref($c))
219                    {
220                        print T $c->as_HTML(undef, ' ');
221                    }
222                    else
223                    {
224                        print T $c;
225                    }
226                }
227            }
228            else
229            {
230                print T $tree->as_HTML(undef, '  ');
231            }
232            close(T);
233    
234            $seen{$html}++;
235    
236            next;
237                  my $h2 = "Here";                  my $h2 = "Here";
238                  my $title = get_title("$dir/$html");                  my $title = get_title("$dir/$html");
239                  open(F, "<", "$dir/$html") or die "Cannot open $html: $!";                  open(F, "<", "$dir/$html") or die "Cannot open $html: $!";
# Line 65  Line 251 
251                          print T $x;                          print T $x;
252                  }                  }
253          }          }
254        opendir(D, $dir) or die "Cannot opendir $dir: $!";
255        for my $f (grep { -f "$dir/$_" && ! $seen{$_} && !/~$/ && !/^\#/  && !/^\./ } readdir(D))
256        {
257            print STDERR "Copy $dir $f\n";
258            copy("$dir/$f", "$dest/$dir/$f");
259        }
260  }  }
261    
262    

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3