# Copyright (c) 2006  Paul Price, Joshua Hoblitt
#
# $Id: Config.pm,v 1.61 2007-06-13 19:17:50 eugene Exp $

package PS::IPP::Config;

use strict;
use warnings FATAL => qw( all );

our $VERSION = '1.00';

use Carp qw( carp );
# use File::Spec 3.19;
use File::Spec 0.87;
use PS::IPP::Metadata::Config 1.00;
use Getopt::Long 2.35 qw( GetOptions :config gnu_getopt pass_through ); # Set pass_through so we don't kill @ARGV

use base qw( Class::Accessor::Fast Exporter );
__PACKAGE__->mk_accessors( qw( path ) );

our @EXPORT_OK = qw(
		    $PS_EXIT_SUCCESS
		    $PS_EXIT_UNKNOWN_ERROR
		    $PS_EXIT_SYS_ERROR
		    $PS_EXIT_CONFIG_ERROR
		    $PS_EXIT_PROG_ERROR
		    $PS_EXIT_DATA_ERROR
		    $PS_EXIT_TIMEOUT_ERROR
		    metadataLookupStr
		    metadataLookupMD
		    caturi
		    );

our $PS_EXIT_SUCCESS = 0;
our $PS_EXIT_UNKNOWN_ERROR = 1;
our $PS_EXIT_SYS_ERROR = 2;
our $PS_EXIT_CONFIG_ERROR = 3;
our $PS_EXIT_PROG_ERROR = 4;
our $PS_EXIT_DATA_ERROR = 5;
our $PS_EXIT_TIMEOUT_ERROR = 6;

our $parser = PS::IPP::Metadata::Config->new; # Metadata parser
$parser->overwrite(0);		# Turn off overwrite

#$::RD_TRACE = 1;
#$::RD_HINT = 1;
#use Data::Dumper;

# Given a parsed metadata, parse it into an array of hashes
sub new {
    my $class = shift;		# Class name
    my $camera = shift;		# Camera name

    unless (defined $class) {
	carp "Programming error";
	exit($PS_EXIT_PROG_ERROR);
    }

    # Get location of ipprc file
    my $name;			# Name of ipprc file
    GetOptions( 'site=s' => \$name );
    $name = $ENV{PS_SITE} if not defined $name;
    if (not defined $name and defined $ENV{HOME}) {
	$name = $ENV{HOME} . '/.ipprc';
    }

    my $file;			# File handle
    unless (open $file, $name) {
	carp "Unable to open ipprc file $name: $!";
	exit($PS_EXIT_CONFIG_ERROR);
    }
    my @contents = <$file>;	# Contents of the ipprc file
    close $file;

    my $mdc = $parser->parse( join '', @contents); # The parsed metadata config

    my $path = _interpolate_env(metadataLookupStr($mdc, 'PATH')); # The path
    unless (defined $path) {
	carp "PATH is not set in $name\n";
	exit($PS_EXIT_CONFIG_ERROR);
    }

    # Interpolate environment variables in the work directory

    my $self = {
	path => $path,		# Path
	camera => undef,	# Camera configuration
	rejection => undef,	# Rejection data
	_ipprc => $mdc		# The parsed configuration
	};
    bless $self, $class;

    $self->define_camera($camera) if defined $camera;

    return $self;
}

# Find a configuration file, which might be anywhere in the PATH
sub _find_config
{
    my $self = shift;		# Configuration object
    my $filename = shift;	# File name to find

    my @path = split /:/, $self->{path}; # List of paths to try
    my $found = 0;			# Found it?
    my $realfile;
    my $tries = 0;
    while (not $found) {
	## try a second time
	foreach my $path (@path) {
	    $realfile = File::Spec->rel2abs( $filename, $path );
	    if ($tries) {
		print "re-trying ($tries): filename: $filename, path: $path -> ";
		print "test: $realfile\n";
	    }
	    if (-f $realfile) {
		$found = 1;
		return $realfile;
	    }
	}
	if (not $found) {
	    $tries ++;
	    if ($tries > 4) {
		unless ($found) {
		    carp "Unable to find camera configuration file $filename\n";
		    exit($PS_EXIT_CONFIG_ERROR);
		}
	    }
	    ## try again after a moment?
	    system ("df");
	    select(undef, undef, undef, 0.25);
	}
    }

    carp "Unable to find configuration file: $filename";
    exit($PS_EXIT_CONFIG_ERROR);
}

