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

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

Now correctly accounts for bold, italic and bold-italic text.

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