#!/usr/bin/perl
###############################################################################
# PERL script to search in a general way through the 2QZ catalogue.
# This is the command line version, which has been modifed from the WWW/CGI
# version.
# 
# Written by S.M. Croom & R.J. Smith 6/2/01
# 
# SMC 22/02/01 (v1.1)
#
# RJS 22/02/01 (v1.2)
#   Many changes, principally to produce prettified HTML output results.
#   Added maxrows to %allkeywords array.
#   Changed file name to cat_search_www.cgi so it can be called as
#     a cgi-bin from the CGIservlet-1.2.pl mini server.
#
# SMC 24/02/01 (v1.3)
# fixed problem with zero (0) entries in boxes.
# U/R min and max now supported
# ra min/max wrap around at RA=0h now works
#
# RJS 28/02/01 (v1.4) 
# Changed name back to cat_search_www.pl. Sorry!
# Web page now calls searcher.cgi. I think this means that the only
# 	paths we are dependent on are /bin/sh and that the user has 
#	`perl' in their search PATH, since we call both Servelet and 
#	cat_search_www.pl via `perl **********.pl'
# Added explicit printf for better formatting
# -ve decs are now printed out as -ve
# Swapped ID and redshift columns in output table
#
# SMC 08/03/01 (v1.5)
# Now checks for limits of the 2QZ survey areas when doing RA,Dec search
# Search in r mag fixed to include proper upper limits (not upper limits+10)
#
# RJS 09/03/01  (v1.6)
# Taking advantage of SMC's addition of writing search results in
#   /tmp/2QZ.out, I have written out 2QZ.out.html as a replacement
#   for the old allpub.cat.html containing only requested objects.
#   It is therefore MUCH faster to load. These are linked from the
#   CAT column in results table.
# Added `Observation 2' to the results table.
# Reformatted results table header slightly in line with WWW
#   version.
#
# SMC 12/06/02 (v1.7)
# Added a search keyword for object name.  This can be a string which
# is contained within either the catalogue or IAU name of the object.  The
# new keyword is called "name".
#
# SMC 23/08/02 (v1.8)
# Fixed problem when the object name was passed as "2QZ J012526.7-313341".
# The 2QZ is removed, as are any leading or trailing blanks.
#
# SMC 08/11/02 (v1.9)
# Fixed problem with "+" (which is a meta-character in perl regular 
# expressions) in the name of objects, so that searching on the name
# e.g. J131858.7+003051 works.  
#
# SMC 11/06/03 (v2.0)
# Fixed bug with quality search (found by BJB)
#
################################################################################
#                                                                              #
#          LICENCE                                                             #
#                                                                              #
#          This program is free software; you can redistribute it and/or       #
#          modify it under the terms of the GNU General Public License         #
#          as published by the Free Software Foundation; either version 2      #
#          of the License, or (at your option) any later version.              #
#                                                                              #
#          This program is distributed in the hope that it will be useful,     #
#          but WITHOUT ANY WARRANTY; without even the implied warranty of      #
#          MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the       #
#          GNU General Public License for more details.                        #
#                                                                              #
#          You should have received a copy of the GNU General Public License   #
#          along with this program; if not, write to the Free Software         #
#          Foundation, Inc., 59 Temple Place - Suite 330,                      #
#          Boston, MA  02111-1307, USA.                                        #
#                                                                              #
################################################################################
#
# version control:
$version=2.0;
print "cat_search.pl version $version\n\n";
#
# CGI stuff to accept form input:
#
# define a hash of all allowable keywords
%allkeywords = (bmin,bmin,bmax,bmax,ubmin,ubmin,ubmax,ubmax,brmin,brmin,brmax,brmax);
%allkeywords = (ramin,ramin,ramax,ramax,decmin,decmin,decmax,decmax,%allkeywords);
%allkeywords = (ra,ra,dec,dec,radius,radius,umin,umin,umax,umax,%allkeywords);
%allkeywords = (zmin,zmin,zmax,zmax,qualmin,qualmin,qualmax,qualmax,%allkeywords);
%allkeywords = (snmin,snmin,snmax,snmax,id,id,rmin,rmin,rmax,rmax,%allkeywords);
%allkeywords = (maxrows,maxrows,subid,subid,postype,postype,name,name,%allkeywords);
# define position keywords:
%poskeywords = (ramin,ramin,ramax,ramax,decmin,decmin,decmax,decmax,ra,ra,dec,dec);
# set a few useful parameters:
$pi=atan2(1,1)*4;
$dtor=$pi/180.0;
#
# get the keywords from the command line:
if ( scalar(@ARGV) == 0 ) {
    print "Usage: cat_search.pl <catalogue_file> <output_file> <constraint1> <constraint2>...\n";
    print "or:    cat_search.pl -h for more help\n";
    exit(10);
}
elsif ($ARGV[0] eq "-h") {
    help();
    exit(11);
}
else {
    @inlist = @ARGV;
    $inlistnumber = scalar(@ARGV);
}
# figure out constraints:
$catfile=$ARGV[0];
$outfile=$ARGV[1];
print "catalogue file   : $catfile\n";
print "input constraints:\n";
$ncont=0;
$i=2;
$nval=0;
$nkey=0;
while ($i < $inlistnumber) {
    if ($ARGV[$i] =~ /=/) { # split up the entry if there is an equals sign
	@tmp=split(/=/,$ARGV[$i]);
	$data{$tmp[0]}=$tmp[1];
	$keyword=$tmp[0];
	$i++;
    }
    else {
	$data{$keyword}=$data{$keyword}." ".$ARGV[$i];
	$i++;
    }
}
# Now extract only those keywords which match with the search keywords:
while (($key, $val) = each %data) {
    if ( $val =~ /\w/ && $allkeywords{$key}) {
	$val =~ s/^\s+//; # remove leading whitespaces
	$val =~ s/\s+$//; # remove trailing whitespaces
	if ($key =~ /id/ && $val =~ /Any/) { # if any IDs don't use this keyword
	    next;
	}
	$value{$key}=$val;
	$keywords{$key}=$key;
	print "$key: $val\n";
    }
}
# find out which RA/Dec search mechanism is used and remove any other 
# elements from the hash of constraints:
if ($value{postype} =~ /radius/) {
    delete $value{ramin};
    delete $value{ramax};
    delete $value{decmin};
    delete $value{decmax};
    delete $keywords{ramin};
    delete $keywords{ramax};
    delete $keywords{decmin};
    delete $keywords{decmax};
}
elsif ($value{postype} =~ /minmax/) {
    delete $value{ra};
    delete $value{dec};
    delete $value{radius};
    delete $keywords{ra};
    delete $keywords{dec};
    delete $keywords{radius};
}
delete $value{postype};
delete $keyword{postype};
# Do checks on the values of the constraints that have been input.
# All but ID and name require only numerical input:
foreach $keywd (keys %value) {
    if ($keywd =~ /name/) { # if the keyword is "name" remove 2QZ and all blanks, and fix up + signs:
	$value{$keywd} =~ s/2QZ//g;
	$value{$keywd} =~ s/\s//g;
	$value{$keywd} =~ s/\+/\\\+/g;
    }
    @tmp=split(/\s+/,$value{$keywd}); # first check if there is just one element in the string
    $nelement=$#tmp;
    if ($nelement > 2) {
	print "ERROR: input value for $keywd is invalid\n";
	exit(99);
    }
    if ($nelement > 0) {
	if ($keywd !~ /ra/ && $keywd !~ /dec/) {
	    print "ERROR: input value for $keywd is invalid\n";
	    exit(98);
	}
    }
    if ($keywd =~ /id/) {
	if ($value{$keywd} !~ /^([a-zA-Z])*(\?{0,2})$/ ) { # check for a valid string
	    print "ERROR: input value for $keywd is invalid: $value{$keywd}\n";
	    exit(97);
	}
	if ($value{$keywd} =~ /noid/) {
	    $value{$keywd}='\?\?';
	}
    }
    elsif ($keywd !~ /name/) {
	foreach $val (@tmp) {
	    if ($val !~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?$/ ) { # checks for a number
		print "ERROR: input value for $keywd is invalid\n";
		exit(96);
	    }
	}
    }
}
# If the ramin, ramax, decmin, decmax keywords are set then convert to
# radians (uses set_ra() and set_dec()):
if ($keywords{ramin}) {
    @tmp=split(/\s+/,$value{ramin});
    $value{ramin}=set_ra(@tmp);
}
if ($keywords{ramax}) {
    @tmp=split(/\s+/,$value{ramax});
    $value{ramax}=set_ra(@tmp);
}
if ($keywords{decmin}) {
    @tmp=split(/\s+/,$value{decmin});
    $value{decmin}=set_dec(@tmp);
}
if ($keywords{decmax} =~ /decmax/) {
    @tmp=split(/\s+/,$value{decmax});
    $value{decmax}=set_dec(@tmp);
}
# find out whether we have both min and max RA limits:
$raminmax=0;
if ($keywords{ramax} && $keywords{ramin}) {
    if ($value{ramin} < $value{ramax}) {
	$raminmax=1; # normal min < max
    }
    else {
	$raminmax=2; # min > max, so wrap around RA=0h
    }
}

