Astro::WaveBand - Transparently work in waveband, wavelength or filter

  use Astro::WaveBand;

  $w = new Astro::WaveBand( Filter => $filter );
  $w = new Astro::WaveBand( Wavelength => $wavelength );

  $w = new Astro::WaveBand( Wavelength => $wavelength,
                            Instrument => 'CGS4' );

  $filter = $w->filter;
  $wave   = $w->wavelength;
  $band   = $w->waveband;    # radio, xray, submm
  $freq   = $w->frequency;
  $wnum   = $w->wavenumber;

  $natural= $w->natural;
  $natural = "$w";

  $w->natural_unit("wavelength");

package Astro::WaveBand;

use 5.006;
use strict;
use warnings;
use Carp;

# Register an Astro::WaveBand warning category
use warnings::register;

# CVS version: $Log: WaveBand.pm,v $
# CVS version: Revision 1.4  2002/05/28 19:15:56  timj
# CVS version: - Include licence in perl module
# CVS version: - Include README in MANIFEST!
# CVS version: - Update to v0.04 for re-release to CPAN
# CVS version:
# CVS version: Revision 1.3  2002/05/16 21:15:59  timj
# CVS version: Prepare for CPAN release
# CVS version:
our $VERSION = 0.04;

# Overloading
use overload '""' => "natural";

# Constants

# Speed of light in m/s
use constant CLIGHT => 299792458;

# Continuum Filters are keyed by instrument
# although if an instrument is not specified the filters
# hash will be searched for a match if none is available in
# GENERIC
my %FILTERS = (
	       GENERIC => {
			   U => 0.365,
			   B => 0.44,
			   V => 0.55,
			   R => 0.70,
			   I => 0.90,
			   J => 1.25,
			   H => 1.65,
			   K => 2.2,
			   L => 3.45,
			   M => 4.7,
			   N =>10.2,
			   Q =>20.0,
			  },
	       IRCAM => {
			 "J98" =>     "1.250" ,
			 "H98" =>     "1.635" ,
			 "K98" =>     "2.150" ,
			 "Lp98" =>    "3.6"   ,
			 "Mp98" =>    "4.800" ,
			 "2.1c" =>    "2.100" ,
			 "2.122S1" => "2.122" ,
			 "BrG" =>     "2.0"   ,
			 "2.2c" =>    "2.200" ,
			 "2.248S1" => "2.248" ,
			 "3.6nbLp" => "3.6"   ,
			 "4.0c" =>    "4.000" ,
			 "BrA" =>     "4.0"   ,
			 "Ice" =>     "3.1"   ,
			 "Dust" =>    "3.28"  ,
			 "3.4nbL" =>  "3.4"   ,
			 "3.5mbL" =>  "3.5"   ,
			},
	       UFTI => {
			"I" =>     "0.9"  ,
			"Z" =>     "1.033",
			"J98" =>   "1.250",
			"H98" =>   "1.635",
			"K98" =>   "2.150",
			"Kprime" =>"2.120",
			"1.644" => "1.644",
			"1.57" =>  "1.57" ,
			"2.122" => "2.122",
			"BrG" =>   "2.166",
			"BrGz" =>  "2.173",
			"2.248S(1)" => "2.248",
			"2.27" =>  "2.270",
		       },
	       MICHELLE => {
			    "F105B53" => 10.5,
			    "F79B10" =>   7.9,
			    "F88B10" =>   8.8,
			    "F97B10" =>   9.7,
			    "F103B10" => 10.3,
			    "F116B9" =>  11.6,
			    "F125B9" =>  12.5,
			    "F107B4" =>  10.7,
			    "F122B3" =>  12.2,
			    "F128B2" =>  12.8,
			    "F209B42" => 20.9,
			    "F185B9" =>  18.5,
			    "NBlock" =>  10.6,
			    "QBlock" =>  20.9,
			    "F22B15" =>   2.2,
			    "F34B9" =>    3.4,
			    "F47B5" =>    4.7,
			   },
	       SCUBA => {
			 "850W" => 863,
			 "450W" => 443,
			 "450N" => 442,
			 "850N" => 862,
			},
	      );

# Instruments that have natural units
my %NATURAL = (
 	       CGS4 => 'wavelength',
	       SCUBA => 'filter',
	       UFTI => 'filter',
	       IRCAM => 'filter',
	       MICHELLE => 'filter',
	       ACSIS => 'frequency',
	      );

