# Copyright (c) 2006  Paul Price, Joshua Hoblitt
#
# $Id: Config.pm,v 1.31 2007-02-16 20:58:15 price Exp $

package PS::IPP::Config;

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

our $VERSION = '1.00';

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

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

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} unless defined $name;
    $name = $ENV{HOME} . '/.ipprc' unless defined $name;

    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(_mdLookupStr($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 = _mdLookupMD($self->{_ipprc}, 'CAMERAS'); # List of cameras
    my $filename = _mdLookupStr($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

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


# 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 = _mdLookupMD($self->{_ipprc}, 'DATAPATH'); # List of paths
    my $pathname = _mdLookupStr($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;
}

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

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

    $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 = _mdLookupMD($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 = _mdLookupMD($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 = _mdLookupMD($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 = _mdLookupStr($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;
}   


# 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 _mdLookupStr
{
    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 _mdLookupMD
{
    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__;