# open an output file in to put the catalogue file:
open (OUT, "> ".$outfile);

# if the ra,dec,radius keywords are used they need to be all used
# so check to make sure that they are and convert the values to radians for
# use later on (call to set_ra() and set_dec() made to check whether the
# input was in radians or hh mm ss format).  Also check that the coordinates
# input are within the 2QZ survey area:
$nrmin=2.5842;
$nrmax=3.8851;
$ndmin=-0.0522;
$ndmax=0.0357;
$srmin=5.6827; # these take care of the RA=0h 
$srmax=0.8623; # wrap around
$sdmin=-0.5637;
$sdmax=-0.4751;
if ( $keywords{ra} || $keywords{dec} || $keywords{radius}) {
    if ($keywords{ra} !~ /ra/ || $keywords{dec} !~ /dec/  || $keywords{radius} !~ /radius/){
	print "\nERROR: for a search around a position all 3 keywords required:\n";
	print "       ra, dec, radius\n";
	exit(12);
    }
    else {
	@tmp=split(/\s+/,$value{ra});
	$racent=set_ra(@tmp);
	@tmp=split(/\s+/,$value{dec});
	$deccent=set_dec(@tmp);
# if the search position is outside the 2QZ region flag the error.  The limits are
# approximate (as the actual survey limits are defined in B1950):
	unless (($racent > $nrmin && $racent < $nrmax && $deccent < 0.0357 && $deccent >$ndmin ) || (($deccent < $sdmax && $deccent > $sdmin) && ($racent > $srmin || $racent < $srmax))) {
	    print "\nERROR: coordinates outside of 2QZ survey range\nApprox. 9h 50m -- 14h 50m, -2.5deg -- +2.5deg\n    And 21h 40m -- 3h 20m, -32.5deg -- -27.5deg\n";
	    exit(13);	    
	}
	$radius=$value{radius};
	$radius=$radius*$dtor/60.0;
	$racentplus=$racent+2*$pi;  # ra centre + 360 deg for RA=0 overlap
	$racentminus=$racent-2*$pi; # ra centre - 360 deg for RA=24 overlap
	$raposextent=$racent+$radius*cos($deccent);
	$ranegextent=$racent-$radius*cos($deccent);
	$poswrap=0;
	$negwrap=0;
	if ($raposextent > 2*$pi) { # see if the search area cuts across 24h
	    $poswrap=1;
	}
	if ($ranegextent < 0) { # see if the search area cuts across 0h
	    $negwrap=1;
	}
	$centresearch=1;
    }
}
#------------------------------------------------------------------------------
# All the checks and setup stuff are now done so open the catalogue file and
# read in the entries.  The catalogue MUST be set up so that the best ID
# is placed in ID_1.
open ( CAT , $catfile ) or die "can\'t open catalogue file\n";
$nlines=0;
while (  $line = <CAT> ) {
    chomp($line);
    $lines[$nlines]=$line;
    $nlines++;
}
close(CAT);

