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

Annotation of /KBaseTutorials/index_dbd_terms.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (view) (download) (as text)

1 : disz 1.1 use strict;
2 :     use Data::Dumper;
3 : olson 1.2 use File::Copy;
4 : disz 1.1 use Getopt::Long;
5 :     use XML::LibXML;
6 : olson 1.2 use HTML::TreeBuilder;
7 : disz 1.1
8 :     #/home/parrello/CdmiData/Published/KSaplingDBD.xml
9 :    
10 :     @ARGV == 2 or die "Usage: $0 DBD-xml-file destination_dir < terms\n";
11 :    
12 :     my $in_file = shift;
13 :     my $dest = shift;
14 :     my %terms;
15 :     my $doc = XML::LibXML->new->parse_file($in_file);
16 :     $doc or die "cannot parse $in_file\n";
17 :    
18 :     while (<>) {
19 :     chomp;
20 :     $terms{$_} = 1;
21 :     }
22 :     for my $r ($doc->findnodes('//Relationships/Relationship'))
23 :     {
24 :     my $n = $r->getAttribute("name");
25 :     $terms{$n} = 1;
26 :     }
27 :    
28 :     for my $e ($doc->findnodes('//Entities/Entity'))
29 :     {
30 :     my $n = $e->getAttribute("name");
31 :     $terms{$n} = 1;
32 :     }
33 :    
34 :     my $term_ctr = 1;
35 :    
36 : olson 1.2 my $terms_re = join("|", map { my $x = quotemeta $_; "(?:$x)" } sort { length($b) <=> length($a) } keys %terms);
37 : disz 1.1
38 :     open(ORDER, "<", "ORDER") or die "cannot open ORDER: $!";
39 :    
40 :     my @dirs = <ORDER>;
41 :     chomp @dirs;
42 :     close(ORDER);
43 :    
44 : olson 1.2 copy("ORDER", "$dest/ORDER");
45 :    
46 : disz 1.1 my @files;
47 : olson 1.2
48 : disz 1.1 for my $dir (@dirs) {
49 : olson 1.2 unless(-d "$dest/$dir"){
50 :     mkdir "$dest/$dir" or die "cannot make dir $dir: $!";
51 :     }
52 :    
53 :     @files = find_files($dir);
54 :    
55 :     my %seen;
56 :     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 : disz 1.1 }
232 : olson 1.2 close(T);
233 :    
234 :     $seen{$html}++;
235 : disz 1.1
236 : olson 1.2 next;
237 :     my $h2 = "Here";
238 :     my $title = get_title("$dir/$html");
239 :     open(F, "<", "$dir/$html") or die "Cannot open $html: $!";
240 :     open (T, ">", "$dest/$dir/$html") or die "cannot open $html: $!";
241 :     while (<F>) {
242 :     my $x = $_;
243 :     if ($x =~ m,<h2>(.*)</h2>,) {
244 :     $h2 = $1;
245 :     }
246 :     $x =~ s!(\w+)!if ($terms{$1}) {my $term = $1;
247 :     my $v= $term_ctr++;
248 :     print "$title\t$dir/$html\t$h2\t$term\t$term$v\n";
249 :     "<a name=\"$term".$v."\"> $term</a> "
250 :     } else {$1}!eg;
251 :     print T $x;
252 : disz 1.1 }
253 : olson 1.2 }
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 : disz 1.1 }
261 :    
262 :    
263 :    
264 :    
265 :     sub find_files {
266 :     # get titles too from publish_site
267 :     my($dir) = @_;
268 :     my @files;
269 :     if (open(O, "<", "$dir/ORDER"))
270 :     {
271 :     @files = <O>;
272 :     chomp @files;
273 :     close(O);
274 :     }
275 :     else
276 :     {
277 :     opendir(D, $dir) or die "cannot opendir $dir: $!";
278 :     @files = sort { $a cmp $b } grep { /\.html$/ && -f "$dir/$_" } readdir(D);
279 :     closedir(D);
280 :     }
281 :     return @files;
282 :     }
283 :     sub get_title
284 :     {
285 :     my($file) = @_;
286 :     open(F, "<", $file) or die "Cannot read $file: $!";
287 :     my $title;
288 :     while (<F>)
289 :     {
290 :     if (/<h1>(.*?)</)
291 :     {
292 :     $title = $1;
293 :     last;
294 :     }
295 :     }
296 :     close(F);
297 :     return $title;
298 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3