Mercurial > hg > lukkari
annotate parsedata.pl @ 33:ad96ed91de92
Fix recursive parsing with attributes.
| author | Matti Hamalainen <ccr@tnsp.org> |
|---|---|
| date | Mon, 31 Oct 2011 09:31:14 +0200 |
| parents | b305d409becd |
| children | bb00a40252e2 |
| rev | line source |
|---|---|
| 1 | 1 #!/usr/bin/perl -w |
| 2 # | |
| 3 # Fetch and parse HTML format class timetable into more sane formats | |
| 32 | 4 # (C) Copyright 2010-2011 Matti Hämäläinen <ccr@tnsp.org> |
| 1 | 5 # |
| 6 use strict; | |
| 7 use Data::Dumper; | |
| 8 use HTML::Entities; | |
| 9 | |
| 10 | |
| 11 sub urlencode($) | |
| 12 { | |
| 13 my $value = $_[0]; | |
| 14 $value =~ s/([^a-zA-Z_0-9 ])/"%" . uc(sprintf "%lx" , unpack("C", $1))/eg; | |
| 15 $value =~ tr/ /+/; | |
| 16 return $value; | |
| 17 } | |
| 18 | |
| 19 | |
| 20 sub str_trim($) | |
| 21 { | |
| 22 my $str = $_[0]; | |
| 23 if (defined($str)) { | |
| 24 $str =~ s/^\s*//; | |
| 25 $str =~ s/\s*$//; | |
| 26 } | |
| 27 return $str; | |
| 28 } | |
| 29 | |
| 30 | |
| 31 sub pop_token_a($) | |
| 32 { | |
| 33 my $tokens = $_[0]; | |
| 34 return shift(@$tokens); | |
| 35 } | |
| 36 | |
| 37 | |
| 38 sub pop_token($) | |
| 39 { | |
| 40 return str_trim(pop_token_a($_[0])); | |
| 41 } | |
| 42 | |
| 43 | |
| 44 sub parse_html_str($) | |
| 45 { | |
| 46 my $tokens = $_[0]; | |
| 47 my $token = pop_token($tokens); | |
| 48 my $str = ""; | |
| 49 $token =~ s/^\s*//; | |
| 50 | |
| 51 return undef unless (substr($token, 0, 1) eq '"'); | |
| 52 $token = substr($token, 1); | |
| 53 | |
| 54 while (defined($token)) { | |
| 26 | 55 my $tmp = $token; |
|
25
a076d8d22422
Fix string parsing in the HTML parser.
Matti Hamalainen <ccr@tnsp.org>
parents:
8
diff
changeset
|
56 $tmp =~ s/\s*$//; |
|
a076d8d22422
Fix string parsing in the HTML parser.
Matti Hamalainen <ccr@tnsp.org>
parents:
8
diff
changeset
|
57 if (substr($tmp, -1) eq '"') { |
|
a076d8d22422
Fix string parsing in the HTML parser.
Matti Hamalainen <ccr@tnsp.org>
parents:
8
diff
changeset
|
58 $str .= substr($tmp, 0, -1); |
| 1 | 59 return $str; |
| 60 } else { | |
| 61 $str .= $token; | |
| 62 } | |
| 63 $token = shift(@$tokens); | |
| 64 } | |
| 65 return undef; | |
| 66 } | |
| 67 | |
| 68 | |
| 69 sub parse_html_tree($$); | |
| 70 | |
| 71 sub parse_html_tree($$) | |
| 72 { | |
| 73 my ($tokens, $tree) = @_; | |
| 74 | |
| 75 while (my $token = pop_token($tokens)) { | |
| 76 if ($token =~ /^<[!\/]?[a-zA-Z]+/) { | |
| 77 $token = lc($token); | |
| 78 if ($token =~ /^<\!.*>$/) { | |
| 79 # Ignore comments etc. | |
| 80 } elsif ($token =~ /^<([a-z]+)(.*)>$/) { | |
| 81 my ($name, $args) = ($1, $2); | |
| 82 if ($name eq "meta" || $name eq "img") { | |
| 83 my $tmp = {}; | |
| 84 parse_html_tree($tokens, $tree); | |
| 85 return $tree; | |
| 86 } else { | |
| 87 my $tmp = { "name" => $name, "args" => str_trim($args) }; | |
| 88 parse_html_tree($tokens, $tmp); | |
| 89 push(@{$$tree{"nodes"}}, $tmp); | |
| 90 } | |
| 91 } elsif ($token =~ /^<\/([a-z]+)>$/) { | |
| 92 return $tree; | |
| 93 } else { | |
| 94 die("HORROR TERROR ELITE: $token\n"); | |
| 95 } | |
| 96 } else { | |
| 97 $token = str_trim(decode_entities($token)); | |
| 98 push(@{$$tree{"nodes"}}, { "name" => "text", "args" => "", "text" => $token }) if length($token) > 0; | |
| 99 } | |
| 100 } | |
| 101 | |
| 102 return $tree; | |
| 103 } | |
| 104 | |
| 105 | |
| 106 sub parse_html($) | |
| 107 { | |
| 108 return undef unless defined($_[0]); | |
| 109 my $str = $_[0]; | |
| 110 my $res = { "name" => "", "args" => "" }; | |
| 111 $str =~ tr/\r/ /; | |
| 112 $str =~ tr/\n/ /; | |
| 113 my @tokens = grep { !($_ =~ /^\s*$/) } split(/(<\/?[a-zA-Z]+.*?>)/, $str); | |
| 114 parse_html_tree(\@tokens, $res); | |
| 115 return $res; | |
| 116 } | |
| 117 | |
| 118 sub html_find_node($$$); | |
| 119 | |
| 120 sub html_find_node($$$) | |
| 121 { | |
| 122 my ($node, $name, $args) = @_; | |
| 123 | |
| 124 if (defined($node)) { | |
| 125 if (ref($node) eq "ARRAY") { | |
| 126 foreach my $n (@$node) { | |
| 127 my $tmp = html_find_node($n, $name, $args); | |
| 128 # Must do it like this, in order not to break the loop | |
| 129 return $tmp if defined($tmp); | |
| 130 } | |
| 131 } elsif (ref($node) eq "HASH") { | |
| 132 if (defined($$node{"name"})) { | |
| 133 if ($$node{"name"} eq $name) { | |
| 134 if ($args ne "") { | |
| 135 if (defined($$node{"args"}) && $$node{"args"} =~ /$args/) { | |
| 136 } else { | |
|
33
ad96ed91de92
Fix recursive parsing with attributes.
Matti Hamalainen <ccr@tnsp.org>
parents:
32
diff
changeset
|
137 return html_find_node($$node{"nodes"}, $name, $args); |
| 1 | 138 } |
| 139 } | |
| 140 return $node; | |
| 141 } else { | |
| 142 return html_find_node($$node{"nodes"}, $name, $args); | |
| 143 } | |
| 144 } | |
| 145 } | |
| 146 } | |
| 147 return undef; | |
| 148 } | |
| 149 | |
| 150 | |
| 151 sub fnode($$) | |
| 152 { | |
| 153 return html_find_node($_[0], $_[1], ""); | |
| 154 } | |
| 155 | |
| 156 | |
| 157 sub fnodea($$$) | |
| 158 { | |
| 159 return html_find_node($_[0], $_[1], $_[2]); | |
| 160 } | |
| 161 | |
| 162 | |
| 163 sub escape($) | |
| 164 { | |
| 165 my $s = $_[0]; | |
| 166 $s =~ s/(['"])/\\$1/g; | |
| 167 return $s; | |
| 168 } | |
| 169 | |
| 170 | |
| 171 sub html_collapse($$); | |
| 172 | |
| 173 sub html_collapse($$) | |
| 174 { | |
| 175 my ($node, $strip) = @_; | |
| 176 my $str = ""; | |
| 177 | |
| 178 if ($$node{"name"} eq "text") { | |
| 179 $str .= $$node{"text"}; | |
| 180 } else { | |
| 181 $str .= "<".$$node{"name"}.">" unless ($strip); | |
| 182 foreach my $n (@{$$node{"nodes"}}) { | |
| 183 $str .= html_collapse($n, $strip); | |
| 184 } | |
| 185 $str .= "</".$$node{"name"}.">" unless ($strip); | |
| 186 } | |
| 187 | |
| 188 return $str; | |
| 189 } | |
| 190 | |
| 191 | |
| 192 ### | |
| 193 ### Main program | |
| 194 ### | |
| 195 my $modes = "simple|php|xml"; | |
| 196 my $opt_mode = "php"; | |
| 197 my $opt_dump = 0; | |
| 198 my $opt_filename; | |
| 199 my $opt_outfile; | |
| 200 | |
| 201 while (defined(my $arg = shift)) { | |
| 202 if (substr($arg, 0, 1) eq "-") { | |
| 203 if ($arg =~ /^-($modes)$/o) { | |
| 204 $opt_mode = $1; | |
| 205 } | |
| 206 elsif ($arg eq "-dump") { | |
| 207 $opt_dump = 1; | |
| 208 } | |
| 209 elsif ($arg eq "-o") { | |
| 210 $opt_outfile = shift or die("Output filename option -o requires an argument.\n"); | |
| 211 } else { | |
| 212 die("Invalid option '$arg'.\n"); | |
| 213 } | |
| 214 } else { | |
| 215 $opt_filename = $arg; | |
| 216 } | |
| 217 } | |
| 218 | |
|
4
dd2bce7ec0c8
Removed http fetching feature, it's not really useful here.
Matti Hamalainen <ccr@tnsp.org>
parents:
3
diff
changeset
|
219 die("Usage: $0 [options] <filename> |
| 1 | 220 |
| 221 -php Output a PHP include file with data in arrays (default) | |
| 222 -simple Output simple tabled output for easy parsing. | |
| 223 -xml Output XML. | |
| 224 | |
| 225 -o <filename> Set output filename. Default is to use stdout. | |
| 226 | |
| 227 -dump Dump HTML tree to stdout and quit. | |
| 228 | |
| 229 ") unless defined($opt_filename); | |
| 230 | |
| 231 | |
| 232 my $data; | |
|
4
dd2bce7ec0c8
Removed http fetching feature, it's not really useful here.
Matti Hamalainen <ccr@tnsp.org>
parents:
3
diff
changeset
|
233 open(my $fh, '<', $opt_filename) or die("Error opening '$opt_filename': $!\n"); |
|
dd2bce7ec0c8
Removed http fetching feature, it's not really useful here.
Matti Hamalainen <ccr@tnsp.org>
parents:
3
diff
changeset
|
234 $data = do { local $/; <$fh> }; |
|
dd2bce7ec0c8
Removed http fetching feature, it's not really useful here.
Matti Hamalainen <ccr@tnsp.org>
parents:
3
diff
changeset
|
235 close($fh); |
| 1 | 236 |
| 237 die("No data in input.\n") unless (defined($data) && $data ne ""); | |
| 238 | |
| 239 | |
| 240 # Filter out certain unneeded elements | |
| 241 $data =~ s/<font[^>]*>//ig; | |
| 242 $data =~ s/<\/font>//ig; | |
| 243 $data =~ s/<\/?center>//ig; | |
| 244 $data =~ s/<br>//ig; | |
| 245 $data =~ s/ / /ig; | |
| 246 | |
| 247 ### Get some general information | |
| 248 my $otree = parse_html($data); | |
| 249 if ($opt_dump) { | |
| 250 print Dumper(fnode($otree, "html")); | |
| 251 exit; | |
| 252 } | |
| 253 | |
| 254 my %class = (); | |
| 255 my $body = fnode($otree, "body"); | |
| 256 if (defined($body) && defined($$body{"nodes"})) { | |
| 257 foreach my $n (@{$$body{"nodes"}}) { | |
| 258 if ($$n{"name"} eq "text") { | |
| 259 push(@{$class{"info"}}, $$n{"text"}); | |
| 260 } | |
| 261 elsif ($$n{"name"} eq "b") { | |
| 262 push(@{$class{"data"}}, $n); | |
| 263 } | |
| 264 } | |
| 265 } | |
| 266 | |
| 267 # Filter out some more, for easier tree access during table parsing | |
| 268 $data =~ s/<\/?b>//ig; | |
| 269 my $tree = parse_html($data); | |
| 270 my $node = fnode(fnode($tree, "body"), "table"); | |
| 271 die("No table element found in document. Perhaps the format has changed? :(\n") unless defined($node); | |
| 272 | |
| 273 ### Parse through the HTML document node tree to find the data we need | |
| 274 my $id = 0; | |
| 275 my $q = $$node{"nodes"}; | |
| 276 my $tunnit = {}; | |
| 277 my $taulu = {}; | |
| 278 my $maxdays = 6; | |
| 279 my $maxhours = 0; | |
| 280 | |
|
8
a52a0bdb5ea1
Crop off empty hours (time slots) and days.
Matti Hamalainen <ccr@tnsp.org>
parents:
4
diff
changeset
|
281 # Skip zero position this way (can't use foreach here) |
| 1 | 282 for (my $i = 1; $i < scalar(@{$q}); $i++) { |
| 283 my $d = $$q[$i]{"nodes"}; | |
| 284 if (defined($d)) { | |
| 285 foreach my $n (@{$d}) { | |
| 286 my $l = $$n{"nodes"}[0]{"nodes"}; | |
| 287 if (defined($l) && $$n{"args"} =~ /colspan=6\s+rowspan=(\d+)/) { | |
| 288 my $tuntia = $1 / 2; | |
| 289 my $data = []; | |
| 290 my $grouped = 0; | |
| 291 foreach my $h (@{$l}) { | |
| 292 if (defined($$h{"nodes"})) { | |
| 293 foreach my $b (@{$$h{"nodes"}}) { | |
| 294 if (defined($$b{"nodes"})) { | |
| 295 my $text = $$b{"nodes"}[0]{"text"}; | |
| 296 $text =~ s/\.$//; | |
| 297 | |
| 298 $grouped = 1 if ($text =~ /vuorov/); | |
| 299 | |
| 300 push(@$data, $text); | |
| 301 } | |
| 302 } | |
| 303 } | |
| 304 } | |
| 305 | |
| 306 my $tid; | |
| 307 if (scalar(@$data) > 0) { | |
| 308 $id++; | |
| 309 $tid = $id; | |
| 310 } else { | |
| 311 $tid = 0; | |
| 312 } | |
| 313 | |
| 314 my $tpd = 0; | |
| 315 for (my $x = 0; $x < $maxdays; $x++) { | |
| 316 if (!defined($$taulu{$maxhours}{$x})) { | |
| 317 $tpd = $x; | |
| 318 last; | |
| 319 } | |
| 320 } | |
| 321 for (my $t = 0; $t < $tuntia; $t++) { | |
| 322 $$taulu{$maxhours + $t}{$tpd} = $tid; | |
| 323 } | |
| 324 | |
| 325 if (scalar(@$data) > 0) { | |
| 326 # Grouped, if there is another class ID in second slot | |
| 327 $grouped = 1 if ($$data[1] =~ /^[A-Z]\d{6}$/); | |
| 328 $$tunnit{$id} = { "grouped" => $grouped, "day" => $tpd, "start" => $maxhours, "hours" => $tuntia, "data" => $data }; | |
| 329 } | |
| 330 } | |
| 331 } | |
| 332 $maxhours++; | |
| 333 } | |
| 334 } | |
| 335 | |
| 336 | |
|
8
a52a0bdb5ea1
Crop off empty hours (time slots) and days.
Matti Hamalainen <ccr@tnsp.org>
parents:
4
diff
changeset
|
337 ### Go through hour table, find last day and hour of the week, crop |
|
a52a0bdb5ea1
Crop off empty hours (time slots) and days.
Matti Hamalainen <ccr@tnsp.org>
parents:
4
diff
changeset
|
338 my $flag = 1; |
|
a52a0bdb5ea1
Crop off empty hours (time slots) and days.
Matti Hamalainen <ccr@tnsp.org>
parents:
4
diff
changeset
|
339 for (my $y = $maxhours - 1; $y >= 0 && $flag; $y--) { |
|
a52a0bdb5ea1
Crop off empty hours (time slots) and days.
Matti Hamalainen <ccr@tnsp.org>
parents:
4
diff
changeset
|
340 for (my $x = 0; $x < $maxdays && $flag; $x++) { |
|
a52a0bdb5ea1
Crop off empty hours (time slots) and days.
Matti Hamalainen <ccr@tnsp.org>
parents:
4
diff
changeset
|
341 $flag = 0 if (defined($$taulu{$y}{$x}) && $$taulu{$y}{$x} != 0); |
|
a52a0bdb5ea1
Crop off empty hours (time slots) and days.
Matti Hamalainen <ccr@tnsp.org>
parents:
4
diff
changeset
|
342 } |
|
a52a0bdb5ea1
Crop off empty hours (time slots) and days.
Matti Hamalainen <ccr@tnsp.org>
parents:
4
diff
changeset
|
343 $maxhours-- if ($flag); |
|
a52a0bdb5ea1
Crop off empty hours (time slots) and days.
Matti Hamalainen <ccr@tnsp.org>
parents:
4
diff
changeset
|
344 } |
|
a52a0bdb5ea1
Crop off empty hours (time slots) and days.
Matti Hamalainen <ccr@tnsp.org>
parents:
4
diff
changeset
|
345 |
|
a52a0bdb5ea1
Crop off empty hours (time slots) and days.
Matti Hamalainen <ccr@tnsp.org>
parents:
4
diff
changeset
|
346 $flag = 1; |
|
a52a0bdb5ea1
Crop off empty hours (time slots) and days.
Matti Hamalainen <ccr@tnsp.org>
parents:
4
diff
changeset
|
347 for (my $x = $maxdays - 1; $x >= 0 && $flag; $x--) { |
|
a52a0bdb5ea1
Crop off empty hours (time slots) and days.
Matti Hamalainen <ccr@tnsp.org>
parents:
4
diff
changeset
|
348 for (my $y = 0; $y < $maxhours && $flag; $y++) { |
|
a52a0bdb5ea1
Crop off empty hours (time slots) and days.
Matti Hamalainen <ccr@tnsp.org>
parents:
4
diff
changeset
|
349 $flag = 0 if (defined($$taulu{$y}{$x}) && $$taulu{$y}{$x} != 0); |
|
a52a0bdb5ea1
Crop off empty hours (time slots) and days.
Matti Hamalainen <ccr@tnsp.org>
parents:
4
diff
changeset
|
350 } |
|
a52a0bdb5ea1
Crop off empty hours (time slots) and days.
Matti Hamalainen <ccr@tnsp.org>
parents:
4
diff
changeset
|
351 $maxdays-- if ($flag); |
|
a52a0bdb5ea1
Crop off empty hours (time slots) and days.
Matti Hamalainen <ccr@tnsp.org>
parents:
4
diff
changeset
|
352 } |
|
a52a0bdb5ea1
Crop off empty hours (time slots) and days.
Matti Hamalainen <ccr@tnsp.org>
parents:
4
diff
changeset
|
353 |
|
a52a0bdb5ea1
Crop off empty hours (time slots) and days.
Matti Hamalainen <ccr@tnsp.org>
parents:
4
diff
changeset
|
354 |
| 1 | 355 ### Open output file, if specified |
| 356 if (defined($opt_outfile)) { | |
| 357 open(STDOUT, '>', $opt_outfile) or die("Could not open output file '$opt_outfile'.\n"); | |
| 358 } | |
| 359 | |
| 360 | |
| 361 ### Output data in desired format | |
| 362 if ($opt_mode eq "php") { | |
| 363 print "<?\n". | |
| 364 "\$classInfo = array(\n". | |
| 365 " \"general\" => array(".join(", ", map { "\"".escape($_)."\""; } @{$class{"info"}})."),\n". | |
| 366 " \"info\" => array(".join(", ", map { "\"".escape(html_collapse($_, 1))."\""; } @{$class{"data"}})."),\n". | |
| 367 " \"info_tags\" => array(".join(", ", map { "\"".escape(html_collapse($_, 0))."\""; } @{$class{"data"}})."),\n". | |
| 368 " \"maxdays\" => $maxdays,\n". | |
| 369 " \"maxhours\" => $maxhours,\n". | |
| 370 ");\n\n"; | |
| 371 | |
| 372 print "\$classDefs = array(\n"; | |
| 373 foreach my $id (sort { $a <=> $b } keys %{$tunnit}) { | |
| 374 print " $id => array("; | |
| 375 foreach my $key (keys %{$$tunnit{$id}}) { | |
| 376 my $a = $$tunnit{$id}{$key}; | |
| 377 print "\"$key\" => "; | |
| 378 if (ref($a) eq "ARRAY") { | |
| 379 print "array(".join(", ", map { "\"".escape($_)."\""; } @$a).")"; | |
| 380 } | |
| 381 elsif ($a =~ /^\d+$/) { | |
| 382 print $a; | |
| 383 } else { | |
| 384 print "\"".escape($a)."\""; | |
| 385 } | |
| 386 print ", "; | |
| 387 } | |
| 388 print "),\n"; | |
| 389 } | |
| 390 | |
| 391 print ");\n". | |
| 392 "\n". | |
| 393 "\$classHourTable = array(\n"; | |
| 394 for (my $y = 0; $y < $maxhours; $y++) { | |
| 395 my $str = ""; | |
| 396 for (my $x = 0; $x < $maxdays; $x++) { | |
| 397 $str .= ", " unless ($str eq ""); | |
| 398 $str .= sprintf "%3d", $$taulu{$y}{$x}; | |
| 399 } | |
| 400 print " array(".$str."),\n"; | |
| 401 } | |
| 402 print ");\n?>\n"; | |
| 403 } | |
| 404 | |
| 405 elsif ($opt_mode eq "xml") { | |
| 406 print "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n". | |
| 407 "<timetable>\n". | |
| 408 " <class>\n". | |
| 409 " <general>".join("", map { "<node>".encode_entities($_)."</node>"; } @{$class{"info"}})."</general>\n". | |
| 410 " <info>".join("", map { "<node>".encode_entities(html_collapse($_, 1))."</node>"; } @{$class{"data"}})."</info>\n". | |
| 411 " <maxdays>$maxdays</maxdays>\n". | |
| 412 " <maxhours>$maxhours</maxhours>\n". | |
| 413 " </class>\n"; | |
| 414 | |
| 415 | |
| 416 print "</timetable>\n"; | |
| 417 } | |
| 418 | |
| 419 elsif ($opt_mode eq "simple") { | |
| 420 for (my $y = 0; $y < $maxhours; $y++) { | |
| 421 for (my $x = 0; $x < $maxdays; $x++) { | |
| 422 printf "%3d ", $$taulu{$y}{$x}; | |
| 423 } | |
| 424 print "\n"; | |
| 425 } | |
| 426 } | |
| 427 | |
| 428 close (STDOUT); |