# Now for the real grunt work...  scan through the catalogue entries and find
# the objects which match the selection criteria, writing the selected objects
# to the output file:
$nselected=0;
for ($i=0; $i<$nlines; $i++) {
#    if (substr($lines[$i],1,3) eq "2QZ") {
#      rlinepub($lines[$i]); # this for the old 10k public release catalogue file
#      $racat=$raradj;
#      $deccat=$decradj;
#    }
#    else { 
    rlinefast($lines[$i]); # this is a standard catalogue file
    $racat=($ra1j+$ra2j/60.0+$ra3j/3600.0)*15.0*$dtor;
    $deccat=$dsignj*($dec1j+$dec2j/60.0+$dec3j/3600.0)*$dtor;
#    }
    $test=1; # selected object: test=1; unselected object: test=0
    foreach $keywd (keys %value) { # loop over all the keywords
        if ($test == 0) {
          last; # if $test=0 then give up with this object
        }
# check for an object name:
	if ($keywd eq "name") {
	    $test1=string_check($iauname,$value{name});
	    $test2=string_check($catname,$value{name});
	    if ($test1 == 0 && $test2 == 0) {$test=0;}
	}
# checks for magnitude and colour ranges:	
	elsif ($keywd eq "bmin") {
	    $test=min_check($b,$value{bmin});
	}
	elsif ($keywd eq "bmax") {
	    $test=max_check($b,$value{bmax});
	}
	elsif ($keywd eq "umin") {
	    $test=min_check($ub+$b,$value{umin});
	}
	elsif ($keywd eq "umax") {
	    $test=max_check($ub+$b,$value{umax});
	}
	elsif ($keywd eq "rmin") {
	    $r=$b-$br;
	    if ($br < -5) { # get proper upper limit r mags
		$r=$r-10.0;
	    }
	    $test=min_check($r,$value{rmin});
	}
	elsif ($keywd eq "rmax") {
	    $r=$b-$br;
	    if ($br < -5) { # get proper upper limit r mags
		$r=$r-10.0;
	    }
	    $test=max_check($r,$value{rmax});
	}
	elsif ($keywd eq "ubmin") {
	    $test=min_check($ub,$value{ubmin});
	}
	elsif ($keywd eq "ubmax") {
	    $test=max_check($ub,$value{ubmax});
	}
	elsif ($keywd eq "brmin") {
	    $test=min_check($br,$value{brmin});
	}
	elsif ($keywd eq "brmax") {
	    $test=max_check($br,$value{brmax});
	}
# check for redshift, quality and ID:
	elsif ($keywd eq "zmin") {
	    $test=min_check($z1,$value{zmin});
	}
	elsif ($keywd eq "zmax") {
	    $test=max_check($z1,$value{zmax});
	}
	elsif ($keywd eq "qualmin") {
	    $test=min_check($zq1,$value{qualmin});
	}
	elsif ($keywd eq "qualmax") {
	    $test=max_check($zq1,$value{qualmin});
	}
	elsif ($keywd eq "id") {
	    $test=string_check($id1,$value{id});
	}
	elsif ($keywd eq "subid") {
	    $test=string_check($id1,$value{subid});
	}
	elsif ($keywd eq "snmin") {
	    $test=min_check($sn1,$value{snmin});
	}
	elsif ($keywd eq "snmax") {
	    $test=max_check($sn1,$value{snmax});
	}
# check for positional limits:
	elsif ($keywd eq "decmin") {
	    $test=min_check($deccat,$value{decmin});
	}
	elsif ($keywd eq "decmax") {
	    $test=max_check($deccat,$value{decmax});
	}
# need to do something clever here.  If only one of ramin and ramax
# is specified then do the normal min/max checking.  But if both
# are specified then we need to do some checks for the RA=0h wrap 
# around
	elsif ($keywd eq "ramin" && $raminmax == 0) {
	    $test=min_check($racat,$value{ramin});
	}
	elsif ($keywd eq "ramax" && $raminmax == 0) {
	    $test=max_check($racat,$value{ramax});
	}
    }
# do RA min/max test:
    if ($test == 1) {
	if ($raminmax == 1){ # this is a normal min/max test
	    if ($racat < $value{ramin} || $racat > $value{ramax}) {
		$test=0;
	    }
	}
	if ($raminmax == 2) { # this the RA=0h wrap case
	    if ($racat > $value{ramax} && $racat < $value{ramin}) {
		$test=0;
	    }
	}
    }
# do a search around a central position.  In some cases this has to be done 
# more than once because of the RA=0h wrap around.  This is the most time 
# intensive bit of the searching so only so this when everything else is done:
    if ($centresearch == 1 && $test == 1) {
	$postest1=0;
	$postest2=0;
	$postest3=0;
	$postest1=position_check($racat,$deccat,$racent,$deccent,$radius);
	if ($poswrap == 1) { # check for wrap around 24h
	    $postest2=position_check($racat,$deccat,$racentminus,$deccent,$radius);
	}
	if ($negwrap == 1) { # check for wrap around 0h
	    $postest3=position_check($racat,$deccat,$racentplus,$deccent,$radius);
	}
	if ($postest1 == 1 || $postest2 == 1 || $postest3 == 1) {
	    $test=1;
	}
	else {
	    $test=0;
	}
    }
# finally print the selected lines:
    if ($test == 1) {
	print OUT "$lines[$i]\n"; # write to catalogue file 
	$linetest[$i]=1;
	$nselected++;
    }
}
close(OUT);

