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

Last change on this file since 25060 was 25060, checked in by davidb, 9 years ago

'attr' as an attribute in HTML, passed straight through to Expeditee added in

File size: 11.8 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
30use CssStyleToExpAttr;
31
32sub new
33{
34 my $class = shift(@_);
35 my $output_dir = shift(@_);
36 my $username = shift(@_) || "greenstone";
37
38 my $self = { 'items' => [], 'lines' => [], 'constraints' => [] };
39
40 $self->{'output_dir'} = $output_dir;
41 $self->{'username'} = $username;
42
43 return bless $self, $class;
44}
45
46sub getFormatedDate
47{
48 my ($opt_mode) = @_;
49
50 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
51
52 my @mabbr = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );
53
54 $year += 1900;
55
56 my $fdate;
57
58 if ((defined $opt_mode) && ($opt_mode eq "highPrecision")) {
59 $fdate = sprintf("%02d%s%04d[%02d:%0d2.%02d]",
60 $mday, $mabbr[$mon],$year,$hour,$min,$sec);
61 }
62 else {
63 $fdate = sprintf("%02d%s%04d[%02d:%0d2]",
64 $mday, $mabbr[$mon],$year,$hour,$min);
65 }
66
67 return $fdate;
68}
69
70sub convertStyleToAttr
71{
72 my ($css_attr) = @_;
73
74 my $exp_attr = {};
75
76 # load up some defaults for font information
77 my $exp_font_family = "s"; # t
78 my $exp_font_face = "r";
79 my $exp_font_size = "14";
80
81# if (defined $css_attr->{'font-family'}) {
82# $font_family = $font_family_lookup->[$css_attr->{'font-family'}];
83# }
84
85 if (defined $css_attr->{'font-size'}) {
86 my $css_font_size = $css_attr->{'font-size'};
87 $exp_font_size = CssStyleToExpAttr::convert_font_size($css_font_size);
88 }
89
90# if (defined $css_attr->{'font-face'}) {
91# $font = conver_font_face($css_attr->{'font-face'});
92# }
93
94# $exp_attr->{'f'} = $exp_font_family.$exp_font_face.$exp_font_size;
95
96 # background color
97
98
99 if (defined $css_attr->{'background-color'}) {
100 my $css_color = $css_attr->{'background-color'};
101
102 my $exp_color = CssStyleToExpAttr::convert_color($css_color);
103
104 $exp_attr->{'e'} = $exp_color;
105 }
106
107 return $exp_attr;
108}
109
110
111sub _nextFreeId
112{
113 my $self = shift @_;
114
115 my $items = $self->{'items'};
116 my $lines = $self->{'lines'};
117 my $constraints = $self->{'constraints'};
118
119 # Ids start at base of 1
120 return 1+(scalar(@$items) + scalar(@$lines) + scalar(@$constraints));
121}
122
123
124sub _addItem
125{
126 my $self = shift @_;
127 my ($type,$attr) = @_;
128
129 # By this point 'attr' is synonymous with being an item
130
131 my $items = $self->{'items'};
132
133 my $next_free_id = $self->_nextFreeId();
134
135 $attr->{'_type'} = $type;
136 $attr->{'_id'} = $next_free_id;
137
138 push(@$items,$attr);
139
140 return ($attr,$next_free_id);
141}
142
143
144
145sub _setBaseDefaultAttributes
146{
147 my $self = shift @_;
148 my ($attr) = @_;
149
150 $attr->{'o'} = $self->{'username'};
151 $attr->{'s'} = getFormatedDate("highPrecision");
152 $attr->{'Q'} = "0"; # gradient
153 $attr->{'v'} = "S"; # dot type
154}
155
156
157sub setPointDefaultAttributes
158{
159 my $self = shift @_;
160 my ($attr) = @_;
161
162 $self->_setBaseDefaultAttributes($attr);
163}
164
165sub setTextDefaultAttributes
166{
167 my $self = shift @_;
168 my ($attr) = @_;
169
170 $self->_setBaseDefaultAttributes($attr);
171
172 if(defined $attr->{'d'}){
173
174 }
175 else {
176 $attr->{'d'} = "0 0 0"; # black color
177 }
178
179}
180
181
182sub setRectPointDefaultAttributes
183{
184 my $self = shift @_;
185 my ($attr) = @_;
186
187
188 $self->setPointDefaultAttributes($attr);
189
190 if((defined $attr->{'d'}) && (defined $attr->{'h'})){
191
192 }
193 else {
194 $attr->{'d'} = "80 80 80"; # grey color for rect lines
195 $attr->{'h'} = "1.0"; # line thickness
196 }
197}
198
199
200sub addRectPoint
201{
202 my $self = shift @_;
203 my ($x, $y, $attr) = @_;
204
205 my %attr_copy = %$attr; # make a private copy of 'attr'
206
207 $self->setRectPointDefaultAttributes(\%attr_copy);
208
209 my $items = $self->{'items'};
210
211 $attr_copy{'P'} = "$x $y";
212
213 return $self->_addItem("P",\%attr_copy);
214}
215
216sub addText
217{
218 my $self = shift @_;
219 my ($x, $y, $text, $w, $attr) = @_;
220
221 my %attr_copy = %$attr; # make a private copy of 'attr'
222
223 $self->setTextDefaultAttributes(\%attr_copy);
224 my $items = $self->{'items'};
225
226 $attr_copy{'P'} = "$x $y";
227 $attr_copy{'T'} = $text;
228 $attr_copy{'w'} = "-$w" if (defined $w);
229
230 return $self->_addItem("T",\%attr_copy);
231}
232
233sub addLine
234{
235 my $self = shift @_;
236
237 my ($item_id1,$item_id2) = @_;
238
239 my $lines = $self->{'lines'};
240 my $line_type = 1;
241
242 my $next_free_id = $self->_nextFreeId();
243
244 my $attr = { 'L' => "$next_free_id $line_type" };
245
246 $attr->{'s'} = "$item_id1 $item_id2";
247
248 push(@$lines,$attr);
249
250 return ($attr,$next_free_id);
251}
252
253
254sub addConstraint
255{
256 my $self = shift @_;
257
258 my ($orientation,$item_id1,$item_id2) = @_;
259
260 my $constraints = $self->{'constraints'};
261
262 my $orientation_type = undef;
263 if ($orientation eq "vertical") {
264 $orientation_type = 2;
265 }
266 else {
267 # assume horizontal for now
268 $orientation_type = 3;
269 }
270
271 my $next_free_id = $self->_nextFreeId();
272
273 my $attr = { 'C' => "$next_free_id $orientation_type" };
274
275 $attr->{'s'} = "$item_id1 $item_id2";
276
277 push(@$constraints,$attr);
278
279 return ($attr,$next_free_id);
280}
281
282
283sub addRect
284{
285 my $self = shift @_;
286
287 my ($xl, $yt, $xr, $yb, $attr) = @_;
288
289 # do point in same order Expeditee puts them in
290 my ($p_tr,$p_tr_id) = $self->addRectPoint($xr,$yt,$attr);
291 my ($p_tl,$p_tl_id) = $self->addRectPoint($xl,$yt,$attr);
292 my ($p_bl,$p_bl_id) = $self->addRectPoint($xl,$yb,$attr);
293 my ($p_br,$p_br_id) = $self->addRectPoint($xr,$yb,$attr);
294
295 my ($l_t,$l_t_id) = $self->addLine($p_tr_id,$p_tl_id);
296 my ($l_l,$l_l_id) = $self->addLine($p_tl_id,$p_bl_id);
297 my ($l_b,$l_b_id) = $self->addLine($p_bl_id,$p_br_id);
298 my ($l_r,$l_r_id) = $self->addLine($p_br_id,$p_tr_id);
299
300 my ($c_t,$c_t_id) = $self->addConstraint("horizontal",$p_tr_id,$p_tl_id);
301 my ($c_l,$c_l_id) = $self->addConstraint("vertical" ,$p_tl_id,$p_bl_id);
302 my ($c_b,$c_b_id) = $self->addConstraint("horizontal",$p_bl_id,$p_br_id);
303 my ($c_r,$c_r_id) = $self->addConstraint("vertical" ,$p_br_id,$p_tr_id);
304
305 $p_tr->{'l'} = "$l_t_id $l_r_id";
306 $p_tl->{'l'} = "$l_t_id $l_l_id";
307 $p_bl->{'l'} = "$l_l_id $l_b_id";
308 $p_br->{'l'} = "$l_b_id $l_r_id";
309
310 $p_tr->{'c'} = "$c_t_id $c_r_id";
311 $p_tl->{'c'} = "$c_t_id $c_l_id";
312 $p_bl->{'c'} = "$c_l_id $c_b_id";
313 $p_br->{'c'} = "$c_b_id $c_r_id";
314
315}
316
317sub writeHeaderSection
318{
319 my $self = shift @_;
320
321 # Example header:
322 # V 1
323 # p 4
324 # U davidb
325 # D 09Jan2012[13:33]
326 # M davidb
327 # d 09Jan2012[13:33]
328 # Z
329 #
330
331 # Legend:
332 # V = version
333 # p = permision level
334 # U = username (owner)
335 # M = last modified by
336 # D, d = date information
337 # Z => end of section
338
339
340 my $username = $self->{'username'};
341
342 my $fdate = getFormatedDate();
343
344 print FOUT "V 1\n";
345 print FOUT "p 4\n";
346 print FOUT "U $username\n";
347 print FOUT "D $fdate\n";
348 print FOUT "M $username\n";
349 print FOUT "d $fdate\n";
350 print FOUT "Z\n\n";
351
352}
353
354
355sub writeItemsSection
356{
357 my $self = shift @_;
358
359 my $items = $self->{'items'};
360
361 foreach my $item (@$items) {
362
363 my $type = delete $item->{'_type'};
364 my $id = delete $item->{'_id'};
365
366 if(defined($type) && defined($id)) {
367
368 print FOUT "S $type $id\n";
369
370 foreach my $a (keys %$item) {
371 print FOUT "$a ", $item->{$a}, "\n";
372 }
373
374 print FOUT "\n";
375
376 }
377
378 }
379
380 print FOUT "Z\n\n";
381}
382
383sub writeLinesSection
384{
385 my $self = shift @_;
386
387 my $lines = $self->{'lines'};
388
389 foreach my $line (@$lines) {
390
391 print FOUT "L ", $line->{'L'}, "\n";
392 print FOUT "s ", $line->{'s'}, "\n";
393
394 print FOUT "\n";
395 }
396
397 print FOUT "Z\n\n";
398
399}
400
401sub writeConstraintsSection
402{
403 my $self = shift @_;
404
405 my $constraints = $self->{'constraints'};
406
407 foreach my $constraint (@$constraints) {
408 print FOUT "C ", $constraint->{'C'}, "\n";
409 print FOUT "s ", $constraint->{'s'}, "\n";
410
411 print FOUT "\n";
412 }
413
414 print FOUT "Z\n\n";
415}
416
417sub writeStatisticsSection
418{
419 my $self = shift @_;
420
421 # Currently do nothing
422}
423
424sub saveFrame
425{
426 my $self = shift @_;
427 my ($file) = @_;
428
429 my $filename = &util::filename_cat($self->{'output_dir'},$file);
430
431 my $status = undef;
432
433 if (open(FOUT,">$filename")) {
434 binmode(FOUT,":utf8");
435 $self->writeHeaderSection();
436 $self->writeItemsSection();
437 $self->writeLinesSection();
438 $self->writeConstraintsSection();
439 $self->writeStatisticsSection();
440
441 close(FOUT);
442 $status = 1;
443 }
444 else {
445 print STDERR "ExpediteeFrameIO::saveFrame() Failed to open $filename for output\n";
446 $status = 0;
447 }
448
449 return $status;
450}
451
452sub buildFrame
453{
454 my $self = shift @_;
455 my ($html_node) = @_;
456
457 my $type = $html_node->{'type'};
458
459 if ($type eq "rect") {
460
461 my $rect = $html_node->{'rect'};
462 my $xl = $rect->{'xl'};
463 my $xr = $rect->{'xr'};
464 my $yt = $rect->{'yt'};
465 my $yb = $rect->{'yb'};
466
467 my $attr = convertStyleToAttr($html_node->{'style'});
468
469 if (defined $html_node->{'attr'}) {
470 # values provided in 'attr' explicitly overwrite any values
471 # derived from CSS style
472
473 my $direct_attr_str = $html_node->{'attr'};
474 my @direct_attr_array = split(/\s*;\s*/,$direct_attr_str);
475 foreach my $da (@direct_attr_array) {
476 my ($key,$val) = ($da =~ m/^(.)\s*(.*)$/);
477 $attr->{$key} = $val;
478 }
479 }
480
481 $self->addRect($xl,$yt,$xr,$yb,$attr);
482
483 if (defined $html_node->{'img'}) {
484
485 my $img_url = $html_node->{'img'};
486 $img_url =~ s/^http:\/\/(.*?)\/greenstone3(.*?)\///;
487 if ($img_url =~ m/^interfaces\//) {
488 $img_url = "images/$img_url";
489 }
490 elsif ($img_url =~ m/^sites\//) {
491 $img_url =~ s/^sites\/(.*?)\//images\//;
492 }
493
494 my $x = $xl;
495 my $y = $yt;
496
497 my $attr = {};
498
499 my $img_text = "\@i: $img_url";
500
501 $self->addText($x,$y,$img_text,undef,$attr);
502 }
503
504 }
505 elsif ($type eq "text") {
506 my $text = $html_node->{'text'};
507
508 my $x = $html_node->{'xl'};
509 my $y = $html_node->{'yt'};
510 my $w = $html_node->{'xr'} - $x +1;
511
512 my $attr = convertStyleToAttr($html_node->{'style'});
513
514 # fudge factor for now (based on default font size used)
515 $y += 16; # y-value of text item in Expeditee is it's base line
516 $x += 4;
517
518 my $data = $html_node->{'data'};
519 $attr->{'D'} = $data if defined $data;
520
521 $self->addText($x,$y,$text,$w,$attr);
522 }
523 else {
524 print STDERR "ExpediteeFrameIO::buildFrame(): Warning, unrecognized type '$type'\n";
525 }
526
527 my $childNodes = $html_node->{'childNodes'};
528 foreach my $child_node (@$childNodes) {
529 $self->buildFrame($child_node);
530 }
531}
532
533
534sub saveLastFrameNumber
535{
536 my $self = shift @_;
537 my ($last_frame_number) = @_;
538
539 my $filename = &util::filename_cat($self->{'output_dir'},"frame.inf");
540
541 my $status = undef;
542
543 if (open(FNOUT,">$filename")) {
544 binmode(FNOUT,":utf8");
545
546 #writes frameset name concatenated with last frame number in the set to the frame.inf file.
547 my $getFramesetName = $self->{'output_dir'};
548 print FNOUT "$getFramesetName$last_frame_number\n";
549
550
551 close(FNOUT);
552 $status = 1;
553 }
554 else {
555 print STDERR "ExpediteeFrameIO::saveLastFrameNumber() Failed to open $filename for output\n";
556 $status = 0;
557 }
558
559 return $status;
560
561}
562
5631;
Note: See TracBrowser for help on using the repository browser.