# Define a camera to use
sub define_camera
{
    my $self = shift;		# Configuration object
    my $name = shift;		# Camera name

    unless (defined $self and defined $name) {
	carp "Programming error";
	exit($PS_EXIT_PROG_ERROR);
    }

    my $camera_list = metadataLookupMD($self->{_ipprc}, 'CAMERAS'); # List of cameras
    my $filename = metadataLookupStr($camera_list, $name); # Filename of camera configuration
    unless (defined $filename) {
	carp "Unable to find configuration file for camera $name\n";
	exit($PS_EXIT_CONFIG_ERROR);
    }

    my $realfile = $self->_find_config($filename); # Resolved filename, after hunting the PATH

    # Read the file
    my $file;			# File handle
    unless (open $file, $realfile) {
	carp "Unable to open camera configuration file $realfile: $!";
	exit($PS_EXIT_CONFIG_ERROR);
    }
    my @contents = <$file>;
    close $file;
    $self->{camera} = $parser->parse( join '', @contents); # The parsed metadata config
    $self->{cameraName} = $name;

    unless (defined $self->{camera}) {
	carp "Failure to define camera";
	exit($PS_EXIT_CONFIG_ERROR);
    }

    # XXX why isn't just $self being returned here? -JH
    return defined $self->{camera};
}