print "$nselected objects selected and written to $outfile\n";

exit(0);

###############################################################################
###############################################################################
# subroutines...
###############################################################################
# subroutine to print out help information:
sub help {
    print "CAT_SEARCH.PL HELP\n";
    print "------------------\n";
    print "This script does a generalized search through the 2QZ catalogue\n";
    print "The syntax used in the following:\n\n";
    print "cat_search.pl <catalogue_file> <output_file> <constraint1> <constraint2>...\n\n";
    print "the constraints all take the form:\n\n";
    print "<keyword>=<value>\n\n";
    print "currently useable keywords are:\n\n";
    print "keyword  |  definition\n";
    print "----------------------------------------------------\n";
    print "name     |  sub-string within either the IAU or catalogue name\n";
    print "----------------------------------------------------\n";
    print "bmin     |  minimum (bright) bj magnitude\n";
    print "bmax     |  maximum (faint) bj magnitude\n";
    print "umin     |  minimum (bright) u magnitude\n";
    print "umax     |  maximum (faint) u magnitude\n";
    print "rmin     |  minimum (bright) r magnitude\n";
    print "rmax     |  maximum (faint) r magnitude\n";
    print "ubmin    |  minimum (blue) u-bj magnitude\n";
    print "ubmax    |  maximum (red) u-bj magnitude\n";
    print "brmin    |  minimum (blue) bj-r magnitude\n";
    print "brmax    |  maximum (red) bj-r magnitude\n";
    print "----------------------------------------------------\n";
    print "ramin    |  minimum ra (hh mm ss or decimal degrees)\n";
    print "ramax    |  maximum ra (hh mm ss or decimal degrees)\n";
    print "decmin   |  minimum dec (+-dd mm ss or decimal degrees)\n";
    print "decmax   |  maximum dec (+-dd mm ss or decimal degrees)\n";
    print "----------------------------------------------------\n";
    print "zmin     |  minimum redshift\n";
    print "zmax     |  maximum redshift\n";
    print "qualmin  |  minimum quality flag value (>=11)\n";
    print "qualmax  |  maximum quality flag value (<=33)\n";
    print "id       |  string to search IDs for\n";
    print "snmin    |  minimum signal-to-noise\n";
    print "snmax    |  maximum signal-to-noise\n";
#    print "comment  |  string to find in comments\n";
    print "----------------------------------------------------\n";
    print "ra       |  centre of search region (hh mm ss or degrees)   )\n";
    print "dec      |  centre of search region (+-dd mm ss or degrees) ) must be used\n";
    print "radius   |  search radius in arcminutes                     )     together\n";
    print "----------------------------------------------------\n";
    print "\n";
    print "\n";
    print "positional arguments:\n";
    print "These can be given in the standard (hh mm ss.s) type of format, or can be\n";
    print "given in decimal degrees (NOT decimal radians).  The search radius is always\n";
    print "in arcminutes\n\n";
    print "A simple example:\n";
    print "cat_search.pl sgp.cat out.cat bmin=20.5 bmax=20.0\n";
    print "This example will find all objects in the range 20<bj<20.5\n";
    print "\n";
    print "A more complicated example is:\n";
    print "cat_search.pl sgp.cat out.cat ra=01 30 00 dec=-30 20 00 radius=5 id=QSO\n";
    print "or\n";
    print "search_cat.pl sgp.cat out.cat ra=22.5 dec=-30.33333 radius=5 id=QSO\n";
    print "this example will find all objects within 5 acrminutes of the specified coordinates\n";
    print "which are identifed as QSOs\n";
    return;
}
###############################################################################
# subroutine to determine RA in radians depending on whether the input
# is (hh mm ss) or radians: 
sub set_ra {
    my @ra=@_;
    if (scalar(@ra) == 3) {
	$rarad=($ra[0]+$ra[1]/60.0+$ra[2]/3600.0)*15.0*$dtor;
    }
    elsif (scalar(@ra) == 1) {
	$rarad=$ra[0]*$dtor;
    }
    else {
	print "\n\nERROR: converting RA\n";
	exit(14);
    }
    return $rarad;
}
###############################################################################
# subroutine to determine Dec in radians depending on whether the input
# is (dd mm ss) or radians: 
sub set_dec {
    my @dec=@_;
    if (scalar(@dec) == 3) {
	$decrad=(abs($dec[0])+$dec[1]/60.0+$dec[2]/3600.0)*$dtor;
	if ($dec[0] =~ /-/) {
	    $decrad=-1.0*$decrad;
	}
    }
    elsif (scalar(@dec) == 1) {
	$decrad=$dec[0]*$dtor;
    }
    else {
	print "\n\nERROR: converting Declination\n";
	exit(15);
    }
    return $decrad;
}
###############################################################################
# subroutine to check if an object is selected above an abitrary minimum value
sub min_check {
    if ($_[0] >= $_[1]) {
	return 1;
    }
    else {
	return 0;
    }
}
###############################################################################
# subroutine to check if an object is selected below an abitrary maximum value
sub max_check {
    if ($_[0] <= $_[1]) {
	return 1;
    }
    else {
	return 0;
    }
}
###############################################################################
# subroutine to check if an object is less than a set distance
# away from a point in ra,dec space.  Coordinates specified in
# radians, and the small angle approximation is used.  Usage:
# position check ( ra, dec, ra_cent, dec_cent, radius)
sub position_check {
    my $diff = (($_[0]-$_[2])**2*cos($_[1])*cos($_[3])+($_[1]-$_[3])**2)**0.5;
    if ($diff <= $_[4]) {
        return 1;
    }
    else {
        return 0;
    }
}
###############################################################################
# subroutine to check is an object contains a string:
sub string_check {
    if ($_[0] =~ $_[1]) {
	return 1;
    }
    else {
	return 0;
    }
}

