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

###########################################################################
#
# GreenstoneXMLPlugout.pm -- the plugout module for Greenstone Archives
# A component of the Greenstone digital library software
# from the New Zealand Digital Library Project at the 
# University of Waikato, New Zealand.
#
# Copyright (C) 2006 New Zealand Digital Library Project
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
###########################################################################

package GreenstoneXMLPlugout;

use strict;
no strict 'refs';
no strict 'subs';

eval {require bytes};
use util;
use BasePlugout;
use docprint;

sub BEGIN {
    @GreenstoneXMLPlugout::ISA = ('BasePlugout');
}

my $arguments = [];

my $options = { 'name'     => "GreenstoneXMLPlugout",
        'desc'     => "{GreenstoneXMLPlugout.desc}",
        'abstract' => "no",
        'inherits' => "yes" };

sub new {
    my ($class) = shift (@_);
    my ($plugoutlist, $inputargs,$hashArgOptLists) = @_;
    push(@$plugoutlist, $class);

    push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});
    push(@{$hashArgOptLists->{"OptList"}},$options);

    my $self = new BasePlugout($plugoutlist,$inputargs,$hashArgOptLists);

    return bless $self, $class;
}

sub saveas
{
  my $self = shift (@_);
  my ($doc_obj,$doc_dir) = @_;

  my $outhandler;
  if ($self->{'debug'})
  {
    $outhandler = STDOUT;
    # can we do the xslt and still do debug mode?
  }
  else
  {
    my $output_dir = $self->get_output_dir();
    my $working_dir = &util::filename_cat($output_dir, $doc_dir);
    if (!&util::dir_exists($working_dir))
    {
      &util::mk_all_dir($working_dir);
    }
    $self->process_assoc_files ($doc_obj, $doc_dir, '');
    $self->process_metafiles_metadata ($doc_obj);
    my $output_file = &util::filename_cat($working_dir, "doc.xml");
    $self->open_xslt_pipe($output_file, $self->{'xslt_file'});
    if (defined $self->{'xslt_writer'})
    {
      $outhandler = $self->{'xslt_writer'};
    }
    else
    {
      $outhandler = $self->get_output_handler($output_file);
    }
  }

  binmode($outhandler,":utf8");

  $self->output_xml_header($outhandler,"Archive");
  my $section_output = &docprint::get_section_xml($doc_obj, $doc_obj->get_top_section());
  print $outhandler $section_output;
  $self->output_xml_footer($outhandler,"Archive");

  if (!$self->{'debug'})
  {
    if (defined $self->{'xslt_writer'})
    {
      $self->close_xslt_pipe();
    }
    else
    {
      close($outhandler);
    }

    $self->{'short_doc_file'} = util::filename_cat($doc_dir, "doc.xml");

    $self->store_output_info_reference($doc_obj);
  }
}
# /** saveas() **/

# Overriden for HDFS support
sub get_output_handler
{
  my $self = shift (@_);
  my ($output_file_name) = @_;
  if (&util::isHDFS($output_file_name))
  {
    open(*OUTPUT, &util::file_openfdcommand($output_file_name, '>'));
    return *OUTPUT;
  }
  else
  {
    return $self->SUPER::get_output_handler($output_file_name);
  }
}

sub get_new_doc_dir
{
  my $self = shift (@_);
  my ($working_info, $working_dir, $OID) = @_;
  my $doc_dir = "";
  my $doc_dir_rest = $OID;

  ###rint "!!GreenstoneXMLPlugout::get_new_doc_dir([working_info]," . $working_dir . "," . $OID . ")\n";

  # Remove any \ and / from the OID because we are about to generate a path
  # Remove ":" too, as otherwise they get confused with the protocols / drive letters
  $doc_dir_rest =~ s/[\:\\\/]//g;
  my $doc_dir_num = 0;
  my $created_directory = 0;
  do
  {
    if ($doc_dir_num > 0)
    {
      $doc_dir .= "/";
    }
#    if ($doc_dir_rest =~ s/^(.{1,3})//)
    if ($doc_dir_rest =~ s/^((D|HASH)?.{1,3})//i)
    {
      $doc_dir .= $1;
      $doc_dir_num++;
    }
    ###rint "!! - testing Path: " . $doc_dir . "\n";
    $created_directory = &util::mk_all_dir(&util::filename_cat($working_dir, $doc_dir . '.dir'));
    ###rint "-> result: |" . $created_directory . "|\n";
  }
  while ($doc_dir_rest ne "" && $doc_dir_num < 32 && !$created_directory);
  my $i = 0;
  my $doc_dir_base = $doc_dir;
  while (!$created_directory && $i < 256)
  {
    $i++;
    $doc_dir = $doc_dir_base . '-' . $i;
    ###rint "!! - testing Path: " . $doc_dir . "\n";
    $created_directory = &util::mk_all_dir(&util::filename_cat($working_dir, $doc_dir . '.dir'));
    ###rint "-> result: |" . $created_directory . "|\n";
  }
  if (!$created_directory)
  {
    die("Error! Failed to create directory for document: " . $doc_dir_base . "\n");
  }
  ###rint "!! Final Path: " . $doc_dir . ".dir\n";
  return $doc_dir . '.dir';
}

1;