#!/usr/bin/env perl

######################################################################
# This is the CGI-based server for querying the DBS database.  Queries
# are made as HTTP GET requests.  Responses come as text/plain result,
# with some additional DBS-specific reply headers.  Usually the result
# is in XML.  See the PythonAPI for the client side of this exchange.
#
# The server is hosted on CERN web servers and accesses the DBS Oracle
# database hosted at CERN.
#
# This server script requires the following additional components:
#  - Database parameter file which defines the database contact and
#    authentication parameters.  This file is stored in AFS directory
#    only accessible to DBS admins and the web server itself.  This
#    is currently /afs/cern.ch/cms/aprom/DBS/DBAccessInfo/DBParam.
#  - PhEDEx toolkit modules, which currently implement DBS access.
#    These are currently in /afs/cern.ch/cms/aprom/phedex/PHEDEX.
#  - Extra perl modules and the Oracle instant client libraries.
#    These are currently in /afs/cern.ch/cms/aprom/phedex/Tools.
#   
# The details about the query are returned in three extra HTTP reply
# headers: dbs-status-{code,message,detail}, plus the reply body.
# Of these, dbs-status-code and -message are always given; the former
# is a numeric code and the latter a textual version.  The third
# header dbs-status-detail may be present in errors and may explain
# in more detail what went wrong.  The status codes are as follows:
#
#  100      Success, reply body contains result
#  200-299  The request itself was not accepted by the server.
#  300-399  The parameters supplied in the request were not accepted.
#  400-499  The request was well-formed, but a runtime error occurred.
#  500-599  Requested data does not exist.

######################################################################
# Prepare the environment.  We can't source the environment setup
# scripts since they are for bourne shell.  Just hardcode minimal set.

BEGIN {
  use strict; use warnings; $^W=1;
  die "\$TNS_ADMIN not set\n" if ! $ENV{TNS_ADMIN};
  die "\$ORACLE_HOME not set\n" if ! $ENV{ORACLE_HOME};
}

use CGI qw(header param escapeHTML);
use DBI qw(:sql_types);
use XML::Parser;
use Text::Glob 'glob_to_regex';
use Error qw(:try);
$Text::Glob::strict_wildcard_slash = 0;

$file = 'out.txt';
open(INFO, ">$file");

######################################################################
# Main program

my $dbparams = $ENV{DBS_DBPARAM} || "/home/sekhri/cgi/PythonAPI/DBParam";
my $SAFE_NAME = qr|^[-A-Za-z0-9_.]+$|;
my $SAFE_PATH = qr|^[-A-Za-z0-9_./]+$|;
my $SAFE_TIERS = qr|^[-A-Za-z,]+$|;
# Known API calls
my %apis = (
  # Query side
  'getDatasetProvenance' => [ \&getDatasetProvenance, {
    path => REQUIRED, datatier => OPTIONAL } ],
  'getDatasetContents' => [ \&getDatasetContents, {
    path => REQUIRED } ],
  'getDatasetInfo' => [ \&getDatasetInfo, {
    path => REQUIRED } ],
  'getDatasetFiles' => [ \&getDatasetFiles, {
    path => REQUIRED } ],
  'listPrimaryDatasets' => [ \&listPrimaryDatasets, {
    pattern => OPTIONAL } ],
  'listProcessedDatasets' => [ \&listProcessedDatasets, {
    pattern => OPTIONAL } ],
  'listParameterSets' => [ \&listParameterSets, {
    pattern => OPTIONAL } ],
  'listApplications' => [ \&listApplications, {
    pattern => OPTIONAL } ],
  'listApplicationConfigs' => [ \&listApplicationConfigs, {
    pattern => OPTIONAL } ],

  # Legacy
  'listDatasets' => [ \&listProcessedDatasets, {
    pattern => OPTIONAL } ],

  # Update side, requires authentication (FIXME)
  'createPrimaryDataset' => [ \&createPrimaryDataset, {
    name => REQUIRED } ],
  'createProcessing' => [ \&createProcessing, {
    xmlinput => REQUIRED } ],
  'insertDatasetInfo' => [ \&insertDatasetInfo, {
    xmlinput => REQUIRED } ],
  'createFileBlock' => [ \&createFileBlock, {
    processing => REQUIRED } ],
  'createProcessedDataset' => [ \&createProcessedDataset, {
    path => REQUIRED } ],
  'insertEventCollections' => [ \&insertEventCollections, {
    xmlinput => REQUIRED } ],
  'mergeAndRemap' => [ \&mergeAndRemap, {
    xmlinput => REQUIRED } ],
  'insertFiles' => [ \&insertFiles, {
    xmlinput => REQUIRED } ]);

map { $$_[1]{api} = REQUIRED; $$_[1]{instance} = OPTIONAL } values %apis;
# Get parameters

my $api = param('api');
&reply_failure (200, "Bad request", "API call was not defined")
  if (! defined $api);
&reply_failure (300, "Bad data", "Requested API call was not recognised")
  if (! exists $apis{$api});

# Invoke the method
&checkParameters ($apis{$api}[1]);
&callApi ($apis{$api});

my($exceptionClass) = ();

sub throwException{
	my($myValue ,$myClass, $myMessage) = @_;
	$exceptionClass = $myClass;
	throw Error::Simple($myMessage,$myValue);
}

######################################################################
# Common routines.

# Make sure the call is valid.  Make sure all required arguments are
# present, and reject any excess arguments.
sub checkParameters
{
  my ($params) = @_;
  my @excess = grep (! exists $$params{$_}, param());
  my @missing = grep ($$params{$_}{REQUIRED} && ! defined param($_), keys %$params);
  if (@excess || @missing)
  {
    my $err = "";
    $err .= "Excess parameters @excess\n" if @excess;
    $err .= "Missing required parameters @missing\n" if @missing;
    &reply_failure (200, "Bad request", $err);
  }
}

# Call an API function.  Common error handling.
sub callApi
{
  my ($api) = @_;
  my $dbs;
  eval
  {
    $dbs = &connectToDBS();
    &{$$api[0]} ($dbs);
  };

  # If there was a failure, spit out an error.  Note that "exit" is a
  # special "die" call under mod_perl, so handle it gracefully.
  if ($@)
  {
    my $msg = $@;
    eval { $$dbs{DBH}->rollback(); $$dbs{DBH}->disconnect () };
    exit if ref $msg eq 'APR::Error' && $msg == ModPerl::EXIT;
    &reply_failure (402, "Execution error", $msg)
  }
  eval { $$dbs{DBH}->disconnect () };
  exit;
}

# Validate a path from the form argumens.
sub getPath
{
  my ($nameof, $optional) = @_;
  $nameof = 'path' if ! defined $nameof;
  return &checkPath (scalar param($nameof), $nameof, $optional);
}

# Validate a path
sub checkPath
{
  my ($path, $nameof, $optional) = @_;
  if (defined $path)
  {
    &reply_failure (300, "Bad data", "Invalid characters in $nameof")
      if ($path !~ /$SAFE_PATH/o);
    &reply_failure (300, "Bad data", "Expected /DATASET/TIER/OWNER for $nameof")
      if ($path !~ m|^/([^/]+)/([^/]+)/([^/]+)$|o);
    return ($1, $2, $3);
  }
  elsif (! $optional)
  {
    &reply_failure (200, "Bad request", "No $nameof specified");
  }
  else
  {
    return (undef, undef, undef);
  }
}

# Get a pattern and verify it is a valid one, and convert to a perl
# regular expression.  The patterns are shell globs.
sub getPattern
{
  my ($nameof, $optional) = @_;
  $nameof = 'pattern' if ! defined $nameof;
  return &checkPattern (scalar param($nameof), $nameof, $optional);
}

sub checkPattern
{
  my ($pattern, $nameof, $optional) = @_;
  if (defined $pattern && $pattern ne '')
  {
    my $rxpattern = eval { &glob_to_regex ($pattern) };
    &reply_failure (300, "Bad data", "Invalid glob expression $nameof: $@") if $@;
    return $rxpattern;
  }
  elsif (! $optional)
  {
    &reply_failure (200, "Bad request", "No $nameof specified");
  }
  else
  {
    return undef;
  }
}

# Connect to the DBS database.
sub connectToDBS
{
#my $instance = param('instance') || "DevMC/Reader";
  my $instance = param('instance') || "Anzar/Writer";
  #my $instance = param('instance') || "Production/Reader";
  #my $instance = param('instance') || "Dev/Reader";
  my $self = { DBCONFIG => "$dbparams:$instance" };
  my $dbh = eval { &connectToDatabase ($self) };
  &reply_failure (400, "Database connection failure", $@) if $@;
  &reply_failure (401, "Failed to connect to DBS", "") if ! $dbh;
  $SIG{INT} = 'DEFAULT'; # Restore ORACLE's swallowed signals.
  return $self;
}

# Print standard response headers.  We always print two extra response
# headers, "dbs-status-code:" and "dbs-status-message:", the former a
# numeric value and the latter the same in clear language.  In case of
# errors we may also add "dbs-status-detail:" header to expand on the
# cause of the error.
sub response_headers
{
  my ($code, $msg, $detail) = @_;
  my %args = (-dbs_status_code => $code,
  	      -dbs_status_message => $msg);
  if (defined $detail)
  {
    $detail =~ s/\n/ /sg;
    $args{dbs_status_detail} = $detail;
  }
  print header (-type => 'text/plain', %args);
}