###############################################################################
# subroutine to read a catalogue entry in the format of the old 10k public 2QZ
# catalogue.  Now obselete, but included here for backwards compatability.
sub rlinepub {
    ($dum,$iauname,$ra1j,$ra2j,$ra3j,$dec1j,$dec2j,$dec3j,$raradj,$decradj,$b,$ub,$br,$nobs,$z1,$zq1,$id1,$date1,$fobs1,$sn1,$z2,$zq2,$id2,$date2,$fobs2,$sn2,$zprev,$radio,$xray,$dust)=split(/\s+/,$_[0]);
# set up checks for declination sign:
    if ($dec1j =~ /-/) {
	$dsignj=-1;
	$dsigncharj="-";
    }
    else {
	$dsignj=1.0;
	$dsigncharj="+";
    }
# remove signs (-/+) from declination:
    $dec1j=~s/-//;
    $dec1j=~s/\+//;
    return;
}

###############################################################################
# A quick version of the rline routine using unpack.  This uses an extact 
# description of the catalogue file format so is less flexible (need to be
# careful of minor catalogue format changes) but about twice as quick::
#
sub rlinefast {
# define the format:
    my $lineform="a16xa2xa2xa5xa1a2xa2xa4xa5xa10xa25xa2xa2xa5xa1a2xa2xa4xa3xa9xa9xa11xa11xxxxa6xxxa7xxxa7xxxa1xa6xa2xa10xa8xa4xa3xa7xa6xa2xa10xa8xa4xa3xa7xa5xa6xa7xa7xa20xa20";   
# do the unpacking:
    ($iauname,$ra1j,$ra2j,$ra3j,$dsigncharj,$dec1j,$dec2j,$dec3j,$catno,$catname,$sector,$ra1,$ra2,$ra3,$dsignchar,$dec1,$dec2,$dec3,$ukstfld,$apmx,$apmy,$rarad,$decrad,$b,$ub,$br,$nobs,$z1,$zq1,$id1,$date1,$fobs1,$fibre1,$sn1,$z2,$zq2,$id2,$date2,$fobs2,$fibre2,$sn2,$zprev,$radio,$xray,$dust,$comment1,$comment2)=unpack($lineform,$_[0]);
# do declination sigh stuff:
    $dsign=1;
    if ($dsignchar =~ /-/) {$dsign=-1;} 
    $dsignj=1;
    if ($dsigncharj =~ /-/) {$dsignj=-1;} 
    return;
}


