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

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

Generation of collection space now done during running of html-to-expeditee script and only if the appropriate checkbox is selected by the user.
File size: 14.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 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 $link = $html_node->{'link'};
651 $attr->{'l'} = $link if defined $link;
652
653 my $data = $html_node->{'data'};
654 $attr->{'D'} = $data if defined $data;
655
656 $self->addText($x,$y,$text,$w,$attr);
657 }
658 else {
659 print STDERR "ExpediteeFrameIO::buildFrame(): Warning, unrecognized type '$type'\n";
660 }
661
662 my $childNodes = $html_node->{'childNodes'};
663 foreach my $child_node (@$childNodes) {
664 $self->buildFrame($child_node,$compute_font);
665 }
666}
667
668
669sub saveLastFrameNumber
670{
671 my $self = shift @_;
672 my ($last_frame_number,$collect) = @_;
673
674 my $filename = &util::filename_cat($self->{'output_dir'},"frame.inf");
675
676 my $status = undef;
677
678 if (open(FNOUT,">$filename")) {
679 binmode(FNOUT,":utf8");
680
681 #writes frameset name concatenated with last frame number in the set to the frame.inf file.
682 # my $getFramesetName = $self->{'output_dir'};
683
684 #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.
685 print FNOUT "$collect"."$last_frame_number";
686
687 close(FNOUT);
688 $status = 1;
689 }
690 else {
691 print STDERR "ExpediteeFrameIO::saveLastFrameNumber() Failed to open $filename for output\n";
692
693 $status = 0;
694 }
695
696 return $status;
697
698}
699
7001;
Note: See TracBrowser for help on using the repository browser.