source: gs2-extensions/parallel-building/trunk/src/perllib/plugouts/GreenstoneXMLPlugout.pm@ 27377

Last change on this file since 27377 was 27377, checked in by jmt12, 11 years ago

Updating calls to intermediate util functions to the new FileUtils functions

File size: 4.8 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 FileUtils;
35use BasePlugout;
36use docprint;
37
38sub BEGIN {
39 @GreenstoneXMLPlugout::ISA = ('BasePlugout');
40}
41
42my $arguments = [];
43
44my $options = { 'name' => "GreenstoneXMLPlugout",
45 'desc' => "{GreenstoneXMLPlugout.desc}",
46 'abstract' => "no",
47 'inherits' => "yes" };
48
49sub new {
50 my ($class) = shift (@_);
51 my ($plugoutlist, $inputargs,$hashArgOptLists) = @_;
52 push(@$plugoutlist, $class);
53
54 push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});
55 push(@{$hashArgOptLists->{"OptList"}},$options);
56
57 my $self = new BasePlugout($plugoutlist,$inputargs,$hashArgOptLists);
58
59 return bless $self, $class;
60}
61
62sub saveas
63{
64 my $self = shift (@_);
65 my ($doc_obj,$doc_dir) = @_;
66
67 my $outhandler;
68 if ($self->{'debug'})
69 {
70 $outhandler = STDOUT;
71 # can we do the xslt and still do debug mode?
72 }
73 else
74 {
75 my $output_dir = $self->get_output_dir();
76 my $working_dir = &FileUtils::filenameConcatenate($output_dir, $doc_dir);
77 if (!&FileUtils::directoryExists($working_dir))
78 {
79 &FileUtils::makeAllDirectories($working_dir);
80 }
81 $self->process_assoc_files ($doc_obj, $doc_dir, '');
82 $self->process_metafiles_metadata ($doc_obj);
83 my $output_file = &FileUtils::filenameConcatenate($working_dir, "doc.xml");
84 $self->open_xslt_pipe($output_file, $self->{'xslt_file'});
85 if (defined $self->{'xslt_writer'})
86 {
87 $outhandler = $self->{'xslt_writer'};
88 }
89 else
90 {
91 $outhandler = $self->get_output_handler($output_file);
92 }
93 }
94
95 binmode($outhandler,":utf8");
96
97 $self->output_xml_header($outhandler,"Archive");
98 my $section_output = &docprint::get_section_xml($doc_obj, $doc_obj->get_top_section());
99 print $outhandler $section_output;
100 $self->output_xml_footer($outhandler,"Archive");
101
102 if (!$self->{'debug'})
103 {
104 if (defined $self->{'xslt_writer'})
105 {
106 $self->close_xslt_pipe();
107 }
108 else
109 {
110 close($outhandler);
111 }
112
113 $self->{'short_doc_file'} = FileUtils::filenameConcatenate($doc_dir, "doc.xml");
114
115 $self->store_output_info_reference($doc_obj);
116 }
117}
118# /** saveas() **/
119
120sub get_new_doc_dir
121{
122 my $self = shift (@_);
123 my ($working_info, $working_dir, $OID) = @_;
124 my $doc_dir = "";
125 my $doc_dir_rest = $OID;
126
127 ###rint "!!GreenstoneXMLPlugout::get_new_doc_dir([working_info]," . $working_dir . "," . $OID . ")\n";
128
129 # Remove any \ and / from the OID because we are about to generate a path
130 # Remove ":" too, as otherwise they get confused with the protocols / drive letters
131 $doc_dir_rest =~ s/[\:\\\/]//g;
132 my $doc_dir_num = 0;
133 my $created_directory = 0;
134 do
135 {
136 if ($doc_dir_num > 0)
137 {
138 $doc_dir .= "/";
139 }
140# if ($doc_dir_rest =~ s/^(.{1,3})//)
141 if ($doc_dir_rest =~ s/^((D|HASH)?.{1,3})//i)
142 {
143 $doc_dir .= $1;
144 $doc_dir_num++;
145 }
146 #rint "!! - testing Path: " . $doc_dir . "\n";
147 $created_directory = &FileUtils::makeAllDirectories(&FileUtils::filenameConcatenate($working_dir, $doc_dir . '.dir'));
148 #rint "-> result: |" . $created_directory . "|\n";
149 }
150 while ($doc_dir_rest ne "" && $doc_dir_num < 32 && !$created_directory);
151 my $i = 0;
152 my $doc_dir_base = $doc_dir;
153 while (!$created_directory && $i < 256)
154 {
155 $i++;
156 $doc_dir = $doc_dir_base . '-' . $i;
157 #rint "!! - testing Path: " . $doc_dir . "\n";
158 $created_directory = &FileUtils::makeAllDirectories(&FileUtils::filenameConcatenate($working_dir, $doc_dir . '.dir'));
159 #rint "-> result: |" . $created_directory . "|\n";
160 }
161 if (!$created_directory)
162 {
163 die("Error! Failed to create directory for document: " . $doc_dir_base . "\n");
164 }
165 #rint "!! Final Path: " . $doc_dir . ".dir\n";
166 return $doc_dir . '.dir';
167}
168
1691;
170
Note: See TracBrowser for help on using the repository browser.