# Copyright (c) 2006  Paul Price, Joshua Hoblitt
#
# $Id: Config.pm,v 1.43 2007-05-05 02:52:28 price 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 URI 1.35;
use Nebulous::Client 0.02;

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
	_ipprc => $mdc		# The parsed configuration
	};
    bless $self, $class;

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

    return $self;
}

# 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 @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;
		last;
	    }
	}
	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);
	}
    }

    # 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

    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 "path://SOMETHING" or "neb://SOMETHING")
    my @segments = @_;		# Path segments

    my $old = URI->new( $base ) or die "Unable to parse URI: $base\n"; # URI
    $old = $old->canonical();	# Clean up
    my $scheme = $old->scheme(); # Scheme, e.g., file, path
    unshift @segments, $old->path_segments();

    for (my $i = 0; $i < scalar @segments; $i++) {
	splice( @segments, $i--, 1 ) unless $segments[$i] =~ /\S+/;
    }

    my $new = URI->new();	# URI to return
    $new->scheme( $scheme );
    $new->authority( $old->authority() );

    # Catch "neb:", "neb:/" and "neb://" for the base name
    my $opaque = $old->opaque();
    unshift( @segments, '', '' ) if $opaque eq '' or $opaque eq '/' or $opaque eq '//';
    $new->opaque( '/') if $old->opaque() eq '//';

    $new->path_segments( @segments );

    return $new->canonical()->as_string();
}

# 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 camera configuration file $pathname\n" ;
	exit($PS_EXIT_CONFIG_ERROR);
    }

    return $pathname;
}

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

    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 $uri = URI->new( $name );# URI parser
    my $scheme = $uri->scheme();# Scheme for file name

    return $name unless defined $scheme; # Probably a file name instead of a URI

    if ($scheme eq 'neb') {
	$name = _strip_scheme( $name );
	$self->_neb_start();
	my $neb = $self->{nebulous}; # Nebulous handle
	return $neb->find( $name );
    }
    if ($scheme eq 'path' or $scheme eq '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 $uri = URI->new( $name );# URI parser
    my $scheme = $uri->scheme();# Scheme for file name
    if (defined $scheme) {
	if ($scheme eq 'neb') {
	    $name = _strip_scheme( $name );
	    $self->_neb_start();
	    return $self->{nebulous}->open_create( $name );
	}
	if ($scheme eq 'path' or $scheme eq '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 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 $uri = URI->new( $name );# URI parser
    my $scheme = $uri->scheme();# Scheme for file name
    if (defined $scheme and $scheme eq 'neb') {
	$name = _strip_scheme( $name );
	$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 $uri = URI->new( $name );# URI parser
    my $scheme = $uri->scheme();# Scheme for file name
    if (defined $scheme and $scheme eq 'neb') {
	$name = _strip_scheme( $name );
	$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 $uri = URI->new( $target );# URI parser
    my $scheme = $uri->scheme();# Scheme for file name
    if (defined $scheme and $scheme eq 'neb') {
	$target = _strip_scheme( $target );
	$self->_neb_start();
	$target = $self->{nebulous}->create( $target );
    }
    $target = $self->file_resolve( $target );
    $source = $self->file_resolve( $source );

    system "cp $source $target";
}

# Strip the scheme (e.g., "neb://") off a URI name
sub _strip_scheme
{
    my $name = shift;		# File name of interest
    $name =~ s|^\S+:/*||;
    return $name;
}

# 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 $uri = URI->new( $name ); # URI parser
    my $scheme = $uri->scheme(); # Scheme for file name
    return $name if defined $scheme and $scheme eq 'neb'; # Nothing to be done: Nebulous handles it all

    # Might need to create a directory
    $name = $self->convert_filename_absolute( $name );
    my ( $vol, $dirs, $file ) = File::Spec->splitpath( $name );
    system "mkdir -p $dirs";

    return $name;
}


# Convert a relative filename (e.g., "path://PATH/file") to an absolute (e.g., "/path/to/file")
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);
    }

    my $uri = URI->new($name) or die "Unable to parse URI: $name\n"; # URI
    my $scheme = $uri->scheme(); # Scheme, e.g., file, path
    if (lc($scheme) eq 'file') {
	my $host = $uri->host();
	my $path;
	if (defined $host) {
	    # The user has file://some/directory/ but *probably* wants
	    # /some/directory/ i.e., the URI is technically wrong
	    # (should be one or three leading slashes, not two).  We
	    # choose to fix it and give the user what we think they
	    # want, rather than what they asked for.
	    $path = File::Spec->catfile( undef, $host, $uri->path() );
	} else {
	    $path = $uri->path();
	}

	return File::Spec->canonpath( $path );
    }

    if (lc($scheme) eq 'path') {
	my $authority = $uri->authority();
	my $path = $self->datapath( $authority );
	my @segments = $uri->path_segments();
	return File::Spec->catfile( $path, @segments );
    }

    return $name;
}

# 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 = URI->new( $name )->scheme();
    if ($scheme eq 'path' or $scheme eq 'file') {
	# We may as well search for a 'better' path
	$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 ($vol, $dir, $file) = File::Spec->splitpath( $name );
    my @dirs = File::Spec->splitdir( $dir );
    pop @dirs;			# Get rid of filename

    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
      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;
      }
  }
    my $uri = URI->new();	# URI to return
    if (defined $best_score) {
	my $rel = File::Spec->abs2rel( $name, $best_path );
	my @segments = File::Spec->splitdir( $rel );
	$uri->scheme( 'path' );
	$uri->authority( $best_name );
	$uri->path_segments( @segments );
    } else {
	$uri->scheme( 'file' );
	$uri->path( $name );
    }

    return $uri->as_string();
}

# 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);
    }

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

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

  TYPES: foreach my $item (@$rejection) {
      if (lc($item->{name}) eq $type) {
	  unless ($item->{class} eq "metadata") {
	      carp "$name within REJECTION 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 REJECTION list for $type.\n";
	  return undef;
      }
  }

    if (not defined $filter) {
	carp "Unable to find type $type with no FILTER in REJECTION list.\n";
    } else {
	carp "Unable to find type $type with FILTER $filter in REJECTION 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";
	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__;