sub new {
  my $proto = shift;
  my $class = ref($proto) || $proto;

  my %args = @_;

  # Check the hash contains one of the following
  my @keys = qw/ Filter Wavelength Frequency Wavenumber /;
  my $found = 0;
  for my $key (@keys) {
    $found++ if exists $args{$key};
  }

  if ($found == 0) {
    warnings::warn("Missing a mandatory key")
	if warnings::enabled();
    return undef;
  } elsif ($found > 1) {
    warnings::warn("More than one mandatory key")
	if warnings::enabled();
    return undef;
  }

  my $w = bless { Cache => {} }, $class;

  # Now insert the information into the object
  # Do Instrument first since we may need it to convert
  # filter to wavelength
  if (exists $args{Instrument}) {
    $w->instrument( $args{Instrument});
  }

  for my $key (keys %args) {
    my $method = lc($key);
    next if $method eq  'instrument';
    if ($w->can($method)) {
      $w->$method( $args{$key});
    }
  }

  # We are now done so just return the object
  return $w;
}

sub wavelength {
  my $self = shift;
  if (@_) {
    my $value = shift;
    $self->_store_in_cache('wavelength' => $value);
  } else {
    return $self->_fetch_from_cache( 'wavelength' );
  }
  return;
}

sub frequency {
  my $self = shift;
  if (@_) {
    my $value = shift;

    # store value and wavelength in cache
    $self->_cache_value_and_wav( 'frequency', $value);

  } else {
    # Read value from the cache
    return $self->_read_value_with_convert( "frequency" );

  }

  return;
}

sub wavenumber {
  my $self = shift;
  if (@_) {
    my $value = shift;

    # store value and wavelength in cache
    $self->_cache_value_and_wav( 'wavenumber', $value);

  } else {
    # Read value from the cache
    return $self->_read_value_with_convert( "wavenumber" );

  }

  return;
}

sub filter {
  my $self = shift;
  if (@_) {
    my $value = shift;

    # store value and wavelength in cache
    $self->_cache_value_and_wav( 'filter', $value);

  } else {
    # Read value from the cache
    return $self->_read_value_with_convert( "filter" );

  }

  return;

}

sub instrument {
  my $self = shift;
  if (@_) { $self->{Instrument} = uc(shift); }
  return $self->{Instrument};
}

sub natural_unit {
  my $self = shift;
  if (@_) { $self->{NaturalUnit} = shift; }
  return $self->{NaturalUnit};
}

sub waveband {
  my $self = shift;

  my $lambda = $self->wavelength;
  return undef unless defined $lambda;

  my $band;
  if ($lambda >= 10000 ) {  # > 1cm
    $band = 'radio';
  } elsif ($lambda < 10000 and $lambda >= 1000) {
    $band = 'mm';
  } elsif ($lambda < 1000 and $lambda >= 100) {
    $band = 'submm';
  } elsif ($lambda < 100 and $lambda >= 1) {
    $band = 'infrared';
  } elsif ($lambda < 1 and $lambda >= 0.3) {
    $band = 'optical';
  } elsif ($lambda < 0.3 and $lambda >= 0.01) {
    $band = 'ultraviolet';
  } elsif ($lambda < 0.01 and $lambda >= 0.00001) {
    $band = 'x-ray';
  } elsif ($lambda < 0.00001) {
    $band = 'gamma-ray';
  }

  return $band;
}

sub natural {
  my $self = shift;

  # First see if the default unit is set
  my $unit = $self->natural_unit;

  unless (defined $unit) {
    # Check the instrument
    my $inst = $self->instrument;
    if ($inst and exists $NATURAL{$inst}) {
      $unit = $NATURAL{$inst};
    }
  }

  # Guess at filter if we have no choice
  $unit = 'filter' unless defined $unit;

  # retrieve the value
  my $value;
  if ($self->can($unit)) {
    $value = $self->$unit();
  }

  # All else fails... try wavelength
  $value = $self->wavelength() unless defined $value;

  return $value;
}

sub _cache {
  my $self = shift;
  if (wantarray) {
    return %{ $self->{Cache} };
  } else {
    return $self->{Cache};
  }
}