###############################################################################
# subroutine to read the catalogue entries in a standard format 2QZ catalogue 
# file
sub rline {
    my @tmp=split(/\s+/," ".$_[0]);
    $iauname=$tmp[1];
    $ra1j=$tmp[2];
    $ra2j=$tmp[3];
    $ra3j=$tmp[4];
    $dec1j=$tmp[5];
    $dec2j=$tmp[6];
    $dec3j=$tmp[7];
    $catno=$tmp[8];
    $catname=$tmp[9];
    $sector=$tmp[10];
    $ra1=$tmp[11];
    $ra2=$tmp[12];
    $ra3=$tmp[13];
    $dec1=$tmp[14];
    $dec2=$tmp[15];
    $dec3=$tmp[16];
    $ukstfld=$tmp[17];
    $apmx=$tmp[18];
    $apmy=$tmp[19];
    $rarad=$tmp[20];
    $decrad=$tmp[21];
    $b=$tmp[22];
    $ub=$tmp[23];
    $br=$tmp[24];
    $nobs=$tmp[25];
    $z1=$tmp[26];
    $zq1=$tmp[27];
    $id1=$tmp[28];
    $date1=$tmp[29];
    $fobs1=$tmp[30];
    $fibre1=$tmp[31];
    $sn1=$tmp[32];
    $z2=$tmp[33];
    $zq2=$tmp[34];
    $id2=$tmp[35];
    $date2=$tmp[36];
    $fobs2=$tmp[37];
    $fibre2=$tmp[38];
    $sn2=$tmp[39];
    $zprev=$tmp[40];
    $radio=$tmp[41];
    $xray=$tmp[42];
    $dust=$tmp[43];
    $comment1=$tmp[44];
    $comment2=$tmp[45];
# set up checks for declination sign:
    $dsign=1.0;
    $dsignchar="+";
    if ($dec1 =~ /-/) {
	$dsign=-1;
	$dsignchar="-";
    }
    $dsignj=1.0;
    $dsigncharj="+";
    if ($dec1j =~ /-/) {
	$dsignj=-1;
	$dsigncharj="-";
    }
# remove signs (-/+) from declination:
    $dec1=~s/-//;
    $dec1=~s/\+//;
    $dec1j=~s/-//;
    $dec1j=~s/\+//;
    return;
}

###############################################################################