# Generate a failure reply.
sub reply_failure
{
  my ($code, $msg, $detail, @info) = @_;
  $detail =~ s/\n+/ /sg; $detail =~ s/\s+$//s;
  &response_headers ($code, $msg, $detail);
  print @info;
  exit (1);

}

# Generate a success reply.
sub reply_success
{
  my (@data) = @_;
  &response_headers (100, "Success", undef);
  print @data;
  exit (0);
}

######################################################################
# Parse database connection arguments.
sub parseDatabaseInfo
{
    my ($self) = @_;

    if ($self->{DBCONFIG} =~ /(.*):(.*)/)
    {
	$self->{DBCONFIG} = $1;
	$self->{DBSECTION} = $2;
    }

    my $insection = $self->{DBSECTION} ? 0 : 1;
    open (DBCONF, "< $self->{DBCONFIG}")
	or die "$self->{DBCONFIG}: $!\n";

    while (<DBCONF>)
    {
	chomp; s/#.*//; s/^\s+//; s/\s+$//; s/\s+/ /g; next if /^$/;
	if (/^Section (\S+)$/) {
	    $insection = ($1 eq $self->{DBSECTION});
	} elsif (/^Interface (\S+)$/) {
	    $self->{DBH_DBITYPE} = $1 if $insection;
	} elsif (/^Database (\S+)$/) {
	    $self->{DBH_DBNAME} = $1 if $insection;
	} elsif (/^AuthDBUsername (\S+)$/) {
	    $self->{DBH_DBUSER} = $1 if $insection;
	} elsif (/^AuthDBPassword (\S+)$/) {
	    $self->{DBH_DBPASS} = $1 if $insection;
	} elsif (/^AuthRole (\S+)$/) {
	    $self->{DBH_DBROLE} = $1 if $insection;
	} elsif (/^AuthRolePassword (\S+)$/) {
	    $self->{DBH_DBROLE_PASS} = $1 if $insection;
	} else {
	    die "$self->{DBCONFIG}: $.: Unrecognised line\n";
	}
    }
    close (DBCONF);

    die "$self->{DBCONFIG}: database parameters not found\n"
	if (! $self->{DBH_DBITYPE} || ! $self->{DBH_DBNAME}
	    || ! $self->{DBH_DBUSER} || ! $self->{DBH_DBPASS});

    die "$self->{DBCONFIG}: role specified without username or password\n"
	if ($self->{DBH_DBROLE} && ! $self->{DBH_DBROLE_PASS});
}

# Create a connection to the database.
sub connectToDatabase
{
    my ($self, $identify) = @_;

    # If we have database configuration file, read it
    &parseDatabaseInfo ($self) if ($self->{DBCONFIG} && ! $self->{DBH_DBNAME});

    # Start a new connection.
    $dbh = DBI->connect ("DBI:$self->{DBH_DBITYPE}:$self->{DBH_DBNAME}",
	    		  $self->{DBH_DBUSER}, $self->{DBH_DBPASS},
			  { RaiseError => 1, AutoCommit => 0, PrintError => 0 });
    return undef if ! $dbh;

    # Acquire role if one was specified.  Do not use &dbexec() here
    # as it will expose the password used in the logs.
    if ($self->{DBH_DBROLE})
    {
	eval { $dbh->do ("set role $self->{DBH_DBROLE} identified by"
		         . " $self->{DBH_DBROLE_PASS}") };
	die "failed to authenticate to $self->{DBH_DBNAME} as"
	    . " $self->{DBH_DBUSER} using role $self->{DBH_DBROLE}\n"
	    if $@;
    }

    # Cache it and set some important parameters.
    $self->{DBH} = $dbh;
    $self->{DBH}{FetchHashKeyName} = "NAME_uc";
    $self->{DBH}{LongReadLen} = 4096;
    $self->{DBH}{RowCacheSize} = 10000;
    return $dbh;
}

# Tidy up SQL statement
sub dbsql
{
    my ($sql) = @_;
    $sql =~ s/--.*//mg;
    $sql =~ s/^\s+//mg;
    $sql =~ s/\s+$//mg;
    $sql =~ s/\n/ /g;
    return $sql;
}

# Simple utility to prepare a SQL statement
sub dbprep
{
    my ($dbh, $sql) = @_;
    return $dbh->prepare (&dbsql ($sql));
}

# Simple utility to prepare, bind and execute a SQL statement.
sub dbexec
{
    my ($dbh, $sql, %params) = @_;
    my $stmt = &dbprep ($dbh, $sql);
    my $rv = &dbbindexec ($stmt, %params);
    return wantarray ? ($stmt, $rv) : $stmt;
}

# Simple bind and execute a SQL statement.
sub dbbindexec
{
    my ($stmt, %params) = @_;

    while (my ($param, $val) = each %params) {
	$stmt->bind_param ($param, $val);
    }

    return $stmt->execute();
}

######################################################################
######################################################################
######################################################################
# Actual API implementation routines.  We code many of the queries for
# better efficiency directly against the schema as UtilsDBS isn't well
# geared for our purposes right now.

######################################################################
# List available primary datasets.  Optional pattern matches against
# the dataset name.
sub listPrimaryDatasets
{
  my ($dbs) = @_;

  # Get an optional pattern
  my $rxpattern = &getPattern('pattern', 1);

  # Fetch the list of datasets from the database.
  my $q = &dbexec($$dbs{DBH}, qq{
    select id, name from t_primary_dataset});

  my $out = "<?xml version='1.0' standalone='yes'?><dbs>";
  while (my ($id, $name) = $q->fetchrow())
  {
    next if (defined $rxpattern && $name !~ /$rxpattern/);
    $out .= "<primary-dataset id='$id' name='@{[&escapeHTML($name)]}'/>";
  }
  $out .= "</dbs>\n";

  # Spit out the result
  $$dbs{DBH}->disconnect ();
  &reply_success ($out);
}

######################################################################
# List available processed datasets.  Optional pattern matches against
# the full /primary/tier/name path of the dataset.
sub listProcessedDatasets
{
  my ($dbs) = @_;

  # Get an optional pattern
  my $rxpattern = &getPattern('pattern', 1);

  # Fetch the list of datasets from the database.
  my $q = &dbexec($$dbs{DBH}, qq{
    select
      procds.id,
      primds.name,
      procname.name,
      dt.name
    from t_processed_dataset procds
      join t_primary_dataset primds
        on primds.id = procds.primary_dataset
      join t_processing_name procname
        on procname.id = procds.name
      join t_data_tier dt
        on dt.id = procds.data_tier});

  my $out = "<?xml version='1.0' standalone='yes'?><dbs>";
  while (my ($id, $primary, $processed, $tier) = $q->fetchrow())
  {
    my $token = "/$primary/$tier/$processed";
    next if (defined $rxpattern && $token !~ /$rxpattern/);
    $out .= "<processed-dataset id='$id' path='@{[&escapeHTML($token)]}'/>";
  }
  $out .= "</dbs>\n";

  # Spit out the result
  $$dbs{DBH}->disconnect ();
  &reply_success ($out);
}

######################################################################
# List available parameter sets.  Optional pattern matches against the
# content of the parameter set.
sub listParameterSets
{
  my ($dbs) = @_;

  # Get an optional pattern
  my $rxpattern = &getPattern('pattern', 1);

  # Fetch the list of datasets from the database.
  my $q = &dbexec($$dbs{DBH}, qq{
    select id, hash, content from t_parameter_set});

  my $out = "<?xml version='1.0' standalone='yes'?><dbs>";
  while (my ($id, $hash, $content) = $q->fetchrow())
  {
    next if (defined $rxpattern && $content !~ /$rxpattern/);
    $out .= "<parameter-set id='$id' hash='@{[&escapeHTML($hash)]}'";
    $out .= " content='@{[&escapeHTML($content)]}'/>";
  }
  $out .= "</dbs>\n";

  # Spit out the result
  $$dbs{DBH}->disconnect ();
  &reply_success ($out);
}

######################################################################
# List available applications.  Optional pattern matches against the
# pseudo-path /family/executable/version.
sub listApplications
{
  my ($dbs) = @_;

  # Get an optional pattern
  my $rxpattern = &getPattern('pattern', 1);

  # Fetch the list of datasets from the database.
  my $q = &dbexec($$dbs{DBH}, qq{
    select a.id, af.name, a.executable, a.app_version
    from t_application a
     join t_app_family af on af.id = a.app_family});

  my $out = "<?xml version='1.0' standalone='yes'?><dbs>";
  while (my ($id, $fam, $exe, $ver) = $q->fetchrow())
  {
    my $token = "/$fam/$exe/$ver";
    next if (defined $rxpattern && $token !~ /$rxpattern/);
    $out .= "<application id='$id' family='@{[&escapeHTML($fam)]}'";
    $out .= " executable='@{[&escapeHTML($exe)]}'";
    $out .= " version='@{[&escapeHTML($ver)]}'/>";
  }
  $out .= "</dbs>\n";

  # Spit out the result
  $$dbs{DBH}->disconnect ();
  &reply_success ($out);
}

