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

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

Corrected spelling of one of the method names (from getFormatedDate to getFormattedDate).

File size: 11.8 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";
79 my $exp_font_size = "14";
[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'}) {
86 my $css_font_size = $css_attr->{'font-size'};
87 $exp_font_size = CssStyleToExpAttr::convert_font_size($css_font_size);
88 }
[24939]89
90# if (defined $css_attr->{'font-face'}) {
91# $font = conver_font_face($css_attr->{'font-face'});
92# }
93
[24941]94# $exp_attr->{'f'} = $exp_font_family.$exp_font_face.$exp_font_size;
95
[24944]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
[24939]107 return $exp_attr;
108}
109
110
[24934]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'};
[26511]151 $attr->{'s'} = getFormattedDate("highPrecision");
[24934]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
[25057]172 if(defined $attr->{'d'}){
173
174 }
175 else {
176 $attr->{'d'} = "0 0 0"; # black color
177 }
178
[24934]179}
180
181
182sub setRectPointDefaultAttributes
183{
184 my $self = shift @_;
185 my ($attr) = @_;
186
[25057]187
[24934]188 $self->setPointDefaultAttributes($attr);
189
[25057]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 }
[24934]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 @_;
[24941]219 my ($x, $y, $text, $w, $attr) = @_;
[24934]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;
[24941]228 $attr_copy{'w'} = "-$w" if (defined $w);
[24934]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
[26511]342 my $fdate = getFormattedDate();
[24934]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) {
[25057]362
[24934]363 my $type = delete $item->{'_type'};
[25057]364 my $id = delete $item->{'_id'};
[24934]365
[25057]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 }
[24934]373
[25057]374 print FOUT "\n";
[24934]375
[25057]376 }
377
378 }
379
[24934]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 @_;
[24938]427 my ($file) = @_;
[24934]428
[24938]429 my $filename = &util::filename_cat($self->{'output_dir'},$file);
430
[24934]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 {
[24938]445 print STDERR "ExpediteeFrameIO::saveFrame() Failed to open $filename for output\n";
[24934]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
[24939]467 my $attr = convertStyleToAttr($html_node->{'style'});
[24934]468
[25060]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
[24934]481 $self->addRect($xl,$yt,$xr,$yb,$attr);
482
[24941]483 if (defined $html_node->{'img'}) {
484
485 my $img_url = $html_node->{'img'};
[24944]486 $img_url =~ s/^http:\/\/(.*?)\/greenstone3(.*?)\///;
[24941]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
[24934]504 }
505 elsif ($type eq "text") {
506 my $text = $html_node->{'text'};
507
[24941]508 my $x = $html_node->{'xl'};
509 my $y = $html_node->{'yt'};
510 my $w = $html_node->{'xr'} - $x +1;
[24934]511
[24939]512 my $attr = convertStyleToAttr($html_node->{'style'});
[24934]513
[24941]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
[25057]518 my $data = $html_node->{'data'};
519 $attr->{'D'} = $data if defined $data;
520
[24941]521 $self->addText($x,$y,$text,$w,$attr);
[24934]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
[24938]534sub saveLastFrameNumber
[24934]535{
536 my $self = shift @_;
[24938]537 my ($last_frame_number) = @_;
[24934]538
[24938]539 my $filename = &util::filename_cat($self->{'output_dir'},"frame.inf");
540
541 my $status = undef;
542
543 if (open(FNOUT,">$filename")) {
[24939]544 binmode(FNOUT,":utf8");
[25057]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
[24938]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
[24934]561}
562
5631;
Note: See TracBrowser for help on using the repository browser.