sub _store_in_cache {
  my $self = shift;
  my %entries = @_;

  # Get the cache
  my $cache = $self->_cache;

  # First check to see whether we have any entries in the
  # cache that clash
  for my $key (keys %entries) {

    # No worries if it is not there
    next unless exists $cache->{$key};

    # Check to see if the value is the same as is already present
    # Use a string comparison for filter
    if ($key eq 'filter') {
      next if $cache->{$key} eq $entries{$key};
    } else {
      # Number
      next if $cache->{$key} == $entries{$key};
    }

    # Now we have a key that exists but its value is
    # different. Clear the cache and exit the loop.
    # This means the loop never really reaches the end
    # of the block...
    $self->_clear_cache;

    last;
  }

  # Now insert the values
  for my $key (keys %entries) {
    $cache->{$key} = $entries{$key};
  }

  # finished
  return;
}

sub _clear_cache {
  my $self = shift;
  %{ $self->_cache } = ();
  return;
}

sub _fetch_from_cache {
  my $self = shift;
  return undef unless @_;

  my $key = shift;
  return undef unless $key;
  $key = lc($key); # level playing field

  # Return the value from the cache if it exists
  my $cache = $self->_cache;
  return $cache->{$key} if exists $cache->{$key};

  return undef;
}

sub _cache_value_and_wav {
  my $self = shift;

  my $category = shift;
  my $value = shift;
  return unless defined $value;

  # Convert to the internal format (wavelength)
  my $internal = $self->_convert_from( $category, $value );

  # Store all defined values into cache
  my %store;
  $store{$category} = $value;
  $store{wavelength} = $internal if defined $internal;

  # Clear cache if wavelength is not to be supplied
  $self->_clear_cache() unless defined $internal;

  $self->_store_in_cache( %store );

  return;
}

sub _read_value_with_convert {
  my $self = shift;
  my $category = lc(shift);

  my $value = $self->_fetch_from_cache( $category );

  # Convert it if necessary
  unless ($value) {

    # Convert it from the default value (if set)
    $value = $self->_convert_to( $category );

    # Cache it if necessary
    $self->_store_in_cache( $category => $value )
      if $value;
  }

  return $value;
}

sub _convert_to {
  my $self = shift;
  my $category = shift;

  my $lambda = $self->_fetch_from_cache( 'wavelength' );
  return undef unless defined $lambda;

  # Check all types
  my $output;
  if ($category eq 'wavelength') {
    $output = $lambda;
  } elsif ($category eq 'frequency') {
    # Microns
    $output = CLIGHT / ( $lambda * 1.0E-6);
  } elsif ($category eq 'wavenumber') {
    # Inverse cm
    $output = 1.0 / ( $lambda / 10_000);
  } elsif ($category eq 'filter') {
    # This is slightly harder since we know the value but
    # not the key. Go through each hash looking for a matching
    # key. If we know the instrument we start looking there
    # Else we have to look through GENERIC followed by all the
    # remaining instruments

    my $instrument = $self->instrument;
    my @search = ('GENERIC', keys %FILTERS);
    unshift(@search, $instrument) if defined $instrument;

    # There will be a precision issue here so we convert
    # the base wavelegnth to use 8 significant figures
    $lambda = sprintf("%8e", $lambda);

    OUTER: foreach my $inst (@search) {
	next unless exists $FILTERS{$inst};
	my $hash = $FILTERS{$inst};
	for my $key (keys %{ $hash }) {
	  if ($hash->{$key} == $lambda) {
	    $output = $key;
	    last OUTER;
	  }
	}
      }
  }

  return $output;
}

sub _convert_from {
  my $self = shift;

  my $category = lc(shift);
  my $value = shift;
  return undef unless defined $value;

  # Go through each type
  my $output;
  if ($category eq 'wavelength') {
    $output = $value;
  } elsif ($category eq 'frequency') {

    # Convert frequency to wavelength 
    # converting from metres to microns
    $output = CLIGHT / ($value * 1.0E-6);

  } elsif ($category eq 'wavenumber') {
    # 1 / cm then convert cm to microns
    $output = (1.0 / $value) * 10_000;

  } elsif ($category eq 'filter') {
    # Convert filter to wavelength
    # Need to walk through %FILTERS first for a 
    # instrument match and then for a generic match
    my $instrument = $self->instrument;
    my @search = ('GENERIC');
    unshift(@search, $instrument) if defined $instrument;

    foreach my $name (@search) {

      # First look for a match in %FILTERS
      if (exists $FILTERS{$name}) {
	# Now look for the filter itself
	if (exists $FILTERS{$name}{$value}) {
	  $output = $FILTERS{$name}{$value};
	  last;
	}
      }
    }
  }

  return $output;
}

1;