######################################################################
# List available application configurations.  Optional pattern matches
# against the application pseudo-path /family/executable/version.
sub listApplicationConfigs
{
  my ($dbs) = @_;

  # Get an optional pattern
  my $rxpattern = &getPattern('pattern', 1);

  # Fetch the list of datasets from the database.
  my $q = &dbexec($$dbs{DBH}, qq{
    select
      ac.id,
      a.id, af.name, a.executable, a.app_version,
      p.id, p.hash, p.content
    from t_app_config ac
     join t_application a on a.id = ac.application
       join t_app_family af on af.id = a.app_family
     join t_parameter_set p on p.id = ac.parameter_set});

  my $prev = undef;
  my $out = "<?xml version='1.0' standalone='yes'?><dbs>";
  while (my ($acid, $aid, $fam, $exe, $ver, $pid, $hash, $val) = $q->fetchrow())
  {
    my $token = "/$fam/$exe/$ver";
    next if (defined $rxpattern && $token !~ /$rxpattern/);
    $out .= "</application>" if defined $prev && $prev ne $token;
    if (! defined $prev || $prev ne $token)
    {
      $out .= "<application id='$aid' family='@{[&escapeHTML($fam)]}'";
      $out .= "  executable='@{[&escapeHTML($exe)]}'";
      $out .= "  version='@{[&escapeHTML($ver)]}'>";
      $prev = $token;
    }
    $out .= "<app-config id='$acid' psetid='$pid'";
    $out .= " hash='@{[&escapeHTML($hash)]}'";
    $out .= " content='@{[&escapeHTML($val)]}'/>";
  }
  $out .= "</application>" if defined $prev;
  $out .= "</dbs>\n";

  # Spit out the result
  $$dbs{DBH}->disconnect ();
  &reply_success ($out);
}

######################################################################
# Get dataset provenance.
sub getDatasetProvenance
{
  my ($dbs) = @_;

  # Parse parameters.  If 'datatier' is given, supply only ansers
  # matching those datatiers (comma-separated list of data tiers).
  my @path = &getPath ();
  my $parentspec = param('datatier');
  &reply_failure (300, "Bad data", "Invalid characters in datatier")
    if (defined $parentspec && $parentspec !~ /$SAFE_TIERS/o);

  # Fetch dataset provenance.  Verify all requested datatiers are known.
  fetchAll ($dbs, "data_tier");
  fetchAll ($dbs, "parentage_type");
  my @parents = (defined $parentspec ? split(",", $parentspec) : ());
  foreach my $t (@parents)
  {
    if (! grep ($_->{NAME} eq $t, @{$$dbs{PARENTAGE_TYPE}}))
    {
      $$dbs{DBH}->disconnect ();
      &reply_failure (301, "Bad parentage", "Parentage type '$t' not known");
    }
  }

  # Translate the dataset path to an id
  my $id = &datasetFromPath ($dbs, @path);

  # Fetch provenance info
  my $qdsinputs = &dbexec ($$dbs{DBH}, qq{
    select distinct
      pt.name,
      procds.id,
      procds.data_tier,
      primds.name,
      procname.name
    from t_event_collection ec
      join t_evcoll_parentage ep
	on ep.child = ec.id
      join t_event_collection ec2
	on ec2.id = ep.parent
      join t_processed_dataset procds
	on procds.id = ec2.processed_dataset
      join t_processing_name procname
	on procname.id = procds.name
      join t_primary_dataset primds
	on primds.id = procds.primary_dataset
      join t_parentage_type pt
	on pt.id = ep.type
    where ec.processed_dataset = :id},
    ":id" => $id);

  my $out = "<?xml version='1.0' standalone='yes'?><dbs>";
  $out .= "<processed-dataset id='$id' path='/$path[0]/$path[1]/$path[2]'>";
  while (my ($type, $id, $tier, $primary, $processed) = $qdsinputs->fetchrow())
  {
    next if defined $parentspec && ! grep ($type eq $_, @parents);
    $tier = (grep($_->{ID} eq $tier, @{$$dbs{DATA_TIER}}))[0]->{NAME};
    $out .= "<parent path='/$primary/$tier/$processed' tier='$tier' type='$type' id='$id'/>";
  }
  $out .= "</processed-dataset></dbs>\n";

  # Spit out the result
  $$dbs{DBH}->disconnect ();
  &reply_success ($out);
}

######################################################################
# Get the contents of the dataset: the blocks and event collections.
sub getDatasetContents
{
  my ($dbs) = @_;

  # Parse parameters
  my @path = &getPath ();

  # Translate the dataset path to an id
  my $id = &datasetFromPath ($dbs, @path);

  # Prepare output.
  my $out = "<?xml version='1.0' standalone='yes'?><dbs>";
  my $pathname = "/$path[0]/$path[1]/$path[2]";
  $out .= "<processed-dataset id='$id' path='$pathname'>";

  # Fetch event collections by which block they belong to
  my $q = &dbexec($$dbs{DBH}, qq{
    select distinct
      evc.id,
      evc.name,
      evc.events,
      evs.name,
      b.id,
      bs.name
    from t_event_collection evc
      join t_evcoll_file evf
        on evf.evcoll = evc.id
      left join t_evcoll_status evs
        on evs.id = evc.status
      join t_file f
        on f.id = evf.fileid
      join t_block b
        on b.id = f.inblock
      join t_block_status bs
        on bs.id = b.status
    where evc.processed_dataset = :id
    order by b.id, evc.name},
    ":id" => $id);

  my $prev = undef;
  while (my $row = $q->fetchrow_arrayref())
  {
    my ($id, $name, $events, $status, $block, $bstatus) = @$row;
    $bstatus = "" if ! defined $bstatus;
    $status = "" if ! defined $status;

    $out .= "</block>" if defined $prev && $prev != $block;
    if (! defined $prev || $prev != $block)
    {
      $out .= "<block id='$block' name='$pathname#$block' status='$bstatus'>";
      $prev = $block;
    }
    next if $name eq 'EvC_META';
    $name =~ s/^EvC_Run//;
    $out .= "<event-collection id='$id' name='$name' events='$events' status='$status'/>";
  }
  $out .= "</block>" if defined $prev;
  $out .= "</processed-dataset></dbs>\n";

  # Spit out the result
  $$dbs{DBH}->disconnect ();
  &reply_success ($out);
}

######################################################################
# Get the files and blocks of a dataset.
sub getDatasetFiles
{
  my ($dbs) = @_;

  # Parse parameters
  my @path = &getPath ();

  # Translate the dataset path to an id
  my $id = &datasetFromPath ($dbs, @path);

  # Prepare output.
  my $out = "<?xml version='1.0' standalone='yes'?><dbs>";
  my $pathname = "/$path[0]/$path[1]/$path[2]";
  my $blockbase = "/$path[0]/$path[2]";
  $out .= "<processed-dataset id='$id' path='$pathname'>";

  # Fetch files by which block they belong to
  my $q = &dbexec($$dbs{DBH}, qq{
    select
      f.id,
      f.logical_name,
      f.guid,
      f.filesize,
      f.checksum,
      fs.name,
      ft.name,
      b.id,
      b.files,
      b.bytes,
      bs.name
    from t_processed_dataset pd
      join t_processing p
        on p.primary_dataset = pd.primary_dataset
	and p.name = pd.name
      join t_block b
        on b.processing = p.id
      join t_block_status bs
        on bs.id = b.status
      left join t_file f
        on f.inblock = b.id
      left join t_file_status fs
        on fs.id = f.status
      left join t_file_type ft
        on ft.id = f.type
    where pd.id = :id
    order by b.id, f.logical_name},
    ":id" => $id);

  my $prev = undef;
  while (my $row = $q->fetchrow_arrayref())
  {
    my ($id, $lfn, $guid, $size, $cksum, $status, $type,
	$block, $bfiles, $bbytes, $bstatus) = @$row;
    $bstatus = "" if ! defined $bstatus;

    $out .= "</block>" if defined $prev && $prev != $block;
    if (! defined $prev || $prev != $block)
    {
      # FIXME: Should this obtain the block base name from the database
      # data (t_primary_dataset.name, t_processing->t_processing_name.name)
      # instead of building in the assumption the name is correct?
      $out .= "<block id='$block' name='$blockbase#$block' status='$bstatus'";
      $out .= " files='$bfiles' bytes='$bbytes'>";
      $prev = $block;
    }
    if (defined $id)
    {
      $status = "" if ! defined $status;
      $guid = "" if ! defined $guid;
      $out .= "<file id='$id' inblock='$block' guid='$guid' lfn='$lfn'";
      $out .= " checksum='$cksum' size='$size' status='$status' type='$type'/>";
    }
  }
  $out .= "</block>" if defined $prev;
  $out .= "</processed-dataset></dbs>\n";

  # Spit out the result
  $$dbs{DBH}->disconnect ();
  &reply_success ($out);
}

######################################################################
# Create a new primary dataset
sub createPrimaryDataset {
	my ($dbs) = @_;
      	# Parse parameters
	my $name = param('name');
	my ($id) = ();
	try {
		$id = &createPrimaryDatasetLogic ($dbs, $name);
	} catch	Error with {
		my $ex = shift;
		&reply_failure ($ex->value(), $exceptionClass, $ex->text());
	} finally {
		$$dbs{DBH}->disconnect ();
	};
	# Prepare output.
	my $out = "<?xml version='1.0' standalone='yes'?><dbs>";
	$out .= "<primary-dataset id='$id' name='$name'/></dbs>\n";

	&reply_success ($out);

}

sub createPrimaryDatasetLogic {
	my ($dbs, $name) = @_;

	&throwException(300, "Bad request",  "No name specified") if (! defined $name);
	&throwException (300, "Bad data", "Invalid characters in name") if ($name !~ /$SAFE_NAME/o);

	# Create the primary dataset
	my $obj = eval { &makeNamed($dbs, "primary_dataset", $name, 1) };
	#&throwException (303, "Object exists", "Object already exists: $@") if $@ && $@ =~ /ORA-00001/;
	&throwException (402, "Execution error", $@) if $@;
	&throwException (402, "Execution error", "Failed to fetch object id") if ! defined $$obj{id};

	$$dbs{DBH}->commit();
	return ($$obj{id});
}

