root/gs3-extensions/html-to-expeditee/trunk/src/perllib/ExpediteeFrameIO.pm @ 26596

Revision 26596, 12.8 KB (checked in by davidb, 7 years ago)

The html to expeditee feature will now obtain a matching assocfilepath for each frame and write this value out to the frame as a piece of text.

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) = @_;
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'} = getFormattedDate("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 = getFormattedDate();
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 saveZeroFrame
425{
426    my $self = shift @_;
427    my $file = "0.exp";
428
429    my $filename = &util::filename_cat($self->{'output_dir'},$file);
430
431    my $status = undef;
432
433    my $username = $self->{'username'};
434    my $fdate = getFormattedDate();
435
436    if (open(FOUT,">$filename")) {
437    binmode(FOUT,":utf8");
438   
439    print FOUT <<EOT;
440   
441V 1
442p 4
443U $username
444D $fdate
445M $username
446d $fdate
447Z
448
449Z
450
451Z
452
453Z
454   
455EOT
456
457    close(FOUT);
458    $status = 1;
459    }
460    else {
461    print STDERR "ExpediteeFrameIO::saveZeroFrame() Failed to open $filename for output\n";
462    $status = 0;
463    }
464
465    return $status;
466}
467
468sub writeAssocFilePath
469{
470    my $self = shift @_;
471    my ($assoc) = @_;
472   
473    my $x = 318;
474    my $y = 123;
475    my $text = "\@assocfilepath: $assoc";
476   
477    my $attr = {};
478   
479    #add data: gsdl.Metadata: assocfilepath to this piece of text.
480    $attr->{'D'} = "gsdl.Metadata: assocfilepath";
481   
482    $self->addText($x,$y,$text,undef,$attr);
483}
484
485sub saveFrame
486{
487    my $self = shift @_;
488    my ($file,$assoc) = @_;
489
490    if ($file eq "1.exp") {
491        $self->saveZeroFrame();
492    }
493
494    my $filename = &util::filename_cat($self->{'output_dir'},$file);
495
496    my $status = undef;
497
498    if (open(FOUT,">$filename")) {
499    binmode(FOUT,":utf8");
500   
501
502    $self->writeAssocFilePath($assoc);                      #write assocfilepath out to frame.
503   
504    $self->writeHeaderSection();
505    $self->writeItemsSection();
506    $self->writeLinesSection();
507    $self->writeConstraintsSection();
508    $self->writeStatisticsSection();
509   
510   
511   
512    close(FOUT);
513    $status = 1;
514    }
515    else {
516    print STDERR "ExpediteeFrameIO::saveFrame() Failed to open $filename for output\n";
517    $status = 0;
518    }
519
520    return $status;
521}
522
523sub buildFrame
524{
525    my $self = shift @_;
526    my ($html_node) = @_;
527 
528    my $type = $html_node->{'type'};
529
530    if ($type eq "rect") {
531
532    my $rect = $html_node->{'rect'};
533    my $xl = $rect->{'xl'};
534    my $xr = $rect->{'xr'};
535    my $yt = $rect->{'yt'};
536    my $yb = $rect->{'yb'};
537
538    my $attr = convertStyleToAttr($html_node->{'style'});
539
540    if (defined $html_node->{'attr'}) {
541        # values provided in 'attr' explicitly overwrite any values
542        # derived from CSS style
543
544        my $direct_attr_str = $html_node->{'attr'};
545        my @direct_attr_array = split(/\s*;\s*/,$direct_attr_str);
546        foreach my $da (@direct_attr_array) {
547        my ($key,$val) = ($da =~ m/^(.)\s*(.*)$/);
548        $attr->{$key} = $val;
549        }
550    }
551
552    $self->addRect($xl,$yt,$xr,$yb,$attr);
553
554    if (defined $html_node->{'img'}) {
555
556        my $img_url = $html_node->{'img'};
557        $img_url =~ s/^http:\/\/(.*?)\/greenstone3(.*?)\///;
558        if ($img_url =~ m/^interfaces\//) {
559        $img_url = "greenstone3-svn/web/$img_url";
560        }
561        elsif ($img_url =~ m/^sites\//) {
562#       if ($img_url =~ m/^sites\//) {
563#       $img_url =~ s/^sites\/(.*?)\//images\//;
564            $img_url = "greenstone3-svn/web/$img_url";
565        }
566
567        my $x = $xl;
568        my $y = $yt;
569
570        my $attr = {};
571
572        my $img_text = "\@i: $img_url";
573
574        $self->addText($x,$y,$img_text,undef,$attr);
575    }
576
577    }
578    elsif ($type eq "text") {
579    my $text = $html_node->{'text'};
580
581    my $x = $html_node->{'xl'};
582    my $y = $html_node->{'yt'};
583    my $w = $html_node->{'xr'} - $x +1;
584
585    my $attr = convertStyleToAttr($html_node->{'style'});
586
587    # fudge factor for now (based on default font size used)
588    $y += 16; # y-value of text item in Expeditee is it's base line
589    $x += 4;
590
591    my $data = $html_node->{'data'};
592    $attr->{'D'} = $data if defined $data;
593 
594    $self->addText($x,$y,$text,$w,$attr);
595    }
596    else {
597    print STDERR "ExpediteeFrameIO::buildFrame(): Warning, unrecognized type '$type'\n";
598    }
599
600    my $childNodes = $html_node->{'childNodes'};
601    foreach my $child_node (@$childNodes) {
602    $self->buildFrame($child_node);
603    }
604}
605
606
607sub saveLastFrameNumber
608{
609    my $self = shift @_;
610    my ($last_frame_number) = @_;
611
612    my $filename = &util::filename_cat($self->{'output_dir'},"frame.inf");
613
614    my $status = undef;
615
616    if (open(FNOUT,">$filename")) {
617    binmode(FNOUT,":utf8");
618
619    #writes frameset name concatenated with last frame number in the set to the frame.inf file.
620        my $getFramesetName = $self->{'output_dir'};
621       
622   
623    close(FNOUT);
624    $status = 1;
625    }
626    else {
627    print STDERR "ExpediteeFrameIO::saveLastFrameNumber() Failed to open $filename for output\n";
628    $status = 0;
629    }
630
631    return $status;
632
633}
634
6351;
Note: See TracBrowser for help on using the browser.