# Concatenate elements of a URI
sub caturi
{
    my $base = shift;		# Base name (might be "foo /foo path://SOMETHING" or "neb://SOMETHING")
    my @segments = @_;		# Path segments

    carp "base is not inited" if not defined $base;
    my ($scheme) = $base =~ m|^(\S+):|; # The scheme, e.g., file://, path://
    $base =~ s|^\S+:/*||;

    my $root = '';
    if ($base =~ m|^/|) { $root = '/'; }

    unshift @segments, $base if $base =~ /\S+/;

    # Remove leading and trailing slashes
    foreach my $segment ( @segments ) {
	$segment =~ s|^/*||;
	$segment =~ s|/*$||;
    }

    # Join everything together
    my $joined = join('/', @segments);
    if (defined $scheme) {
	$joined = lc($scheme) . "://" . $joined;
    } else {
	$joined = $root . $joined;
    }

    return $joined;
}

# select a datapath from config.site
sub datapath
{
    my $self = shift;		# Configuration object
    my $name = shift;		# datapath name

    unless (defined $self and defined $name) {
	carp "Programming error";
	exit($PS_EXIT_PROG_ERROR);
    }

    my $path_list = metadataLookupMD($self->{_ipprc}, 'DATAPATH'); # List of paths
    my $pathname = metadataLookupStr($path_list, $name); # Path of interest
    unless (defined $pathname) {
	carp "Unable to find datapath $name\n" ;
	exit($PS_EXIT_CONFIG_ERROR);
    }

    return $pathname;
}

# Start up Nebulous
sub _neb_start
{
    my $self = shift;		# Configuration object

    eval {
	require Nebulous::Client;
    };
    if ($@) {
	carp "Can't find Nebulous::Client.";
	exit($PS_EXIT_PROG_ERROR);
    }

    return 1 if defined $self->{nebulous}; # Already started

    my $server = metadataLookupStr( $self->{_ipprc}, 'NEB_SERVER' ); # Nebulous server
    unless (defined $server) {
	carp "Unable to find NEB_SERVER in camera configuration file.";
	exit($PS_EXIT_CONFIG_ERROR);
    }

    my $neb = Nebulous::Client->new( proxy => $server );
    unless (defined $neb) {
	carp "Unable to find NEB_SERVER in camera configuration file.";
	exit($PS_EXIT_CONFIG_ERROR);
    }

    $self->{nebulous} = $neb;

    return 1;
}


# Resolve a URI to a file name
sub file_resolve
{
    my $self = shift;		# Configuration object
    my $name = shift;		# File name to check

    my ($scheme) = $name =~ m|^(\S+):|; # The scheme, e.g., file://, path://

    return $name unless defined $scheme; # Probably a file name instead of a URI
    $scheme = lc($scheme);

    if ($scheme eq 'neb') {
	$name =~ s|^(\S+):/*||;
	$self->_neb_start();
	my $neb = $self->{nebulous}; # Nebulous handle
	return $neb->find( $name );
    }
    if ($scheme eq 'path' or $scheme eq 'file') {
	# guaranteed to have a scheme (path:// or file://)
	return $self->convert_filename_absolute( $name );
    }

    return $name;
}

# Create and open file
sub file_create_open
{
    my $self = shift;		# Configuration object
    my $name = shift;		# File name to check

    $self->file_prepare( $name );

    my ($scheme) = $name =~ m|^(\S+):|; # The scheme, e.g., file://, path://
    if (defined $scheme) {
	$scheme = lc($scheme);
	if ($scheme eq 'neb') {
	    $name =~ s|^(\S+):/*||;
	    $self->_neb_start();
	    return $self->{nebulous}->open_create( $name );
	}
	if ($scheme eq 'path' or $scheme eq 'file') {
	    # guaranteed to have a scheme (path:// or file://)
	    $name = $self->convert_filename_absolute( $name );
	}
    }

    if (-f $name) {
	carp "Unable to create file $name --- file exists.";
	exit($PS_EXIT_SYS_ERROR);
    }

    my $fh;
    unless (open $fh, '>', $name) {
	carp "Unable to create file $name --- $!";
	exit($PS_EXIT_SYS_ERROR);
    }
    return $fh;
}

# Create and open file for appending
sub file_create_append
{
    my $self = shift;		# Configuration object
    my $name = shift;		# File name to check

    $self->file_prepare( $name );

    my ($scheme) = $name =~ m|^(\S+):|; # The scheme, e.g., file://, path://
    if (defined $scheme) {
	$scheme = lc($scheme);
	if ($scheme eq 'neb') {
	    $name =~ s|^(\S+):/*||;
	    $self->_neb_start();
	    return $self->{nebulous}->open_create( $name );
	}
	if ($scheme eq 'path' or $scheme eq 'file') {
	    # guaranteed to have a scheme (path:// or file://)
	    $name = $self->convert_filename_absolute( $name );
	}
    }

    my $fh;
    unless (open $fh, '>>', $name) {
	carp "Unable to create file $name --- $!";
	exit($PS_EXIT_SYS_ERROR);
    }
    return $fh;
}

# Create a file (intended principally to abstract Nebulous files)
sub file_create
{
    my $self = shift;		# Configuration object
    my $name = shift;		# File name to check

    $self->file_prepare( $name );

    my ($scheme) = $name =~ m|^(\S+):|; # The scheme, e.g., file://, path://
    if (defined $scheme and lc($scheme) eq 'neb') {
	$name =~ s|^(\S+):/*||;
	$self->_neb_start();
	$name = $self->{nebulous}->create( $name );
    }

    return $self->file_resolve($name);
}

# Check if a file exists
sub file_exists
{
    my $self = shift;		# Configuration object
    my $name = shift;		# File name to check

    my ($scheme) = $name =~ m|^(\S+):|; # The scheme, e.g., file://, path://
    if (defined $scheme and lc($scheme) eq 'neb') {
	$name =~ s|^(\S+):/*||;
	$self->_neb_start();
	return (defined $self->{nebulous}->find_instances( $name ) ? 1 : 0);
    }

    return (-f $self->file_resolve($name));
}

# Copy a file
sub file_copy
{
    my $self = shift;		# Configuration object
    my $source = shift;		# Name of source file
    my $target = shift;		# Name of target file

    $self->file_prepare( $target );

    my ($scheme) = $target =~ m|^(\S+):|; # The scheme, e.g., file://, path://
    if (defined $scheme and lc($scheme) eq 'neb') {
	$target =~ s|^(\S+):/*||;
	$self->_neb_start();
	$target = $self->{nebulous}->create( $target );
    }
    $target = $self->file_resolve( $target );
    $source = $self->file_resolve( $source );

    system("cp $source $target") == 0 or (carp "Can't copy file $source to $target." and
					  exit($PS_EXIT_DATA_ERROR));
    return 1;
}

# Strip the filename (the last element of the URI), returning the scheme and directory part
sub _strip_filename
{
    my $name = shift;		# File name of interest
    $name =~ s|/[\w.-]*?$||;
    return $name;
}

# Prepare to receive a new file --- create the directory, if appropriate.  Return the appropriate filename
# Does not register anything with Nebulous
sub file_prepare
{
    my $self = shift;		# Configuration object
    my $name = shift;		# File name for which to prepare
    my $workdir = shift;	# Working directory
    my $template = shift;	# Template filename from which to get working directory if 

    if (defined $workdir) {
	$name = caturi( $workdir, $name );
    } elsif (defined $template) {
	# Take directory from template and apply to name
	my $dir = _strip_filename( $template );
	$name = caturi( $dir, $name );
    }

    my ($scheme) = $name =~ m|^(\S+):|; # The scheme, e.g., file://, path://
    return $name if defined $scheme and lc($scheme) eq 'neb'; # Nothing to be done: Nebulous handles it all

    # Might need to create a directory
    # not guaranteed to have a scheme (path:// or file://) - might be /PATH/foobar
    # a relative path (PATH/foobar) is invalid here
    my $resolved = $self->convert_filename_absolute( $name );
    my ( $vol, $dirs, $file ) = File::Spec->splitpath( $resolved );
    unless (-d $dirs) {
	system("mkdir -p $dirs") == 0 or (carp "Can't create directory $dirs" and exit($PS_EXIT_DATA_ERROR));
    }

    return $name;
}


# Convert a relative filename (e.g., "path://PATH/file") to an absolute (e.g., "/path/to/file")
# note that file://PATH/file resolves to /PATH/file, regardless of the number of leading slashes
sub convert_filename_absolute
{
    my $self = shift;		# Configuration object
    my $name = shift;		# raw name

    unless (defined $self and defined $name) {
	carp "Programming error";
	exit($PS_EXIT_PROG_ERROR);
    }

    $name =~ s|/$||; # drop tailing slashes (foobar/ to foobar)
    my ($scheme) = $name =~ m|^(\S+):|; # The scheme, e.g., file, path

    ## if this is already an absolute path (/PATH/file), just return the path
    unless (defined $scheme) { 
	if ($name =~ m|^/|) { return $name; }
	# without a leading slash, this is an error
	carp "Programming error";
	exit($PS_EXIT_PROG_ERROR);
    }

    $name =~ s|^\S+:/*||;

    if (lc($scheme) eq 'file') {
	# the above strips of the leading slash; replace it for file:// 
	$name = '/' . $name;
	return $name;
    }

    if (lc($scheme) eq 'path') {
	my @dirs = split('/', $name);
	my $pathName = shift @dirs;
	my $path = $self->datapath( $pathName );
	$path =~ s|/*$||;
	return File::Spec->catfile( $path, @dirs );
    }

    # looks like we cannot reach here without an invalid scheme.  
    # programming error?
    # return $name;

    carp "Programming error";
    exit($PS_EXIT_PROG_ERROR);
}

# Convert a relative filename (e.g., "/path/to/file") to an absolute (e.g., "path://PATH/file")
sub convert_filename_relative
{
    my $self = shift;		# Configuration object
    my $name = shift;		# raw name
    
    unless (defined $self and defined $name) {
	carp "Programming error";
	exit($PS_EXIT_PROG_ERROR);
    }
    
    # First, check to see if it's already in a relative form
    my ($scheme) = $name =~ m|^(\S+):|; # The scheme, e.g., file, path
    if (defined $scheme) {
	$scheme = lc($scheme);
	if ($scheme eq 'path' or $scheme eq 'file') {
	    # We may as well search for a 'better' path
	    # guaranteed to have a scheme (path:// or file://)
	    $name = $self->convert_filename_absolute( $name );
	} elsif ($scheme eq 'neb') {
	    # No chance of changing anything --- move along
	    return $name;
	}
    }
    
    $name = File::Spec->canonpath( $name); # Clean up
    my @dirs = File::Spec->splitdir( $name );
    
    my $path_list = metadataLookupMD($self->{_ipprc}, 'DATAPATH'); # List of paths
    my $best_path;
    my $best_name;
    my $best_score;
  CFR_PATH_CHECK: foreach my $path_item (@$path_list) {
      my $path_name = $path_item->{name}; # Name of the path
      my $path = File::Spec->canonpath( $path_item->{value} ); # The path
      $path =~ s|/*$||;
      my @path_dirs = File::Spec->splitdir( $path );
      
      # Check if the path is suitable
      next if scalar @path_dirs > scalar @dirs;
      for (my $i = 0; $i < scalar @path_dirs; $i++) {
	  next CFR_PATH_CHECK if $path_dirs[$i] ne $dirs[$i];
      }
      # It is suitable; see if it is 'best' (minimizes the number of directories)
      my $score = scalar @path_dirs;
      if (not defined $best_score or $score > $best_score) {
	  $best_path = $path;
	  $best_score = $score;
	  $best_name = $path_name;
      }
  }
    
    $name =~ s|^/||;
    $name =~ s|/$||;
    if (defined $best_score) {
	$best_path =~ s|^/||;
	$best_path =~ s|/$||;
	$name =~ s|^$best_path|$best_name|;
	return 'path://' . $name;
    }
    return 'file://' . $name;
}

# Return a rejection limit from the camera configuration
sub rejection
{
    my $self = shift;		# Configuration object
    my $name = shift;		# Name of limit
    my $type = lc(shift);	# Type of frame
    my $filter = shift;		# Filter name, for extra qualification; optional

    unless (defined $self and defined $name and defined $type) {
	carp "Programming error";
	exit($PS_EXIT_PROG_ERROR);
    }

    unless (defined $self->{rejection}) {
	my $camera = $self->{cameraName}; # Camera name
	unless (defined $camera) {
	    carp "Camera has not yet been defined.\n";
	    return undef;
	}
	
	# rejections are saved as a recipe: REJECTIONS
	my @rejContents = `ppConfigDump -dump-recipe REJECTIONS -camera $camera -`;
	
	# load from resulting psMetadataConfig
	$self->{rejection} = $parser->parse( join '', @rejContents); # The rejection metadata
	unless (defined $self->{rejection}) {
	    carp "Unable to parse REJECTION recipe for $camera.";
	    exit($PS_EXIT_CONFIG_ERROR);
	}
    }

    my $rejection = $self->{rejection};

    # Find the appropriate entry
  TYPES: foreach my $item (@$rejection) {
      if (lc($item->{name}) eq $type) {
	  unless ($item->{class} eq "metadata") {
	      carp "$name within REJECTIONS is not of type METADATA";
	      exit($PS_EXIT_PROG_ERROR);
	  }
	  my $limits = $item->{value}; # List of rejection limits

	  # Check the FILTER first
	  foreach my $limit (@$limits) {
	      if ($limit->{name} eq 'FILTER') {
		  if ($limit->{value} eq '*' or
		      (defined $filter and
		       $limit->{value} eq $filter)) {
		      last;
		  }
		  next TYPES; # Doesn't match --- look at the next one
	      }
	  }
	  
	  foreach my $limit (@$limits) {
	      return $limit->{value} if $limit->{name} eq $name;
	  }
	  carp "Unable to find limit $name in REJECTIONS list for $type.\n";
	  return undef;
      }
  }

    if (not defined $filter) {
	carp "Unable to find type $type with no FILTER in REJECTIONS list.\n";
    } else {
	carp "Unable to find type $type with FILTER $filter in REJECTIONS list.\n";
    }
    return undef;
}

# Return a filename from the camera configuration FILERULES
sub filename
{
    my $self = shift;		# Configuration object
    my $name = shift;		# Name of the file
    my $output = shift;		# For replacing {OUTPUT}
    my $component = shift;	# For replacing {CHIP.NAME} and {CELL.NAME}

    unless (defined $self and defined $name and defined $output) {
	carp "Programming error: required inputs left undefined";
	exit($PS_EXIT_PROG_ERROR);
    }

    my $camera = $self->{camera}; # Camera configuration
    unless (defined $camera) {
	carp "Camera has not yet been defined.\n";
	return undef;
    }

    my $filerules = metadataLookupMD($camera, 'FILERULES');	# File rules
    unless (defined $filerules) {
	carp "Can't find FILERULES list in camera configuration.\n";
	return undef;
    }

    my $file = _mdLookupMDwithRedirect($filerules, $name); # The file of interest
    unless (defined $file) {
	carp "Can't find $name within FILERULES in camera configuration.\n";
	return undef;
    }

    my $filename = metadataLookupStr($file, "FILENAME.RULE"); # File name
    unless (defined $filename) {
	carp "Can't find FILENAME.RULE for $name within FILERULES in camera configuration.\n";
	return undef;
    }

    $filename =~ s/\{OUTPUT\}/$output/;
    if ($filename =~ /\{CHIP\.NAME\}/) {
	unless (defined $component) {
	    carp "Programming error";
	    exit($PS_EXIT_PROG_ERROR);
	}
	$filename =~ s/\{CHIP\.NAME\}/$component/;
	$filename =~ s/\{CELL\.NAME\}/$component/;
    }

    return $filename;
}   

# Return an EXTNAME From the EXTNAME.RULE table in the camera configuration
sub extname_rule
{
    my $self = shift;		# Configuration object
    my $name = shift;		# Name of the EXTNAME to build
    my $component = shift;	# For replacing {CHIP.NAME}

    unless (defined $self and defined $name) {
	carp "Programming error";
	exit($PS_EXIT_PROG_ERROR);
    }

    my $camera = $self->{camera}; # Camera configuration
    unless (defined $camera) {
	carp "Camera has not yet been defined.\n";
	return undef;
    }

    my $extname_rules = metadataLookupMD($camera, 'EXTNAME.RULES');	# File rules
    unless (defined $extname_rules) {
	carp "Can't find EXTNAME.RULES in camera configuration.\n";
	return undef;
    }

    my $extname = metadataLookupStr($extname_rules, $name); # File name
    unless (defined $extname) {
	carp "Can't find $name within EXTNAME.RULES in camera configuration.\n";
	return undef;
    }

    if ($extname =~ /\{CHIP\.NAME\}/) {
	unless (defined $component) {
	    carp "Programming error";
	    exit($PS_EXIT_PROG_ERROR);
	}
	$extname =~ s/\{CHIP\.NAME\}/$component/;
    }

    return $extname;
}   

# Return hash of tessellations, from TESSELLATIONS within the camera configuration
sub tessellations
{
    my $self = shift;		# Configuration object

    unless (defined $self) {
	carp "Programming error";
	exit($PS_EXIT_PROG_ERROR);
    }

    my $camera = $self->{camera}; # Camera configuration
    unless (defined $camera) {
	carp "Camera has not yet been defined.\n";
	exit($PS_EXIT_PROG_ERROR);
    }

    my $tessellations = metadataLookupMD($camera, 'TESSELLATIONS'); # Tessellations
    unless (defined $tessellations) {
	carp "Can't find TESSELLATIONS in camera configuration.\n";
	exit($PS_EXIT_CONFIG_ERROR);
    }

    my %tessellations;		# Tessellations hash to return
    foreach my $tess ( @$tessellations ) {
	unless ($tess->{type} eq "STR") {
	    carp "Type for " . $tess->{name} . " within TESSELLATIONS in camera config is not STR.\n";
	    next;
	}

	$tessellations{$tess->{name}} = $tess->{value};
    }

    return \%tessellations;
}


# Return the DVO.CAMERADIR in the camera configuration
sub dvo_cameradir
{
    my $self = shift;		# Configuration object

    unless (defined $self) {
	carp "Programming error";
	exit($PS_EXIT_PROG_ERROR);
    }

    my $camera = $self->{camera}; # Camera configuration
    unless (defined $camera) {
	carp "Camera has not yet been defined.\n";
	return undef;
    }

    my $dir = metadataLookupStr($camera, "DVO.CAMERADIR"); # Directory of interest
    unless (defined $dir) {
	carp "Can't find DVO.CAMERADIR in camera configuration.\n";
	return undef;
    }

    return $dir;
}

# Interpolate environment variables in a directory (or colon-delimited list of directories)
sub _interpolate_env
{
    my $dir = shift;		# Directory of interest

    return undef unless defined $dir;

    while ($dir =~ /\$\{?(\w*)[\}\/:]?/) {
	my $name = $1;		# Environment variable name
	my $value = $ENV{$name}; # Environment variable value
	unless (defined $value) {
	    carp "Unable to find environment variable $name";
	    exit($PS_EXIT_SYS_ERROR);
	}
	$dir =~ s/\$\{?$name\}?/$value\//;
    }
    return $dir;
}

# Lookup the metadata, checking the type is STR
sub metadataLookupStr
{
    my $mdc = shift;		# Metadata config to look up
    my $name = shift;		# Name of item to look up

    unless (defined $mdc and defined $name) {
	carp "Programming error";
	exit($PS_EXIT_PROG_ERROR);
    }

    # Iterate through the array of hashes
    foreach my $item (@$mdc) {
	if ($item->{name} eq $name) {
	    carp "$name within metadata is not of type STR.\n" unless $item->{type} eq "STR";
	    return $item->{value};
	}
    }

    carp "Unable to find $name within metadata.\n";
    return undef;
}

# Lookup the metadata, checking the type is MD
sub metadataLookupMD
{
    my $mdc = shift;		# Metadata config to look up
    my $name = shift;		# Name of item to look ip

    unless (defined $mdc and defined $name) {
	carp "Programming error";
	exit($PS_EXIT_PROG_ERROR);
    }

    # Iterate through the array of hashes
    foreach my $item (@$mdc) {
	if ($item->{name} eq $name) {
	    carp "$name within metadata is not of type METADATA.\n" unless $item->{class} eq "metadata";
	    return $item->{value};
	}
    }

    carp "Unable to find $name within metadata.\n";
    return undef;
}

# Lookup the metadata, checking the type is MD; may be redirection
sub _mdLookupMDwithRedirect
{
    my $mdc = shift;		# Metadata config to look up
    my $name = shift;		# Name of item to look ip

    unless (defined $mdc and defined $name) {
	carp "Programming error";
	exit($PS_EXIT_PROG_ERROR);
    }

    # Iterate through the array of hashes
    foreach my $item (@$mdc) {
	if ($item->{name} eq $name) {
	    if ($item->{class} eq "metadata") {
		return $item->{value};
	    }
	    if ($item->{class} eq "scalar" and $item->{type} eq "STR") {
		# Redirect
		return _mdLookupMDwithRedirect($mdc, $item->{value});
	    }
	    carp "$name within metadata is not of type METADATA or STR.\n";
	    return undef;
	}
    }

    carp "Unable to find $name within metadata.\n";
    return undef;
}


1;

__END__;