######################################################################
# Create a new processing
sub createProcessing {
	my ($dbs) = @_;
      	# Parse parameters
	my $xmlinput = param('xmlinput');
	&reply_failure (200, "Bad request", "No xmlinput specified")
	if (! defined $xmlinput);

	# Parse the xmlinput.  We expect a structure like this:
	#   <processing name='' primary='' parent=''>
	#     <application executable='' version='' family=''/>
	#     <parameter-set hash='' content=''/>
	#   </processing>
	my ($name, $primary, $pname);
	my ($appexe, $appvers, $appfamily);
	my ($psethash, $psetcontent);
	eval {
		(new XML::Parser (Handlers => { Start => sub {
		my ($parser, $element, %attrs) = @_;
		if ($element eq 'processing') {
			$name = $attrs{name};
			$primary = $attrs{primary};
			$pname = $attrs{parent};
		} elsif ($element eq 'application') {
			$appexe = $attrs{executable};
			$appvers = $attrs{version};
			$appfamily = $attrs{family};
		} elsif ($element eq 'parameter-set') {
			$psethash = $attrs{hash};
			$psetcontent = $attrs{content};
		} } } ))->parse ($xmlinput);
	};
	&reply_failure (300, "Bad data", "Failed to parse XML input: $@") if $@;
	my ($id) = ();
	try {
		$id = &createProcessingLogic ($dbs, $name, $primary, $pname, $appexe, $appvers, $appfamily, $psethash, $psetcontent);
	} catch	Error with {
		my $ex = shift;
		&reply_failure ($ex->value(), $exceptionClass, $ex->text());
	} finally {
		$$dbs{DBH}->disconnect ();
	};
      	# Produce an output
	my $out = "<?xml version='1.0' standalone='yes'?><dbs>";
	$out .= "<processing id='$id' name='$name'/></dbs>\n";
	$$dbs{DBH}->disconnect ();
	&reply_success ($out);
}

sub createProcessingLogic {
	my ($dbs, $name, $primary, $pname, $appexe, $appvers, $appfamily, $psethash, $psetcontent) = @_;
	# Verify the parameters.
	&throwException (300, "Bad data", "Missing or invalid processing name")	if ! defined $name || $name eq '' || $name !~ /$SAFE_NAME/o;
	&throwException (300, "Bad data", "Missing or invalid primary name") if ! defined $primary || $primary eq '' || $primary !~ /$SAFE_NAME/o;
	&throwException (300, "Bad data", "Invalid processing parent name") if defined $pname && $pname ne '' && $pname !~ /$SAFE_NAME/o;
	&throwException (300, "Bad data", "Missing application parameters") if (! defined $appexe || $appexe eq '' || ! defined $appvers || $appvers eq '' || ! defined $appfamily || $appfamily eq '');
	&throwException (300, "Bad data", "Missing parameter-set parameters") if (! defined $psethash || $psethash eq '' || ! defined $psetcontent || $psetcontent eq '');

	# If a parent was named, make sure it exists and obtain the id.
	my $parent = undef;
	if (defined $pname && $pname ne '') {
		($parent) = &dbexec($$dbs{DBH}, qq{
			select p.id
			from t_processing p
			join t_processing_name pn
			on pn.id = p.name
			join t_primary_dataset pd
			on pd.id = p.primary_dataset
			where pn.name = :processing_name
			and pd.name = :primary_name},
			":processing_name" => $pname,
			":primary_name" => $primary)
			->fetchrow();
		&throwException (302, "Missing object", "No such parent processing $pname") if ! defined $parent;
	}

	# Get the ids for various things we need
	my ($primaryid) = &getNamed($dbs, "primary_dataset", $primary);

	# Proceed to create objects.  Create parameter set, application and
	# application configuration if they do not yet exist.
	my $pset = &makeObject($dbs, "parameter_set", "hash", {
		'hash' => $psethash,
		'content' => $psetcontent }, 0);
	my $app = &makeObject($dbs, "application", "", {
		'executable' => $appexe,
		'app_version' => $appvers,
		'app_family' => &makeNamed ($dbs, "app_family", $appfamily, 1) }, 0);
	my $appc = &makeObject($dbs, "app_config", "", {
		'application' => $app,
		'parameter_set' => $pset }, 0);
	#if processing doesnot already exist then get the id and return it.
	my $processing = ();
	#try{
		$processing = &makeObject($dbs, "processing", undef, {
			'primary_dataset' => $primaryid,
			'app_config' => $appc,
			'name' => &makeNamed($dbs, "processing_name", $name, 1),
			'is_open' => 'y',
			'input' => $parent }, 1);
	#} catch	Error with {
	#	my $ex = shift;
	#	if ($exceptionClass eq "Object exists" ) {
	#		$$processing{id} = &dbexec($$dbs{DBH}, qq{
	#			select p.id
	#			from t_processing p
	#			where 
	#				p.app_config = :app_config},
					#and p.input = :input},
					#			":app_config" => $$appc{id})->fetchrow();
				#":input" => $processingid);
				#	} else {
			#Rethrow the exception
			#		&reply_failure ($ex->value(), $exceptionClass, $ex->text());
			#	}
			#};
	# Spit out the result
	$$dbs{DBH}->commit();
	return ($$processing{id});
}

######################################################################
# Create a new file block
sub createFileBlock {
	my ($dbs) = @_;
	# Parse parameters
	my $processing = param('processing');
	my ($id) = ();
	try {
		$id = &createFileBlockLogic ($dbs, $processing);
	} catch	Error with {
		my $ex = shift;
		&reply_failure ($ex->value(), $exceptionClass, $ex->text());
	} finally {
		$$dbs{DBH}->disconnect ();
	};

	# Produce output
	my $out = "<?xml version='1.0' standalone='yes'?><dbs>";
	$out .= "<block id='$id' name='$processing#$id'/></dbs>\n";
	&reply_success ($out);
}

sub createFileBlockLogic {
	my ($dbs, $processing) = @_;
	&throwException (200, "Bad request", "No processing specified") if (! defined $processing);
	&throwException (300, "Bad data", "Invalid characters in processing") if ($processing !~ /$SAFE_PATH/o);
	&throwException (300, "Bad data", "Expecting /PRIMARY/NAME processing name") if ($processing !~ m|^/([^/]+)/([^/]+)$|o);

	# First find the processing.  This is required to exist.
	my ($owner) = &dbexec($$dbs{DBH}, qq{
		select p.id
		from t_processing p
		join t_processing_name pn
		on pn.id = p.name
		join t_primary_dataset pd
		on pd.id = p.primary_dataset
		where pn.name = :processing_name
		and pd.name = :primary_name},
		":processing_name" => $2,
		":primary_name" => $1)
		->fetchrow();
	&throwException (302, "Missing object", "No such processing $processing") if ! defined $owner;

	# Now create the block.  (FIXME: Do we give this a name?)
	my $obj = &makeObject($dbs, "block", undef, {
		'processing' => $owner,
		'status' => &makeNamed ($dbs, "block_status", "OPEN", 1),
		'files' => 0,
		'bytes' => 0 }, 0);

	# Spit out the result
	$$dbs{DBH}->commit();
	return ($$obj{id});
}

######################################################################
# Create a new primary dataset
sub createProcessedDataset {
	my ($dbs) = @_;

	# Parse parameters
	my @path = &getPath();
	my @input = &getPath('input', 1);

	# Verify the path components exist.  We require primary dataset and the
	# processing name to exist already, the latter created at the time the
	# processing entity was created.  The data tier is created on demand.
	# This allows us to catch some mistyped names.
	my $primaryName = $path[0];
	my $dataTier = $path[1];
	my $processedName = $path[2];
	my ($id) = ();
	try {
		$id = &createProcessedDatasetLogic ($dbs, $primaryName, $dataTier, $processedName, @input);
	} catch	Error with {
		my $ex = shift;
		&reply_failure ($ex->value(), $exceptionClass, $ex->text());
	} finally {
		$$dbs{DBH}->disconnect ();
	};
	my $path = "/" . join("/", @path);
	my $out = "<?xml version='1.0' standalone='yes'?><dbs>";
	$out .= "<processeed-dataset id='$id' path='$path'/></dbs>\n";
	&reply_success ($out);

}

sub createProcessedDatasetLogic {
	my ($dbs, $primaryName, $dataTier, $processedName, @input) = @_;

	my $primaryid = &getNamed($dbs, "primary_dataset", $primaryName,, 1)->{id};
	my $nameid = &getNamed($dbs, "processing_name", $processedName, 1)->{id};
	my $tierid = &makeNamed ($dbs, "data_tier", $dataTier, 1)->{id};

	# If an input was given, locate it. Note that &datasetFromPath will directly return failure to the client
	my $inputid = (defined $input[0] ? &datasetFromPath($$dbs, @input) : undef);

	# Create the processed dataset
	my $obj = &makeObject($dbs, "processed_dataset", undef, {
		'primary_dataset' => $primaryid,
		'data_tier' => $tierid,
		'name' => $nameid,
		'input' => $inputid }, 1);

	$$dbs{DBH}->commit();
	return($$obj{id});
}

