source: main/trunk/greenstone2/perllib/plugouts/GreenstoneXMLPlugout.pm@ 22839

Last change on this file since 22839 was 22839, checked in by davidb, 14 years ago

More explicit use of utf8 for input and output file handling. Relies on strings in Perl being Unicode aware (and not merely binary bytes) otherwise binary bytes will then be incorrectly re-incoded as UTF-8 (which is not what you want as they already are in UTF-8 form).

  • Property svn:keywords set to Author Date Id Revision
File size: 3.2 KB
Line 
1###########################################################################
2#
3# GreenstoneXMLPlugout.pm -- the plugout module for Greenstone Archives
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) 2006 New Zealand Digital Library Project
9#
10# This program is free software; you can redistribute 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 GreenstoneXMLPlugout;
27
28use strict;
29no strict 'refs';
30no strict 'subs';
31
32eval {require bytes};
33use util;
34use BasePlugout;
35use docprint;
36
37sub BEGIN {
38 @GreenstoneXMLPlugout::ISA = ('BasePlugout');
39}
40
41my $arguments = [];
42
43my $options = { 'name' => "GreenstoneXMLPlugout",
44 'desc' => "{GreenstoneXMLPlugout.desc}",
45 'abstract' => "no",
46 'inherits' => "yes" };
47
48sub new {
49 my ($class) = shift (@_);
50 my ($plugoutlist, $inputargs,$hashArgOptLists) = @_;
51 push(@$plugoutlist, $class);
52
53 push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});
54 push(@{$hashArgOptLists->{"OptList"}},$options);
55
56 my $self = new BasePlugout($plugoutlist,$inputargs,$hashArgOptLists);
57
58 return bless $self, $class;
59}
60
61sub saveas {
62 my $self = shift (@_);
63 my ($doc_obj,$doc_dir) = @_;
64
65 my $outhandler;
66 if ($self->{'debug'}) {
67 $outhandler = STDOUT;
68 # can we do the xslt and still do debug mode?
69 }
70 else {
71 my $output_dir = $self->get_output_dir();
72 &util::mk_all_dir ($output_dir) unless -e $output_dir;
73
74 my $working_dir = &util::filename_cat ($output_dir, $doc_dir);
75 &util::mk_all_dir ($working_dir) unless -e $working_dir;
76
77 $self->process_assoc_files ($doc_obj, $doc_dir, '');
78
79 $self->process_metafiles_metadata ($doc_obj);
80
81 my $output_file = util::filename_cat ($working_dir, "doc.xml");
82
83 $self->open_xslt_pipe($output_file, $self->{'xslt_file'});
84
85
86 if (defined $self->{'xslt_writer'}){
87 $outhandler = $self->{'xslt_writer'};
88 }
89 else{
90 $outhandler = $self->get_output_handler($output_file);
91 }
92 }
93
94 binmode($outhandler,":utf8");
95
96 $self->output_xml_header($outhandler,"Archive");
97 my $section_output = &docprint::get_section_xml($doc_obj, $doc_obj->get_top_section());
98 print $outhandler $section_output;
99 $self->output_xml_footer($outhandler,"Archive");
100
101 if (!$self->{'debug'}) {
102 if (defined $self->{'xslt_writer'}){
103 $self->close_xslt_pipe();
104 }
105 else {
106 close($outhandler);
107 }
108
109 $self->{'short_doc_file'} = util::filename_cat ($doc_dir, "doc.xml");
110
111 $self->store_output_info_reference($doc_obj);
112 }
113}
114
115
116
1171;
118
Note: See TracBrowser for help on using the repository browser.