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

Last change on this file since 26731 was 26731, checked in by davidb, 11 years ago

Can now correctly obtain colours and size of text when generating Expeditee frames. Also accounted for when the web browser being used is Firefox (FF uses "700" instead of the word "bold" for font-weight). The width of text items is also calculated and written to Expeditee. Parameters have also been provided so the user can decide whether they want the correct font information and text width used or to just use default values.
File size: 14.7 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 getFormattedDate
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,$compute_font) = @_;
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 = "18";
80
81 if(defined $compute_font){
82 if($compute_font eq "true"){
83
84 if (defined $css_attr->{'font-size'}) {
85
86 my $css_font_size = $css_attr->{'font-size'};
87 my $new_exp_font_size = CssStyleToExpAttr::convert_font_size($css_font_size);
88
89 if(defined $new_exp_font_size){
90 $exp_font_size = $new_exp_font_size;
91 }
92 }
93
94 if(defined $css_attr->{'font-family'}){
95 my $obtain_font_family = $css_attr->{'font-family'};
96 my $new_exp_font_family = CssStyleToExpAttr::convert_font_family($obtain_font_family);
97
98 if(defined $new_exp_font_family){
99 $exp_font_family = $new_exp_font_family;
100 }
101 }
102
103 #obtain font style/weight - bold, italic or bold-italic.
104
105 if(defined $css_attr->{'font-style'}){
106 my $css_font_style = $css_attr->{'font-style'};
107 my $new_exp_font_face = CssStyleToExpAttr::convert_font_face($css_font_style);
108
109 if(defined $new_exp_font_face){
110 $exp_font_face = $new_exp_font_face;
111 }
112 }
113
114 if(defined $css_attr->{'font-weight'}){
115 my $css_font_face = $css_attr->{'font-weight'};
116 my $new_exp_font_face = CssStyleToExpAttr::convert_font_face($css_font_face);
117
118 if(defined $new_exp_font_face){
119 $exp_font_face = $new_exp_font_face;
120 }
121 }
122
123 if(defined $css_attr->{'font-style'} && defined $css_attr->{'font-weight'}){
124 my $font_face_param = $css_attr->{'font-weight'}.'-'.$css_attr->{'font-style'};
125 my $new_exp_font_face = CssStyleToExpAttr::convert_font_face($font_face_param);
126
127 if(defined $new_exp_font_face){
128 $exp_font_face = $new_exp_font_face;
129 }
130 }
131
132 # color
133 if(defined $css_attr->{'color'}){
134 my $css_color = $css_attr->{'color'};
135
136 my $exp_color = CssStyleToExpAttr::convert_color($css_color);
137
138 $exp_attr->{'d'} = $exp_color;
139 }
140 }
141 }
142
143 $exp_attr->{'f'} = $exp_font_family.$exp_font_face.$exp_font_size;
144
145 # background color
146 if (defined $css_attr->{'background-color'}) {
147 my $css_color = $css_attr->{'background-color'};
148
149 my $exp_color = CssStyleToExpAttr::convert_color($css_color);
150
151 $exp_attr->{'e'} = $exp_color;
152 }
153
154
155
156 return $exp_attr;
157}
158
159
160sub _nextFreeId
161{
162 my $self = shift @_;
163
164 my $items = $self->{'items'};
165 my $lines = $self->{'lines'};
166 my $constraints = $self->{'constraints'};
167
168 # Ids start at base of 1
169 return 1+(scalar(@$items) + scalar(@$lines) + scalar(@$constraints));
170}
171
172
173sub _addItem
174{
175 my $self = shift @_;
176 my ($type,$attr) = @_;
177
178 # By this point 'attr' is synonymous with being an item
179
180 my $items = $self->{'items'};
181
182 my $next_free_id = $self->_nextFreeId();
183
184 $attr->{'_type'} = $type;
185 $attr->{'_id'} = $next_free_id;
186
187 push(@$items,$attr);
188
189 return ($attr,$next_free_id);
190}
191
192
193
194sub _setBaseDefaultAttributes
195{
196 my $self = shift @_;
197 my ($attr) = @_;
198
199 $attr->{'o'} = $self->{'username'};
200 $attr->{'s'} = getFormattedDate("highPrecision");
201 $attr->{'Q'} = "0"; # gradient
202 $attr->{'v'} = "S"; # dot type
203}
204
205
206sub setPointDefaultAttributes
207{
208 my $self = shift @_;
209 my ($attr) = @_;
210
211 $self->_setBaseDefaultAttributes($attr);
212}
213
214sub setTextDefaultAttributes
215{
216 my $self = shift @_;
217 my ($attr) = @_;
218
219 $self->_setBaseDefaultAttributes($attr);
220
221 if(defined $attr->{'d'}){
222
223 }
224 else {
225 $attr->{'d'} = "0 0 0"; # black color
226 }
227
228}
229
230
231sub setRectPointDefaultAttributes
232{
233 my $self = shift @_;
234 my ($attr) = @_;
235
236
237 $self->setPointDefaultAttributes($attr);
238
239 if((defined $attr->{'d'}) && (defined $attr->{'h'})){
240
241 }
242 else {
243 $attr->{'d'} = "80 80 80"; # grey color for rect lines
244 $attr->{'h'} = "1.0"; # line thickness
245 }
246}
247
248
249sub addRectPoint
250{
251 my $self = shift @_;
252 my ($x, $y, $attr) = @_;
253
254 my %attr_copy = %$attr; # make a private copy of 'attr'
255
256 $self->setRectPointDefaultAttributes(\%attr_copy);
257
258 my $items = $self->{'items'};
259
260 $attr_copy{'P'} = "$x $y";
261
262 return $self->_addItem("P",\%attr_copy);
263}
264
265sub addText
266{
267 my $self = shift @_;
268 my ($x,$y,$text,$w,$attr) = @_;
269
270 my %attr_copy = %$attr; #make a private copy of 'attr'
271
272 $self->setTextDefaultAttributes(\%attr_copy);
273 my $items = $self->{'items'};
274
275 $attr_copy{'P'} = "$x $y";
276 $attr_copy{'T'} = $text;
277 #$attr_copy{'w'} = "-$w" if (defined $w);
278 $attr_copy{'w'} = "$w" if (defined $w);
279
280 return $self->_addItem("T",\%attr_copy);
281}
282
283sub addLine
284{
285 my $self = shift @_;
286
287 my ($item_id1,$item_id2) = @_;
288
289 my $lines = $self->{'lines'};
290 my $line_type = 1;
291
292 my $next_free_id = $self->_nextFreeId();
293
294 my $attr = { 'L' => "$next_free_id $line_type" };
295
296 $attr->{'s'} = "$item_id1 $item_id2";
297
298 push(@$lines,$attr);
299
300 return ($attr,$next_free_id);
301}
302
303
304sub addConstraint
305{
306 my $self = shift @_;
307
308 my ($orientation,$item_id1,$item_id2) = @_;
309
310 my $constraints = $self->{'constraints'};
311
312 my $orientation_type = undef;
313 if ($orientation eq "vertical") {
314 $orientation_type = 2;
315 }
316 else {
317 # assume horizontal for now
318 $orientation_type = 3;
319 }
320
321 my $next_free_id = $self->_nextFreeId();
322
323 my $attr = { 'C' => "$next_free_id $orientation_type" };
324
325 $attr->{'s'} = "$item_id1 $item_id2";
326
327 push(@$constraints,$attr);
328
329 return ($attr,$next_free_id);
330}
331
332
333sub addRect
334{
335 my $self = shift @_;
336
337 my ($xl, $yt, $xr, $yb, $attr) = @_;
338
339 # do point in same order Expeditee puts them in
340 my ($p_tr,$p_tr_id) = $self->addRectPoint($xr,$yt,$attr);
341 my ($p_tl,$p_tl_id) = $self->addRectPoint($xl,$yt,$attr);
342 my ($p_bl,$p_bl_id) = $self->addRectPoint($xl,$yb,$attr);
343 my ($p_br,$p_br_id) = $self->addRectPoint($xr,$yb,$attr);
344
345 my ($l_t,$l_t_id) = $self->addLine($p_tr_id,$p_tl_id);
346 my ($l_l,$l_l_id) = $self->addLine($p_tl_id,$p_bl_id);
347 my ($l_b,$l_b_id) = $self->addLine($p_bl_id,$p_br_id);
348 my ($l_r,$l_r_id) = $self->addLine($p_br_id,$p_tr_id);
349
350 my ($c_t,$c_t_id) = $self->addConstraint("horizontal",$p_tr_id,$p_tl_id);
351 my ($c_l,$c_l_id) = $self->addConstraint("vertical" ,$p_tl_id,$p_bl_id);
352 my ($c_b,$c_b_id) = $self->addConstraint("horizontal",$p_bl_id,$p_br_id);
353 my ($c_r,$c_r_id) = $self->addConstraint("vertical" ,$p_br_id,$p_tr_id);
354
355 $p_tr->{'l'} = "$l_t_id $l_r_id";
356 $p_tl->{'l'} = "$l_t_id $l_l_id";
357 $p_bl->{'l'} = "$l_l_id $l_b_id";
358 $p_br->{'l'} = "$l_b_id $l_r_id";
359
360 $p_tr->{'c'} = "$c_t_id $c_r_id";
361 $p_tl->{'c'} = "$c_t_id $c_l_id";
362 $p_bl->{'c'} = "$c_l_id $c_b_id";
363 $p_br->{'c'} = "$c_b_id $c_r_id";
364
365}
366
367sub writeHeaderSection
368{
369 my $self = shift @_;
370
371 # Example header:
372 # V 1
373 # p 4
374 # U davidb
375 # D 09Jan2012[13:33]
376 # M davidb
377 # d 09Jan2012[13:33]
378 # Z
379 #
380
381 # Legend:
382 # V = version
383 # p = permision level
384 # U = username (owner)
385 # M = last modified by
386 # D, d = date information
387 # Z => end of section
388
389
390 my $username = $self->{'username'};
391
392 my $fdate = getFormattedDate();
393
394 print FOUT "V 1\n";
395 print FOUT "p 4\n";
396 print FOUT "U $username\n";
397 print FOUT "D $fdate\n";
398 print FOUT "M $username\n";
399 print FOUT "d $fdate\n";
400 print FOUT "Z\n\n";
401
402}
403
404
405sub writeItemsSection
406{
407 my $self = shift @_;
408
409 my $items = $self->{'items'};
410
411 foreach my $item (@$items) {
412
413 my $type = delete $item->{'_type'};
414 my $id = delete $item->{'_id'};
415
416 if(defined($type) && defined($id)) {
417
418 print FOUT "S $type $id\n";
419
420 foreach my $a (keys %$item) {
421 print FOUT "$a ", $item->{$a}, "\n";
422 }
423
424 print FOUT "\n";
425
426 }
427
428 }
429
430 print FOUT "Z\n\n";
431}
432
433sub writeLinesSection
434{
435 my $self = shift @_;
436
437 my $lines = $self->{'lines'};
438
439 foreach my $line (@$lines) {
440
441 print FOUT "L ", $line->{'L'}, "\n";
442 print FOUT "s ", $line->{'s'}, "\n";
443
444 print FOUT "\n";
445 }
446
447 print FOUT "Z\n\n";
448
449}
450
451sub writeConstraintsSection
452{
453 my $self = shift @_;
454
455 my $constraints = $self->{'constraints'};
456
457 foreach my $constraint (@$constraints) {
458 print FOUT "C ", $constraint->{'C'}, "\n";
459 print FOUT "s ", $constraint->{'s'}, "\n";
460
461 print FOUT "\n";
462 }
463
464 print FOUT "Z\n\n";
465}
466
467sub writeStatisticsSection
468{
469 my $self = shift @_;
470
471 # Currently do nothing
472}
473
474sub saveZeroFrame
475{
476 my $self = shift @_;
477 my $file = "0.exp";
478
479 my $filename = &util::filename_cat($self->{'output_dir'},$file);
480
481 my $status = undef;
482
483 my $username = $self->{'username'};
484 my $fdate = getFormattedDate();
485
486 if (open(FOUT,">$filename")) {
487 binmode(FOUT,":utf8");
488
489 print FOUT <<EOT;
490
491V 1
492p 4
493U $username
494D $fdate
495M $username
496d $fdate
497Z
498
499Z
500
501Z
502
503Z
504
505EOT
506
507 close(FOUT);
508 $status = 1;
509 }
510 else {
511 print STDERR "ExpediteeFrameIO::saveZeroFrame() Failed to open $filename for output\n";
512 $status = 0;
513 }
514
515 return $status;
516}
517
518sub writeAssocFilePath
519{
520 my $self = shift @_;
521 my ($assoc) = @_;
522
523 my $x = 318;
524 my $y = 123;
525 my $text = "\@assocfilepath: $assoc";
526
527 my $attr = {};
528
529 #add data: gsdl.Metadata: assocfilepath to this piece of text.
530 $attr->{'D'} = "gsdl.Metadata: assocfilepath";
531
532 $self->addText($x,$y,$text,undef,$attr);
533}
534
535sub saveFrame
536{
537 my $self = shift @_;
538 my ($file,$assoc) = @_;
539
540 if ($file eq "1.exp") {
541 $self->saveZeroFrame();
542 }
543
544 my $filename = &util::filename_cat($self->{'output_dir'},$file);
545
546 my $status = undef;
547
548 if (open(FOUT,">$filename")) {
549 binmode(FOUT,":utf8");
550
551 if(defined $assoc){
552 $self->writeAssocFilePath($assoc); #write assocfilepath out to frame.
553 }
554
555 $self->writeHeaderSection();
556 $self->writeItemsSection();
557 $self->writeLinesSection();
558 $self->writeConstraintsSection();
559 $self->writeStatisticsSection();
560
561 close(FOUT);
562 $status = 1;
563 }
564 else {
565 print STDERR "ExpediteeFrameIO::saveFrame() Failed to open $filename for output\n";
566 $status = 0;
567 }
568
569 return $status;
570}
571
572sub buildFrame
573{
574 my $self = shift @_;
575 my ($html_node,$compute_font) = @_;
576
577 my $type = $html_node->{'type'};
578
579 if ($type eq "rect") {
580
581 my $rect = $html_node->{'rect'};
582 my $xl = $rect->{'xl'};
583 my $xr = $rect->{'xr'};
584 my $yt = $rect->{'yt'};
585 my $yb = $rect->{'yb'};
586
587 my $attr = convertStyleToAttr($html_node->{'style'});
588
589 if (defined $html_node->{'attr'}) {
590 # values provided in 'attr' explicitly overwrite any values
591 # derived from CSS style
592
593 my $direct_attr_str = $html_node->{'attr'};
594 my @direct_attr_array = split(/\s*;\s*/,$direct_attr_str);
595 foreach my $da (@direct_attr_array) {
596 my ($key,$val) = ($da =~ m/^(.)\s*(.*)$/);
597 $attr->{$key} = $val;
598 }
599 }
600
601 #don't want to add font information to non-text items!
602 my $deleted = delete $attr->{'f'};
603
604 $self->addRect($xl,$yt,$xr,$yb,$attr);
605
606 if (defined $html_node->{'img'}) {
607
608 my $img_url = $html_node->{'img'};
609 $img_url =~ s/^http:\/\/(.*?)\/greenstone3(.*?)\///;
610 if ($img_url =~ m/^interfaces\//) {
611 $img_url = "greenstone3-svn/web/$img_url";
612 }
613 elsif ($img_url =~ m/^sites\//) {
614# if ($img_url =~ m/^sites\//) {
615# $img_url =~ s/^sites\/(.*?)\//images\//;
616 $img_url = "greenstone3-svn/web/$img_url";
617 }
618
619 my $x = $xl;
620 my $y = $yt;
621
622 my $attr = {};
623
624 my $img_text = "\@i: $img_url";
625
626 $self->addText($x,$y,$img_text,undef,$attr);
627 }
628
629 }
630 elsif ($type eq "text") {
631
632 my $text = $html_node->{'text'};
633
634 my $x = $html_node->{'xl'};
635 my $y = $html_node->{'yt'};
636 #my $w = $html_node->{'xr'} - $x +1;
637
638 my $w = undef;
639
640 if(defined $html_node->{'width'}){
641 $w = $html_node->{'width'} - 5; #take away 5px for extra space.
642 }
643
644 my $attr = convertStyleToAttr($html_node->{'style'},$compute_font);
645
646 # fudge factor for now (based on default font size used)
647 $y += 16; # y-value of text item in Expeditee is it's base line
648 $x += 4;
649
650 my $data = $html_node->{'data'};
651 $attr->{'D'} = $data if defined $data;
652
653 $self->addText($x,$y,$text,$w,$attr);
654 }
655 else {
656 print STDERR "ExpediteeFrameIO::buildFrame(): Warning, unrecognized type '$type'\n";
657 }
658
659 my $childNodes = $html_node->{'childNodes'};
660 foreach my $child_node (@$childNodes) {
661 $self->buildFrame($child_node,$compute_font);
662 }
663}
664
665
666sub saveLastFrameNumber
667{
668 my $self = shift @_;
669 my ($last_frame_number,$collect) = @_;
670
671 my $filename = &util::filename_cat($self->{'output_dir'},"frame.inf");
672
673 my $status = undef;
674
675 if (open(FNOUT,">$filename")) {
676 binmode(FNOUT,":utf8");
677
678 #writes frameset name concatenated with last frame number in the set to the frame.inf file.
679 # my $getFramesetName = $self->{'output_dir'};
680
681 #use collection name rather than the directory name where the frameset is stored, when saving the last frame name/number to the frame.inf file.
682 print FNOUT "$collect"."$last_frame_number";
683
684 close(FNOUT);
685 $status = 1;
686 }
687 else {
688 print STDERR "ExpediteeFrameIO::saveLastFrameNumber() Failed to open $filename for output\n";
689
690 $status = 0;
691 }
692
693 return $status;
694
695}
696
6971;
Note: See TracBrowser for help on using the repository browser.