######################################################################
# Insert files into a block of a processing.
sub insertFiles {
	my ($dbs) = @_;

	# Parse parameters
	my $xmlinput = param('xmlinput');
	&reply_failure (200, "Bad request", "No xmlinput specified") if (! defined $xmlinput);

	# Parse the xmlinput.  We expect a structure like this:
	#   <block name=>
	#     <file lfn= guid= checksum= size= status= type= />
	#   </block>
	my ($name, @files) = ();
	eval {
		(new XML::Parser (Handlers => { Start => sub {
		my ($parser, $element, %attrs) = @_;
		if ($element eq 'block') {
			$name = $attrs{name};
		} elsif ($element eq 'file') {
			push(@files, \%attrs);
		} } } ))->parse ($xmlinput);
	};
	&reply_failure (300, "Bad data", "Failed to parse XML input: $@") if $@;
	my ($primary, $processed, $blockid)  = (($name || '') =~ m!^/([^/]+)/([^/]+)\#(\d+)$!o);
	try {
		&insertFilesLogic ($dbs, $name, $primary, $processed, $blockid, @files);
	} catch	Error with {
		my $ex = shift;
		&reply_failure ($ex->value(), $exceptionClass, $ex->text());
	} finally {
		$$dbs{DBH}->disconnect ();
	};

	&reply_success ("<?xml version='1.0' standalone='yes'?><dbs/>");

}

sub insertFilesLogic {

	my ($dbs, $name, $primary, $processed, $blockid, @files) = @_;
	# Verify the parameters.

	&throwException (300, "Bad data", "Missing or invalid block name")
	if (! defined $name || $name eq ''
        || ! defined $primary || $primary eq ''
	|| ! defined $processed || $processed eq ''
	|| ! defined $blockid || $blockid eq '');

	foreach my $file (@files)  {
		&throwException (300, "Bad data", "Invalid file definition")
			if (! defined $$file{lfn} || $$file{lfn} !~ /$SAFE_PATH/o
				|| (defined $$file{guid} && $$file{guid} !~ /^[-A-Fa-f0-9]*$/o)
				|| ! defined $$file{checksum} || $$file{checksum} !~ /^cksum:\d+$/o
				|| ! defined $$file{size} || $$file{size} !~ /^\d+$/o
				|| (defined $$file{status} && $$file{status} !~ /^[A-Z]*$/o)
			|| (defined $$file{type} && $$file{type} !~ /^[A-Za-z]*$/o));
	}

	# Check the block exists and lock it.
	my ($blockid2) = &dbexec($$dbs{DBH}, qq{
		select id from t_block where id = :id for update},
		":id" => $blockid)->fetchrow ();
	&throwException (300, "Bad data", "No such block $name") if ! defined $blockid2;

	# Insert files into the block.  We do everything in one whopping
	# array operation, plus update the block in the end.  We do not
	# return the ids of the file objects in the database.
	my ($nfiles, $nbytes, %type, %status) = (0, 0);
	my $stmt = &dbprep($$dbs{DBH}, qq{
		insert into t_file
		(id, logical_name, guid, checksum, filesize, type, status, inblock)
		values (seq_file.nextval, ?, ?, ?, ?, ?, ?, ?)});
	my %params = ();
	foreach my $file (@files) {
		$type{$$file{type}} ||= &makeNamed ($dbs, "file_type", $$file{type}, 1) if defined $$file{type} && $$file{type} ne '';
		$status{$$file{status}} ||= &makeNamed ($dbs, "file_status", $$file{status}, 1)  if defined $$file{status} && $$file{status} ne '';

		push(@{$params{1}}, $$file{lfn});
		push(@{$params{2}}, $$file{guid});
		push(@{$params{3}}, $$file{checksum});
		push(@{$params{4}}, $$file{size});
		push(@{$params{5}}, $type{$$file{type}}{id});
		push(@{$params{6}}, $status{$$file{status}}{id});
		push(@{$params{7}}, $blockid);

		$nbytes += $$file{size};
		$nfiles++;
	}

	map { $stmt->bind_param_array ($_, $params{$_}) } keys %params;
	eval { $stmt->execute_array ({ ArrayTupleResult => [] }) };
	&throwException (303, "Object exists", "Object already exists: $@") if $@ && $@ =~ /ORA-00001/;
	&throwException (402, "Execution error", $@) if $@;

	&dbexec($$dbs{DBH}, qq{
		update t_block
		set files = files + :nfiles,
		bytes = bytes + :nbytes
		where id = :id},
		":id" => $blockid,
		":nfiles" => $nfiles,
		":nbytes" => $nbytes);

	$$dbs{DBH}->commit();
}

######################################################################
# Insert event collections with parentage and files.
sub insertEventCollections {
	my ($dbs) = @_;
   
	# Parse parameters
	my $xmlinput = param('xmlinput');
	&reply_failure (200, "Bad request", "No xmlinput specified") if (! defined $xmlinput);

	# Parse the xmlinput.  We expect a structure like this:
	#   <processed-dataset path=>
	#     ( <event-collection name= events= status=>
	#          <parent name= type=/> +
	#          <file lfn=/> +
	#       </event-collection> ) +
	#   </block>
	my ($path, @path, @evcs) = ();
	eval  {
		(new XML::Parser (Handlers => { Start => sub {
		my ($parser, $element, %attrs) = @_;
		if ($element eq 'processed-dataset') {
			$path = $attrs{path};
		} elsif ($element eq 'event-collection') {
			push(@evcs, \%attrs);
			$evcs[$#evcs]{parents} = [];
			$evcs[$#evcs]{files} = [];
		} elsif ($element eq 'parent') {
			push(@{$evcs[$#evcs]{parents}}, \%attrs);
		} elsif ($element eq 'file') {
			push(@{$evcs[$#evcs]{files}}, \%attrs);
		} } } ))->parse ($xmlinput);
	};
	&reply_failure (300, "Bad data", "Failed to parse XML input: $@") if $@;
	try {
		&insertEventCollectionsLogic ($dbs, $path,  @evcs);
	} catch	Error with {
		my $ex = shift;
		&reply_failure ($ex->value(), $exceptionClass, $ex->text());
	} finally {
		$$dbs{DBH}->disconnect ();
	};
	&reply_success ("<?xml version='1.0' standalone='yes'?><dbs/>");

}

sub insertEventCollectionsLogic {
	my ($dbs, $path, @evcs) = @_;
	
	# Verify the parameters.
	@path = &checkPath ($path, 'path');
	&throwException (300, "Bad data", "Missing or invalid processed dataset") if ! @path;

	foreach my $evc (@evcs) {
		&throwException (300, "Bad data", "Invalid event collection")
			if (! defined $$evc{name} || $$evc{name} !~ /$SAFE_PATH/o
			|| ! defined $$evc{events} || $$evc{events} !~ /^\d+$/o
			|| (defined $$file{status} && $$file{status} !~ /^[A-Z]*$/o)
			|| ! @{$$evc{files}});
	
		foreach my $p (@{$$evc{parents}}) {
			&throwException (300, "Bad data", "Invalid parentage")
				if (! defined $$p{name} || $$p{name} !~ /$SAFE_PATH/o
				|| ! defined $$p{type} || $$p{type} !~ /^[A-Za-z]+$/o);
			}

		foreach my $f (@{$$evc{files}}) {
			&throwException (300, "Bad data", "Invalid file")  if (! defined $$f{lfn} || $$f{lfn} !~ /$SAFE_PATH/o);
		}
	}

	# Check the dataset exists and lock it.
	my $procds = &datasetFromPath ($dbs, @path, "for update");
	&throwException (300, "Bad data", "No such processed dataset $path") if ! defined $procds;

	# Insert first the event collections, then parentage and files.
	# FIXME: Verify that the named parents and files exist!
	my $estmt = &dbprep($$dbs{DBH}, qq{
		insert into t_event_collection
		(id, processed_dataset, name, events, status)
		values (seq_event_collection.nextval, ?, ?, ?, ?)});
	my $pstmt = &dbprep($$dbs{DBH}, qq{
		insert into t_evcoll_parentage (id, parent, child, type)
		select seq_evcoll_parentage.nextval, p.id, c.id, ?
		from t_event_collection p, t_event_collection c
		where p.name = ? and c.name = ?});
	my $fstmt = &dbprep($$dbs{DBH}, qq{
		insert into t_evcoll_file (id, evcoll, fileid)
		select seq_evcoll_file.nextval, e.id, f.id
		from t_event_collection e, t_file f
		where e.name = ? and f.logical_name = ?});
	my (%eparams, %pparams, %fparams, %type, %status) = ();
	foreach my $evc (@evcs) {
		$status{$$evc{status}} ||= &makeNamed ($dbs, "evcoll_status", $$evc{status}, 1) if defined $$evc{status} && $$evc{status} ne '';
		push(@{$eparams{1}}, $procds);
		push(@{$eparams{2}}, $$evc{name});
		push(@{$eparams{3}}, $$evc{events});
		push(@{$eparams{4}}, $status{$$evc{status}}{id});

		foreach my $p (@{$$evc{parents}}) {
			$type{$$p{type}} ||= &makeNamed ($dbs, "parentage_type", $$p{type}, 1);
			push(@{$pparams{1}}, $type{$$p{type}}{id});
			push(@{$pparams{2}}, $$p{name});
			push(@{$pparams{3}}, $$evc{name});
		}

		foreach my $f (@{$$evc{files}}) {
			push(@{$fparams{1}}, $$evc{name});
			push(@{$fparams{2}}, $$f{lfn});
		}
	}

	eval {
		if (keys %eparams) {
			map { $estmt->bind_param_array ($_, $eparams{$_}) } keys %eparams;
			$estmt->execute_array ({ ArrayTupleResult => [] });
		}

		if (keys %pparams) {
			map { $pstmt->bind_param_array ($_, $pparams{$_}) } keys %pparams;
			$pstmt->execute_array ({ ArrayTupleResult => [] });
		}

		if (keys %fparams) {
			map { $fstmt->bind_param_array ($_, $fparams{$_}) } keys %fparams;
			$fstmt->execute_array ({ ArrayTupleResult => [] });
		}
	};

	&throwException (303, "Object exists", "Object already exists: $@") if $@ && $@ =~ /ORA-00001/;
	&throwException (402, "Execution error", $@)  if $@;

	# Spit out the result
	$$dbs{DBH}->commit();
}

sub mergeAndRemap {
	my ($dbs) = @_;

	# Parse parameters
	my $xmlinput = param('xmlinput');
	&reply_failure (200, "Bad request", "No xmlinput specified")
	if (! defined $xmlinput);
	#print INFO "XMLINPUT is \n";
	#print INFO $xmlinput;
  
	my ($path, @path, @evcs, @evcsmerged,) = ();
	eval {
		(new XML::Parser (Handlers => { Start => sub {
		my ($parser, $element, %attrs) = @_;
		if ($element eq 'processed-dataset') {
			$path = $attrs{path};
		} elsif ($element eq 'event-collection-in') {
			push(@evcs, \%attrs);
			$evcs[$#evcs]{parents} = [];
			$evcs[$#evcs]{files} = [];
		} elsif ($element eq 'parent-in') {
			push(@{$evcs[$#evcs]{parents}}, \%attrs);
		} elsif ($element eq 'file-in') {
			push(@{$evcs[$#evcs]{files}}, \%attrs);
		} elsif ($element eq 'event-collection') {
			push(@evcsmerged, \%attrs);
			$evcsmerged[$#evcsmerged]{parents} = [];
			$evcsmerged[$#evcsmerged]{files} = [];
		} elsif ($element eq 'parent') {
			push(@{$evcsmerged[$#evcsmerged]{parents}}, \%attrs);
		} elsif ($element eq 'file') {
			push(@{$evcsmerged[$#evcsmerged]{files}}, \%attrs);
		} } } ))->parse ($xmlinput);
	};

	# Verify the parameters.
	&reply_failure (300, "Bad data", "Failed to parse XML input: $@") if $@;
	@path = &checkPath ($path, 'path');
	&reply_failure (300, "Bad data", "Missing or invalid processed dataset") if ! @path;
        #Get the ID of t_evcoll_status for status name as merged
        #If status merged doesnot exist then create one
	$ecsid = ${&makeNamed ($dbs, "evcoll_status", "merged", 1)}{id};
	#print INFO "\nSTATUS ID   $ecsid \n";
	@plist  = ();#parent list of id
	@ptlist  = ();#parentage type list of id for parents
	@cptlist  = ();#parentage type list of id for child
	@clist  = ();#child list of id
	@eclist  = ();#evecent collection list of id

	foreach my $evc (@evcs) {
		&reply_failure (300, "Bad data", "Invalid event collection")
		if (! defined $$evc{name} || $$evc{name} !~ /$SAFE_PATH/o
		|| ! defined $$evc{events} || $$evc{events} !~ /^\d+$/o
		|| (defined $$file{status} && $$file{status} !~ /^[A-Z]*$/o)
		|| ! @{$$evc{files}});
  
		#print INFO "\n  $$evc{name} ";

		$gecid = ();
		foreach my $f (@{$$evc{files}})	{
			&reply_failure (300, "Bad data", "Invalid file") if (! defined $$f{lfn} || $$f{lfn} !~ /$SAFE_PATH/o);
			# Get all the parents and ECID and push it in the array
			my ($q) = &dbexec($$dbs{DBH}, qq{
				select p.parent, ec.id, pt.id
				from t_evcoll_parentage p, t_file f,t_event_collection ec,t_evcoll_file ecf, t_parentage_type pt
				where 
				ec.id = p.child
				and ecf.evcoll = ec.id
				and ecf.fileid = f.id
				and p.type = pt.id
				and ec.name = :ec_name
				and ec.events = :ec_events
				and f.logical_name = :f_logical_name},
				":ec_name" => $$evc{name},
				":ec_events" => $$evc{events},
				":f_logical_name" => $$f{lfn});
			#push all the parent, evcoll id and parentage type in lists
			while (my ($parent, $ecid, $ptype) = $q->fetchrow()) {
				#print INFO "\nPARENT   $parent \n";
				#print INFO "\nECID   $ecid \n";
				#print INFO "\nPTYPE   $ptype \n";
				push(@plist, $parent);	    
				push(@ptlist, $ptype);	    
				push(@eclist, $parent);	    
				$gecid = $ecid;
                	}
		
		}#//For each file
		# Get all the child and parentage type of this ECID and push it in the array
		my ($q1) = &dbexec($$dbs{DBH}, qq{
			select p.child, p.type
			from t_evcoll_parentage p, t_evcoll_parentage pt
			where 
			p.type = pt.id
			and p.parent = :ec_id},
			":ec_id" => $gecid);
		while (my ($child, $ptype) = $q1->fetchrow()) {
			#print INFO "\nCHILD   $child \n";
			#print INFO "\nPTYPE   $ptype \n";
			push(@clist, $child);	    
			push(@cptlist, $ptype);	    
		}
		#update the event collection status to be merged
		&dbexec($$dbs{DBH}, qq{
			update t_event_collection
			set status = :status
			where id = :id},
		        ":id" => $gecid,
			":status" => $ecsid);
				  
	}#For each EVC

	#Get the processed dataset id in which the new event collection neeeds to get inserted.
	my $procds = &datasetFromPath ($dbs, @path);
	&reply_failure (300, "Bad data", "No such processed dataset $path") if ! defined $procds;

	#print INFO "Processed dataset id is $procds";
	#Now insert the new Merged EventCollection. Call insertEventCollection to do the dirty work
	my $estmt = &dbprep($$dbs{DBH}, qq{
		insert into t_event_collection
		(id, processed_dataset, name, events, status)
		values (seq_event_collection.nextval, :proid ,:name, :events, :status)
		returning id into :id});
	my $fstmt = &dbprep($$dbs{DBH}, qq{
		insert into t_evcoll_file (id, evcoll, fileid)
		select seq_evcoll_file.nextval, e.id, f.id
		from t_event_collection e, t_file f
		where e.name = :ev_name and f.logical_name = :f_logical_name});

	my $obj = ();
	foreach my $evc (@evcsmerged) {
		$statusid = ${&makeNamed ($dbs, "evcoll_status", "final", 1)}{id};
		$estmt->bind_param(":proid", $procds);
		$estmt->bind_param(":name", $$evc{name});
		$estmt->bind_param(":events", $$evc{events});
		$estmt->bind_param(":status", $statusid);
		$estmt->bind_param_inout(":id", \$$obj{id}, 10, { TYPE => SQL_INTEGER });
		foreach my $f (@{$$evc{files}}) {
			$fstmt->bind_param(":ev_name", $$evc{name});
			$fstmt->bind_param(":f_logical_name", $$f{lfn});
		}
	}
	$estmt->execute ();
	$fstmt->execute ();
	my ($ecidmerged) = $$obj{id};
	&reply_failure (300, "Bad data", "Could not insert a new Event Collection") if ! defined $ecidmerged;
	#print INFO "EV ID that just got inserted is $ecidmerged \n";

	#insert all the new parents and child relationships
	my (%pparams) = ();
	my $pstmt = &dbprep($$dbs{DBH}, qq{
		insert into t_evcoll_parentage
		(id, parent, child, type)
		values (seq_evcoll_parentage.nextval, ?, ?, ?)});
	for ($count = 0; $count != @plist; $count++) {
		push(@{$pparams{1}}, $plist[$count]);
		push(@{$pparams{2}}, $ecidmerged);
		push(@{$pparams{3}}, $ptlist[$count]);
		#print INFO "\$plist[$count] $plist[$count]\n";
		#print INFO "ecidmerged $ecidmerged\n";
		#print INFO "\$ptlist[$count] $ptlist[$count]\n";
	}
	for ($count = 0; $count != @clist; $count++) {
		push(@{$pparams{1}}, $ecidmerged);
		push(@{$pparams{2}}, $clist[$count]);
		push(@{$pparams{3}}, $cptlist[$count]);
		#print INFO "ecidmerged $ecidmerged\n";
		#print INFO "\$clist[$count] $clist[$count]\n";
		#print INFO "\$cptlist[$count] $cptlist[$count]\n";
	}

	eval {
		if (keys %pparams) {
			#print INFO "inside keys ppram\n";
			map { $pstmt->bind_param_array ($_, $pparams{$_}) } keys %pparams;
			$pstmt->execute_array ({ ArrayTupleResult => [] });
		}
	};
	&reply_failure (402, "Execution error", $@) if $@;

	$$dbs{DBH}->commit();
	$$dbs{DBH}->disconnect ();
	#close(INFO);
	&reply_success ("<?xml version='1.0' standalone='yes'?><dbs/>");
}
    
######################################################################
# Schema utilities.
sub datasetFromPath
{
  my ($dbs, $primary, $tier, $processed, $lock) = @_;
  $lock ||= "";
  my ($id) = &dbexec($$dbs{DBH}, qq{
    select procds.id
    from t_processed_dataset procds
      join t_primary_dataset primds
        on primds.id = procds.primary_dataset
      join t_processing_name proname
        on proname.id = procds.name
      join t_data_tier dt
        on dt.id = procds.data_tier
    where proname.name = :procname
      and primds.name = :primname
      and dt.name = :tiername
    $lock},
    ":primname" => $primary,
    ":procname" => $processed,
    ":tiername" => $tier)
    ->fetchrow ();

  if (! defined $id )
  {
    $$dbs{DBH}->disconnect ();
    &reply_failure (302, "Missing object",
      "The dataset /$primary/$tier/$processed does not exist");
  }

  return $id;
}

# Simple tool to fetch everything from a table.  Useful for various
# mass fetch from various meta-data type tables.  Returns an array
# of hashes, where each hash has keys with the column names.
sub fetchAll
{
    my ($dbs, $kind) = @_;
    return $$dbs{uc($kind)} = &dbexec($$dbs{DBH}, qq{select * from t_$kind})
      ->fetchall_arrayref ({});
}

# Fetch a named object from the database, if one doesn't exist, make
# one.  Returns a hash with 'id' and 'name' set appropriately.
sub makeNamed
{
  my ($dbs, $kind, $name, $optional) = @_;
  my $obj = $optional ? &getNamed($dbs, $kind, $name) : { 'name' => $name };
  if (! defined $$obj{id})
  {
    my $stmt = &dbprep($$dbs{DBH}, qq{
      insert into t_$kind (id, name)
      values (seq_$kind.nextval, :name)
      returning id into :id});
    $stmt->bind_param(":name", $name);
    $stmt->bind_param_inout(":id", \$$obj{id}, 10, { TYPE => SQL_INTEGER });
    $stmt->execute ();
  }
  return $obj;
}

# Fetch a named object from the database.  Returns a hash with 'id'
# and 'name' set; the id will be null if no entity exists.
sub getNamed
{
  my ($dbs, $kind, $name, $required) = @_;
  my ($id) = &dbexec($$dbs{DBH}, qq{
    select id from t_$kind where name = :name},
    ":name" => $name)->fetchrow();
   
  &reply_failure (302, "Missing object", "No such $required $name")
    if ! defined $id && defined $required;
  return { 'id' => $id, 'name' => $name };
}

# Create an object in the database.  Takes a hash of object attributes,
# which should be the names of the columns to the database.  Each hash
# element may map to a scalar value, or to another hash with 'id' set.
# On return, the object's 'id' has been set.

							
sub makeObject
{
  my ($dbs, $kind, $keycheck, $attrs, $except) = @_;
  my $id = $$attrs{id};
  my @names = sort keys %$attrs;
  my %params = ();
  foreach my $name (@names)
  {
    my $val = $$attrs{$name};
    $params{$name} = ref $val ? $$val{id} : $val;
  }

  # Check the object doesn't already exist if so requested.
  if (! defined $id && defined $keycheck)
  {
    my @matching = grep(/$keycheck/, @names);
    ($id) = &dbexec($$dbs{DBH}, "select id from t_$kind where "
      . join(" and ", map { "$_ = :param_$_" } @matching),
      map { (":param_$_" => $params{$_}) } @matching)->fetchrow();
  }
  	      
  #print INFO "\nkind is $kind\n";
  if (! defined $id)
  {
    # Prepare a SQL statement
    my $sql = "insert into t_$kind (id, " . join(", ", @names) . ") values ("
      . "seq_$kind.nextval, " . join (", ", map { ":param_$_" } @names) . ") "
      . "returning id into :id";
    my $stmt = &dbprep($$dbs{DBH}, $sql);
    $stmt->bind_param_inout(":id", \$id, 10, { TYPE => SQL_INTEGER });
    map { $stmt->bind_param(":param_$_", $params{$_}) } keys %params;
    # Execute
    eval { $stmt->execute() };
    &throwException (303, "Object exists", "Object already exists: $@")
      if $@ && $@ =~ /ORA-00001/ && $except;
    &throwException (402, "Execution error", $@)
      if $@;
    &throwException (402, "Execution error", "Failed to fetch object id")
      if ! defined $id;
  } else {
	  #print INFO "id is  $id\n";
  }

  $$attrs{id} = $id;
  return $attrs;
}

######################################################################
### FIXME! IGNORE IGNORE IGNORE IGNORE IGNORE IGNORE IGNORE FIXME!
######################################################################
sub makeMediator
{
    my ($self) = @_;
    return $self->{CACHED_MEDIATOR} if $self->{CACHED_MEDIATOR};

    my $user = getpwuid($<);
    my $host = &getfullhostname();
    my $app = $0; $app =~ s|.*/||;
    my $id = "host=$host#user=$user#app=$app";
    my $m = (grep($_->{NAME} eq $id, @{$self->{PERSON}}))[0];
    return $self->{CACHED_MEDIATOR} = $m if $m;

    $self->{CACHED_MEDIATOR} = $m = { NAME => $id,
	    			      CONTACT_INFO => "$user\@$host",
				      DISTINGUISHED_NAME => "/CN=$id" };
    return $self->newObject ($m, 'person', $m);
}

sub makePerson
{
    my ($self, $object) = @_;
    return $self->{CACHED_PERSON} if $self->{CACHED_PERSON};

    die "no ~/.globus/usercert.pem, cannot identify person\n"
        if ! -f "$ENV{HOME}/.globus/usercert.pem";

    my $email = scalar getpwuid($<) . '@' . &getfullhostname();
    my $certemail = qx(openssl x509 -in \$HOME/.globus/usercert.pem -noout -email 2>/dev/null);
    my $dn = qx(openssl x509 -in \$HOME/.globus/usercert.pem -noout -subject 2>/dev/null);
    my $name = (getpwuid($<))[6]; $name =~ s/,.*//;
    do { chomp($certemail); $email = $certemail }  if $certemail;
    do { chomp($dn); $dn =~ s/^subject\s*=\s*// } if $dn;
    do { $name = $1 } if ($dn && $dn =~ /CN=(.*?)( \d+)?(\/.*)?$/);

    my $p = (grep ($_->{NAME} eq $name, @{$self->{PERSON}}))[0];
    return $self->{CACHED_PERSON} = $p if $p;

    $self->{CACHED_PERSON} = $p = { NAME => $name,
				    CONTACT_INFO => $email,
				    DISTINGUISHED_NAME => $dn };
    return $self->newObject ($p, 'person', $p);
}

sub addHistory
{
  my ($self, $object, $person, $kind);
	# Update object history.  Note that if newObject was called by
	# makeMediator(), we produce a recursive call, but it all works
	# correctly because of the second time around it returns the
	# cached object, and we've already set the ID above on it.
	&dbexec ($self->{DBH}, qq{
	    insert into t_object_history
	    (object_type, object_id, operation, at, person, mediator)
	    values (:objtype, :objid, 'INSERT', :now, :person, :mediator)},
	    ":objtype" => uc("t_$kind"),
	    ":objid" => $object->{ID},
	    ":now" => &mytimeofday(),
	    ":person" => $person->{ID},
	    ":mediator" => $self->makeMediator()->{ID});
}

# Get the snapshot of the complete dataset in xml
sub getDatasetInfo {
	my ($dbs) = @_;
	# Parse parameters
	my @path = &getPath ();

	# Translate the dataset path to an id
	my $processid = &datasetFromPath ($dbs, @path);

	# Prepare output.
	my $out = "<?xml version='1.0' standalone='yes'?><dbs>";
	my $primaryid = &getNamed($dbs, "primary_dataset", $path[0], 1)->{id};
	my $pathname = "/$path[0]/$path[1]/$path[2]";
	$out .= "<primary-dataset id='$primaryid' name='$path[0]'>\n";
	$out .= "<processed-dataset id='$processid' path='$pathname'>\n";

	# Fetch event collections in this processed dataset
	$q = &dbexec($$dbs{DBH}, qq{
		select 	evc.id,	evc.name, evc.events, evs.name
		from t_event_collection evc, t_evcoll_status evs
		where 
			evs.id = evc.status
			and evc.processed_dataset = :id},
		":id" => $processid);
	while (my $row = $q->fetchrow_arrayref()) {
		my ($id, $name, $events, $status) = @$row;
		$status = "" if ! defined $status;
		$out .= "<event-collection id='$id' name='$name' events='$events' status='$status'>\n";
		#For each Event Collection get the list of fileids
		my $q1 = &dbexec($$dbs{DBH}, qq{
			select evf.fileid, f.logical_name
			from t_evcoll_file evf, t_file f
			where 
				evf.fileid = f.id
				and evf.evcoll = :id},
			":id" => $id);
		while (my ($fileid, $lfn) = $q1->fetchrow()) {
			$out .= "<file id='$fileid' lfn='$lfn'/>\n";
		}
		#For each Event Collection get the parent Event Collection
		my $q2 = &dbexec($$dbs{DBH}, qq{
		select 	evc.id,	evc.name, evc.events, evs.name, pt.name
		from t_event_collection evc, t_evcoll_status evs, t_evcoll_parentage evp, t_parentage_type pt
		where 
			evs.id = evc.status
			and evp.child = :child
			and evp.parent = evc.id
			and evp.type = pt.id},
		":child" => $id);
		while (my ($id, $name, $events, $status, $ptype) = $q2->fetchrow()) {
			$out .= "<parent id='$id' name='$name' events='$events' status='$status' type='$ptype'/>\n";
		}
		$out .= "</event-collection>\n";

	

	}
	$out .= "</processed-dataset>\n";
	#Fetch all the processing with application in this Primary dataset
	my $q3 = &dbexec($$dbs{DBH}, qq{
		select p.id, pn.name, p.is_open, app.executable, app.app_version, appf.name, ps.hash, ps.content
		from t_processing p, t_processing_name pn, t_app_config appc, t_application app, t_app_family appf, t_parameter_set ps
		where 
			p.app_config = appc.id 
			and p.name = pn.id
			and appc.application = app.id
			and appc.parameter_set = ps.id
			and app.app_family = appf.id
			and p.primary_dataset = :primid},
		":primid" => $primaryid);
	while (my ($processingid, $processingname, $isopen, $exe, $version, $family, $hash, $content) = $q3->fetchrow()) {
		$out .= "\n<processing id='$processingid' name='$processingname' is-open='$isopen' executable='$exe' version='$version' family='$family' hash='$hash' content='$content'>\n";

		#Get all the Blocks inside this Processing
		my $q4 = &dbexec($$dbs{DBH}, qq{
			select b.id, b.files, b.bytes, bs.name
			from t_block b, t_block_status bs
			where 
				b.status = bs.id 
				and b.processing = :procid},
			":procid" => $processingid);
		while (my ($bid, $bfiles, $bbytes, $status) = $q4->fetchrow()) {
			$out .= "<block id='$bid' files='$bfiles' bytes='$bbytes' status='$status'>\n";
			#Fetch all the files inside this block
			my $q5 = &dbexec($$dbs{DBH}, qq{
				select f.id, f.guid, f.logical_name, f.checksum,f.filesize, ft.name, fs.name
				from t_file f, t_file_type ft, t_file_status fs
				where 
					f.status = fs.id
					and f.type = ft.id
					and f.inblock = :blockid},
				":blockid" => $bid);
			while (my ($fid, $fguid, $flogicalname, $fchecksum, $ffilesize, $ftype, $fstatus) = $q5->fetchrow()) {
				$out .= "<afile id='$fid' guid='$fguid' lfn='$flogicalname' checksum='$fchecksum' size='$ffilesize' inblock='$bid' type='$ftype' status='$fstatus'/>\n";
			}
		 	$out .= "</block>\n";
		}
		 $out .= "</processing>\n";
	}
	$out .= "</primary-dataset></dbs>\n";
	
	$$dbs{DBH}->disconnect ();
	&reply_success ($out);
}

sub insertDatasetInfo {
	my ($dbs) = @_;

	# Parse parameters
	my $xmlinput = param('xmlinput');
	&reply_failure (200, "Bad request", "No xmlinput specified") if (! defined $xmlinput);
	print INFO "xmlinput $xmlinput\n";
	my ($primaryDatasetName, $path,  @evcs, @processing,) = ();
	eval {
		(new XML::Parser (Handlers => { Start => sub {
		my ($parser, $element, %attrs) = @_;
		if ($element eq 'primary-dataset') {
			$primaryDatasetName = $attrs{name};
		}elsif ($element eq 'processed-dataset') {
			$path = $attrs{path};
		} elsif ($element eq 'event-collection') {
			push(@evcs, \%attrs);
			$evcs[$#evcs]{parents} = [];
			$evcs[$#evcs]{files} = [];
		} elsif ($element eq 'parent') {
			push(@{$evcs[$#evcs]{parents}}, \%attrs);
		} elsif ($element eq 'file') {
			push(@{$evcs[$#evcs]{files}}, \%attrs);
		} elsif ($element eq 'processing') {
			push(@processing, \%attrs);
			$processing[$#processing]{block} = [];
			$processing[$#processing]{files} = [];
		} elsif ($element eq 'block') {
			push(@{$processing[$#processing]{block}}, \%attrs);
		} elsif ($element eq 'afile') {
			push(@{$processing[$#processing]{files}}, \%attrs);
		} } } ))->parse ($xmlinput);
	};

	# Verify the parameters.
	&reply_failure (300, "Bad data", "Failed to parse XML input: $@") if $@;

	try {	
		&insertDatasetInfoLogic ($dbs, $primaryDatasetName, $path,  \@evcs, \@processing);
		#&insertDatasetInfoLogic ($dbs, $primaryDatasetName, $path,   @processing);
	} catch	Error with {
		my $ex = shift;
		&reply_failure ($ex->value(), $exceptionClass, $ex->text());
	} finally {
		$$dbs{DBH}->disconnect ();
	};
      	# Produce an output
	my $out = "<?xml version='1.0' standalone='yes'?><dbs/>";
	&reply_success ($out);

}
	
# Insert the contents of a remote DBS into this local DBS
sub insertDatasetInfoLogic {
	#To pass two arrays as a parameter you have to convert into scaler ref and then convert it back to array
	my ($dbs, $primaryDatasetName, $path,  $ref_evcs, $ref_processing,) = @_;
	my (@evcs) = @{$ref_evcs};
	my (@processing) = @{$ref_processing};
	##########################################################################################################
	##########################################################################################################
	#Insert a new Primary Dataset if it doesnot exist alerady.
	my $primaryId = &createPrimaryDatasetLogic ($dbs, $primaryDatasetName);
	print INFO "\nprimary id $primaryId \nprimary name $primaryDatasetName";
	
	##########################################################################################################
	##########################################################################################################
	#Insert a new Processing if it does not exist
	&printProcessing(@processing);
	foreach my $aProcessing (@processing) {
		#FIXME Get the input and pass it correctly to the &createProcessingLogic method and change ithe code  to select the processing id with input in where clause.
		my ($processingId) = ();
		try {
			$processingId = &createProcessingLogic ($dbs, $$aProcessing{name}, $primaryDatasetName, "",  $$aProcessing{executable}, $$aProcessing{version}, $$aProcessing{family}, $$aProcessing{hash} , $$aProcessing{content} );
		} catch	Error with {
			my $ex = shift;
			if (!($exceptionClass eq "Object exists") ) {
				&throwException ($ex->value(), $exceptionClass, $ex->text());
			}
		};
		print INFO "\nProcessing ID  $processingId ";
		
		##########################################################################################################
		##########################################################################################################
		# Insert new Blocks
		my ($tmpName) = "/$primaryDatasetName/$$aProcessing{name}";
		my (%blocks) = (); #Array to strore remote and local block id mapping
		foreach my $aBlock  (@{$$aProcessing{block}}) {
			my ($blockId) =  &createFileBlockLogic ($dbs, $tmpName);
			#$blockId = 178;#For testing only
			$blocks{$$aBlock{id}} = $blockId;
			print INFO "MAP $$aBlock{id} -> $blocks{$$aBlock{id}}";
		}
		##########################################################################################################
		##########################################################################################################
		# Insert new Files
		#FIXME Instead of inserting one file by ine file. Insert many files at once. This woudld require change in XML from getDatasetInfo
		foreach my $aFile (@{$$aProcessing{files}}) {
			my (@files) = ();
			push(@files, $aFile);
			&printFile(@files);
			try {
				&insertFilesLogic ($dbs, "$tmpName/$blocks{$$aFile{inblock}}", $primaryDatasetName, $$aProcessing{name}, $blocks{$$aFile{inblock}}, @files);
			} catch	Error with {
				my $ex = shift;
				if (!($exceptionClass eq "Object exists") ) {
					&throwException ($ex->value(), $exceptionClass, $ex->text());
				}
			};	
		}
	}
	
	##########################################################################################################
	#########################################################################################################
	#Insert a new Processed Dataset if it doesnot exist already.
	#FIXME the input filed is null when getDatasetInfo is called.
	my($priName, $dataTier, $proName) = &checkPath($path, "path");
	print INFO "\npriName $priName \ndataTier $dataTier \nproName $proName \n";
	my ($processedId) = ();
	try {
		$processedId = &createProcessedDatasetLogic ($dbs, $priName, $dataTier, $proName, undef);
	} catch	Error with {
		my $ex = shift;
		if (!($exceptionClass eq "Object exists") ) {
			&throwException ($ex->value(), $exceptionClass, $ex->text());
		}
	};
	print INFO "processedId $processedId\n";

	##########################################################################################################
	#########################################################################################################
	#Insert all the Event Collections if it doesnot exist already.
	&printEvc(@evcs);
	&insertEventCollectionsLogic ($dbs, $path,  @evcs);
	print INFO "\nEVC inserted properly\n";
	

	close(INFO);

}

#Temporary Printing functions 
sub printFile {
	my (@files) = @_;
	foreach my $atmp (@files) {
		print INFO "\nid : $$atmp{id}\n";
		print INFO "guid : $$atmp{guid}\n";
		print INFO "logical-name : $$atmp{lfn}\n";
		print INFO "checksum : $$atmp{checksum}\n";
		print INFO "size : $$atmp{size}\n";
		print INFO "inblock : $$atmp{inblock}\n";
		print INFO "type : $$atmp{type}\n";
		print INFO "status : $$atmp{status}\n";
	}
}
sub printEvc {
	my (@evcs) = @_;
	foreach my $aEvc (@evcs) {
		print INFO "id : $$aEvc{id}\n";
		print INFO "name : $$aEvc{name}\n";
		print INFO "events : $$aEvc{events}\n";
		print INFO "status : $$aEvc{status}\n";
	}
}

sub printProcessing {
	my (@proc) = @_;
	foreach my $aProcessing (@proc) {
		print INFO "\nprocessingName  $$aProcessing{name} ";
		print INFO "\nexecutable  $$aProcessing{executable} ";
		print INFO "\nversion  $$aProcessing{version} ";
		print INFO "\nfamily  $$aProcessing{family} ";
		print INFO "\nhash  $$aProcessing{hash} ";
		print INFO "\ncontent  $$aProcessing{content} ";
	}
}