source: gs3-extensions/html-to-expeditee/trunk/src/perllib/ExpediteeFrameIO.pm@ 24934

Last change on this file since 24934 was 24934, checked in by davidb, 12 years ago

Introduction of new Perl module to handle taking the JSON version of the traversed HTML tree and output it as an expeditee frame

File size: 9.0 KB
Line 
1###########################################################################
2#
3# ExpediteeFrameIO.pm --
4# A component of the Greenstone digital library software
5# from the New Zealand Digital Library Project at the
6# University of Waikato, New Zealand.
7#
8# Copyright (C) 2009 New Zealand Digital Library Project
9#
10# This program is free software; you can redistr te it and/or modify
11# it under the terms of the GNU General Public License as published by
12# the Free Software Foundation; either version 2 of the License, or
13# (at your option) any later version.
14#
15# This program is distributed in the hope that it will be useful,
16# but WITHOUT ANY WARRANTY; without even the implied warranty of
17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18# GNU General Public License for more details.
19#
20# You should have received a copy of the GNU General Public License
21# along with this program; if not, write to the Free Software
22# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
23#
24###########################################################################
25
26package ExpediteeFrameIO;
27
28use strict;
29
30sub new
31{
32 my $class = shift(@_);
33 my ($username) = shift(@_) || "greenstone";
34
35 my $self = { 'items' => [], 'lines' => [], 'constraints' => [] };
36
37 $self->{'username'} = $username;
38
39 return bless $self, $class;
40}
41
42sub getFormatedDate
43{
44 my ($opt_mode) = @_;
45
46 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
47
48 my @mabbr = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );
49
50 $year += 1900;
51
52 my $fdate;
53
54 if ((defined $opt_mode) && ($opt_mode eq "highPrecision")) {
55 $fdate = sprintf("%02d%s%04d[%02d:%0d2.%02d]",
56 $mday, $mabbr[$mon],$year,$hour,$min,$sec);
57 }
58 else {
59 $fdate = sprintf("%02d%s%04d[%02d:%0d2]",
60 $mday, $mabbr[$mon],$year,$hour,$min);
61 }
62
63 return $fdate;
64}
65
66sub _nextFreeId
67{
68 my $self = shift @_;
69
70 my $items = $self->{'items'};
71 my $lines = $self->{'lines'};
72 my $constraints = $self->{'constraints'};
73
74 # Ids start at base of 1
75 return 1+(scalar(@$items) + scalar(@$lines) + scalar(@$constraints));
76}
77
78
79sub _addItem
80{
81 my $self = shift @_;
82 my ($type,$attr) = @_;
83
84 # By this point 'attr' is synonymous with being an item
85
86 my $items = $self->{'items'};
87
88 my $next_free_id = $self->_nextFreeId();
89
90 $attr->{'_type'} = $type;
91 $attr->{'_id'} = $next_free_id;
92
93 push(@$items,$attr);
94
95 return ($attr,$next_free_id);
96}
97
98
99
100sub _setBaseDefaultAttributes
101{
102 my $self = shift @_;
103 my ($attr) = @_;
104
105 $attr->{'o'} = $self->{'username'};
106 $attr->{'s'} = getFormatedDate("highPrecision");
107 $attr->{'Q'} = "0"; # gradient
108 $attr->{'v'} = "S"; # dot type
109}
110
111
112sub setPointDefaultAttributes
113{
114 my $self = shift @_;
115 my ($attr) = @_;
116
117 $self->_setBaseDefaultAttributes($attr);
118}
119
120sub setTextDefaultAttributes
121{
122 my $self = shift @_;
123 my ($attr) = @_;
124
125 $self->_setBaseDefaultAttributes($attr);
126
127 $attr->{'d'} = "0 0 0"; # black color
128}
129
130
131sub setRectPointDefaultAttributes
132{
133 my $self = shift @_;
134 my ($attr) = @_;
135
136 $self->setPointDefaultAttributes($attr);
137
138 $attr->{'d'} = "50 100 50"; # green color for rect lines
139 $attr->{'h'} = "2.0"; # line thickness
140}
141
142
143sub addRectPoint
144{
145 my $self = shift @_;
146 my ($x, $y, $attr) = @_;
147
148 my %attr_copy = %$attr; # make a private copy of 'attr'
149
150 $self->setRectPointDefaultAttributes(\%attr_copy);
151
152 my $items = $self->{'items'};
153
154 $attr_copy{'P'} = "$x $y";
155
156 return $self->_addItem("P",\%attr_copy);
157}
158
159sub addText
160{
161 my $self = shift @_;
162 my ($x, $y, $text, $attr) = @_;
163
164 # fudge factor for now (based on default font size used)
165 $y += 16; # y-value of text item in Expeditee is it's base line
166
167 my %attr_copy = %$attr; # make a private copy of 'attr'
168
169 $self->setTextDefaultAttributes(\%attr_copy);
170
171 my $items = $self->{'items'};
172
173 $attr_copy{'P'} = "$x $y";
174 $attr_copy{'T'} = $text;
175
176 return $self->_addItem("T",\%attr_copy);
177}
178
179sub addLine
180{
181 my $self = shift @_;
182
183 my ($item_id1,$item_id2) = @_;
184
185 my $lines = $self->{'lines'};
186 my $line_type = 1;
187
188 my $next_free_id = $self->_nextFreeId();
189
190 my $attr = { 'L' => "$next_free_id $line_type" };
191
192 $attr->{'s'} = "$item_id1 $item_id2";
193
194 push(@$lines,$attr);
195
196 return ($attr,$next_free_id);
197}
198
199
200sub addConstraint
201{
202 my $self = shift @_;
203
204 my ($orientation,$item_id1,$item_id2) = @_;
205
206 my $constraints = $self->{'constraints'};
207
208 my $orientation_type = undef;
209 if ($orientation eq "vertical") {
210 $orientation_type = 2;
211 }
212 else {
213 # assume horizontal for now
214 $orientation_type = 3;
215 }
216
217 my $next_free_id = $self->_nextFreeId();
218
219 my $attr = { 'C' => "$next_free_id $orientation_type" };
220
221 $attr->{'s'} = "$item_id1 $item_id2";
222
223 push(@$constraints,$attr);
224
225 return ($attr,$next_free_id);
226}
227
228
229sub addRect
230{
231 my $self = shift @_;
232
233 my ($xl, $yt, $xr, $yb, $attr) = @_;
234
235 # do point in same order Expeditee puts them in
236 my ($p_tr,$p_tr_id) = $self->addRectPoint($xr,$yt,$attr);
237 my ($p_tl,$p_tl_id) = $self->addRectPoint($xl,$yt,$attr);
238 my ($p_bl,$p_bl_id) = $self->addRectPoint($xl,$yb,$attr);
239 my ($p_br,$p_br_id) = $self->addRectPoint($xr,$yb,$attr);
240
241 my ($l_t,$l_t_id) = $self->addLine($p_tr_id,$p_tl_id);
242 my ($l_l,$l_l_id) = $self->addLine($p_tl_id,$p_bl_id);
243 my ($l_b,$l_b_id) = $self->addLine($p_bl_id,$p_br_id);
244 my ($l_r,$l_r_id) = $self->addLine($p_br_id,$p_tr_id);
245
246 my ($c_t,$c_t_id) = $self->addConstraint("horizontal",$p_tr_id,$p_tl_id);
247 my ($c_l,$c_l_id) = $self->addConstraint("vertical" ,$p_tl_id,$p_bl_id);
248 my ($c_b,$c_b_id) = $self->addConstraint("horizontal",$p_bl_id,$p_br_id);
249 my ($c_r,$c_r_id) = $self->addConstraint("vertical" ,$p_br_id,$p_tr_id);
250
251 $p_tr->{'l'} = "$l_t_id $l_r_id";
252 $p_tl->{'l'} = "$l_t_id $l_l_id";
253 $p_bl->{'l'} = "$l_l_id $l_b_id";
254 $p_br->{'l'} = "$l_b_id $l_r_id";
255
256 $p_tr->{'c'} = "$c_t_id $c_r_id";
257 $p_tl->{'c'} = "$c_t_id $c_l_id";
258 $p_bl->{'c'} = "$c_l_id $c_b_id";
259 $p_br->{'c'} = "$c_b_id $c_r_id";
260
261}
262
263sub writeHeaderSection
264{
265 my $self = shift @_;
266
267 # Example header:
268 # V 1
269 # p 4
270 # U davidb
271 # D 09Jan2012[13:33]
272 # M davidb
273 # d 09Jan2012[13:33]
274 # Z
275 #
276
277 # Legend:
278 # V = version
279 # p = permision level
280 # U = username (owner)
281 # M = last modified by
282 # D, d = date information
283 # Z => end of section
284
285
286 my $username = $self->{'username'};
287
288 my $fdate = getFormatedDate();
289
290 print FOUT "V 1\n";
291 print FOUT "p 4\n";
292 print FOUT "U $username\n";
293 print FOUT "D $fdate\n";
294 print FOUT "M $username\n";
295 print FOUT "d $fdate\n";
296 print FOUT "Z\n\n";
297
298}
299
300
301sub writeItemsSection
302{
303 my $self = shift @_;
304
305 my $items = $self->{'items'};
306
307 foreach my $item (@$items) {
308 my $type = delete $item->{'_type'};
309 my $id = delete $item->{'_id'};
310
311 print FOUT "S $type $id\n";
312 foreach my $a (keys %$item) {
313 print FOUT "$a ", $item->{$a}, "\n";
314 }
315
316 print FOUT "\n";
317 }
318
319 print FOUT "Z\n\n";
320}
321
322sub writeLinesSection
323{
324 my $self = shift @_;
325
326 my $lines = $self->{'lines'};
327
328 foreach my $line (@$lines) {
329
330 print FOUT "L ", $line->{'L'}, "\n";
331 print FOUT "s ", $line->{'s'}, "\n";
332
333 print FOUT "\n";
334 }
335
336 print FOUT "Z\n\n";
337
338}
339
340sub writeConstraintsSection
341{
342 my $self = shift @_;
343
344 my $constraints = $self->{'constraints'};
345
346 foreach my $constraint (@$constraints) {
347 print FOUT "C ", $constraint->{'C'}, "\n";
348 print FOUT "s ", $constraint->{'s'}, "\n";
349
350 print FOUT "\n";
351 }
352
353 print FOUT "Z\n\n";
354}
355
356sub writeStatisticsSection
357{
358 my $self = shift @_;
359
360 # Currently do nothing
361}
362
363sub saveFrame
364{
365 my $self = shift @_;
366 my ($filename) = @_;
367
368 my $status = undef;
369
370 if (open(FOUT,">$filename")) {
371 binmode(FOUT,":utf8");
372 $self->writeHeaderSection();
373 $self->writeItemsSection();
374 $self->writeLinesSection();
375 $self->writeConstraintsSection();
376 $self->writeStatisticsSection();
377
378 close(FOUT);
379 $status = 1;
380 }
381 else {
382 print STDERR "ExpediteeFrameIO:: Failed to open $filename for output\n";
383 $status = 0;
384 }
385
386 return $status;
387}
388
389sub buildFrame
390{
391 my $self = shift @_;
392 my ($html_node) = @_;
393
394 my $type = $html_node->{'type'};
395
396 if ($type eq "rect") {
397
398 my $rect = $html_node->{'rect'};
399 my $xl = $rect->{'xl'};
400 my $xr = $rect->{'xr'};
401 my $yt = $rect->{'yt'};
402 my $yb = $rect->{'yb'};
403
404 my $attr = {};
405
406 $self->addRect($xl,$yt,$xr,$yb,$attr);
407
408 }
409 elsif ($type eq "text") {
410 my $text = $html_node->{'text'};
411
412 my $x = $html_node->{'x'};
413 my $y = $html_node->{'y'};
414
415 my $attr = {};
416
417 $self->addText($x,$y,$text,$attr);
418 }
419 else {
420 print STDERR "ExpediteeFrameIO::buildFrame(): Warning, unrecognized type '$type'\n";
421 }
422
423 my $childNodes = $html_node->{'childNodes'};
424 foreach my $child_node (@$childNodes) {
425 $self->buildFrame($child_node);
426 }
427}
428
429
430sub saveNextFreeFrame
431{
432 my $self = shift @_;
433 my ($nextFreeFrame) = @_;
434
435 print STDERR "**** saveNextFreeFrame not implemented yet!!\n";
436}
437
4381;
Note: See TracBrowser for help on using the repository browser.