#!/usr/bin/env /proj/axaf/bin/perlwrap
BEGIN
{
    $ENV{SYBASE} = "/soft/sybase";
    $ENV{LANG} = "";
}

use strict;
use DBI;
use DBD::Sybase;
use Astro::ADS::Query;
use Astro::ADS::Result;
use Astro::ADS::Result::Paper;
use Tk;

use vars qw($syb_pwd $ocat_pwd $VERSION %param 
	    $dbh1 $dsn1 $dbh2 $dsn2
	    $mw $cat $work_frame $abs_submit $cat_button
	    $read_flag $status $category $obsid %category %status
	    $status $get_abs $abs_source $month $year $get_bibs $cat_art
	    $obs_list $work_comment $obsid_entry $obsid_page
	    %obsid $start_bib $start_bib_aux $acis $hrc $letg $hetg $hrma 
	    $pcad $ephin $ops $software $multiwave $followup $theory
	    $next $previous $cancel $cancel_art $count @list
	    $total_bibs $ads_db %pub_type %pub_form %bib_def %cxc_sets
	    $pub_type $pub_form $refereed);
$VERSION = '$Id: bibcat,v 1.35 2005/01/05 19:31:10 arcops Exp $';

{
    use Getopt::Long;
    parse_opts();
    
    if ($param{version})
    {
        print $VERSION, "\n";
        exit( 0 );
    }
    
    if ($param{help}) 
    { 
        usage(0);
    }

    use Term::ReadKey;
    if ($param{test}) {
	ReadMode 'noecho';
	print "Enter password for arcops on sqlbeta: \n";
	$syb_pwd = ReadLine( 0 );
	chomp $syb_pwd;
	print "Enter password for $param{U} on sqlbeta: \n";
	$ocat_pwd = ReadLine( 0 );
	chomp $ocat_pwd;
	ReadMode 'restore';
    }
    else {
	ReadMode 'noecho';
	print "Enter password for dbcron on sybase: \n";
	$syb_pwd = ReadLine( 0 );
	chomp $syb_pwd;
	print "Enter password for $param{U} on ocatsqlsrv: \n";
	$ocat_pwd = ReadLine( 0 );
	chomp $ocat_pwd;
	ReadMode 'restore';
    }
    my $user = 'bibcat_user';
    my $server = "server=sybase";
    my $db = "database=bibcodes_working";
    my $script_name = "scriptName=bibcat";
    if ($param{test}) {
	$server = "server=sqlbeta";
	$db = "database=axafapstat";
	$user = 'test_user';
    }

    # Database connection 1: this connection is to the database
    # that contains the working tables 
    print "dbh1: connecting $user to $server in $db\n";
    $dsn1 = "DBI:Sybase:$server;$script_name;$db";
    $dbh1 = DBI->connect($dsn1, $user, $syb_pwd, {
        PrintError => 0,
        RaiseError => 1});

    # Database connection 2: this connection is to the database
    # that contains the final tables
    $server = "server=servername";
    $server = "server=sqlbeta" if ($param{test});
    $db = "database=bibcodes";
    print "dbh2: connecting $param{U} to $server in $db\n";
    $dsn2 = "DBI:Sybase:$server;$script_name;$db";
    $dbh2 = DBI->connect($dsn2, $param{U}, $ocat_pwd, {
        PrintError => 0,
        RaiseError => 1});

    # Check that user has proper permissions to update final tables
    # It is assumed that the user for connection 1 owns the working
    # tables and can therefor edit them
    my $perm = 'no';
    my $query = qq(execute sp_activeroles);
    my $sqlh2 = $dbh2->prepare($query);
    $sqlh2->execute();
    while( my ($role) = $sqlh2->fetchrow_array) {
	$perm = 'yes' if ($role =~ /bibcat\_role/);
    }
    $sqlh2->finish;

    if ($perm eq 'no') {
	warn("$param{U} does not have bibcat_role\n");
	exit(0);
    }

    # Get the starting number of entries in bibcode tables to keep 
    # track of how many papers were checked and found during the session
    ($start_bib, $start_bib_aux) = get_counts();
 
    my $log = "===== " . scalar localtime() . " [$param{U}] =====\n";
    print2log($log);
    printsql($log);

    # These hashes contain the text for the various sets of buttons
    %category = ("1" => "1 presents specific\nobservation(s)",
		 "2" => "2 refers to published results",
		 "3" => "3 predicts Chandra results",
		 "4" => "4 on instrumentation,\nsoftware, or operations",
		 "5" => "5 cannot be classified");
    
    %status = ("OK" => "OK",
	       "Confirmation requested" => "R",
	       "Confirmation to be requested" => "P",
	       "Journal not available on-line" => "J",
	       "Not Chandra related" => "NA",
	       "Bibcode not found" => "Q",
	       "Hold" => "H",
	       "Withdrawn" => "W");

    %pub_type = ("Book" => "B",
		 "Government Publication" => "G",
		 "Thesis" => "T",
		 "Journal" => "J",
		 "Proceedings" => "P",
		 "Circular" => "C",
		 "Review" => "R",
		 "Newsletter" => "N",
		 "On-Line Data Catalog" => "O",
		 "Multimedia" => "M");

    %pub_form = ("Article" => "art",
		 "Abstract" => "abs",
		 "Memo" => "memo",
		 "Data" => "data",
		 "Errata" => "err",
		 "Article (abstract only)" => "art0",
		 "Title" => "title");

    # Populate %bib_def from the bib2pub table
    my $bibdef = $dbh1->prepare(qq(select bib_string, pub_type, pub_form, 
				   refereed from bib2pub));
    $bibdef->execute();
    while (my($bibstring, $ptype, $pform, $ref) = $bibdef->fetchrow_array) {
	$bib_def{$bibstring}{'pub_type'} = $ptype;
	$bib_def{$bibstring}{'pub_form'} = $pform;
	$bib_def{$bibstring}{'refereed'} = $ref;
    }

    # Populate %cxc_sets from the datasets table
    my $sets = $dbh2->prepare(qq(select dataset, set_id from datasets));
    $sets->execute();
    while (my($set, $set_id) = $sets->fetchrow_array) {
	$cxc_sets{$set}{'set_id'} = $set_id;
	$cxc_sets{$set}{'flag'} = 0;
    }

    # Create the main window
    $mw = MainWindow->new;
    $mw->title("Bibcode Cataloger");
    $mw->geometry("+0+0");
    my $button_frame = $mw->Frame(-borderwidth => 2,
				  -relief => 'flat'
				  )->pack(-side => 'top',
					  -pady => 5,
					  -fill => 'none');
    my $quit = $button_frame->Button(-text => "Quit", 
				     -command => sub {
					 # Get the ending number of entries 
					 # in bibcode tables
					 my ($end_bib, $end_bib_aux) = 
					     get_counts();
					 my $total_bib = $end_bib - $start_bib;
					 my $total_bib_aux = 
					     $end_bib_aux - $start_bib_aux;
					 print "$total_bib entries were added to bibcodes.\n";
					 print "$total_bib_aux entries were added to bibcodes_main.\n";
					 print2log("$total_bib entries were added to bibcodes.\n");
					 print2log("$total_bib_aux entries were added to bibcodes_main.\n");
					 exit(0);}
				     )->pack(-side => 'left',
					     -fill => 'none');

    # Get abstracts - This function creates a list of bibcodes for a specified
    # month/year for either the AST/PHY/INST ads databases.  The new entries
    # are inserted into bibcodes_work.  The results of the ADS query are kept
    # in /data/mola/chandracite/AST|PHY|INST.  If no new entries are added to
    # bibcodes_work, those files are deleted.
    $get_abs = $button_frame->Button(-text => "Get Abstracts",
				     -command => \&do_GetAbstracts
				     )->pack(-side => 'left',
					     -fill => 'none');

    # Categorize papers - This function creates a list of bibcodes which
    # have not bee categorized.  The user can then step through the list
    # using Previous/Next buttons.  A Netscape window linked to the ADS
    # abstract is then produced.
    $cat_art = $button_frame->Button(-text => "Categorize Papers",
				      -command => \&do_CatPap
				      )->pack(-side => 'left',
					      -fill => 'none');

    # This frame holds the buttons for whichever function is being performed.
    $work_frame = $mw->Frame(-borderwidth => 2,
				-relief => 'flat',
			     )->pack(-side => 'bottom');
    MainLoop;
}

#****************************************************************************
# Subroutine for parse opts
#****************************************************************************
sub parse_opts
{

  %param = (
            U => undef,
            verbose => 0
           );

  GetOptions( \%param,
              "U=s",
              "verbose",
              "version",
              "help",
	      "test"
            ) or exit(1);

  return if $param{help} or $param{version};


  my $err = 0;
  while ( my ( $par, $val ) = each ( %param ) )
  {
    next if defined $val;
    warn("parameter `$par' not set\n");
    $err++;
  }

  exit(1) if $err;

}

#****************************************************************************
# Subroutine for usage statements
#****************************************************************************
sub usage
{
  my ( $exit ) = @_;

  local $^W = 0;
  require Pod::Text;
  Pod::Text::pod2text( '-75', $0 );
  exit $exit;
}

#****************************************************************************
# Subroutine to write to the log
#****************************************************************************
sub print2log {
    my ($line) = @_;
    if ($param{test}) {
	print $line;
    }
    else {
	open (LOG, ">>/data/mola/chandracite/LOGS/bibcat.log") ||
	    die "Sorry, couldn't open /data/mola/chandracite/LOGS/bibcat.log: $!\n";
	print LOG $line;
	close LOG;
    }
}

#****************************************************************************
# Subroutine to write failed sql to a file for editing
#****************************************************************************
sub printsql {
    my ($insert) = @_;
    if ($param{test}) {
	print $insert;
    }
    else {
	open (SQL, ">>/data/mola/chandracite/SQL/bibcat.sql") ||
	    die "Sorry, couldn't open /data/mola/chandracite/SQL/bibcat.sql: $!\n";
	print SQL $insert;
	close SQL;
    }
}

#****************************************************************************
# Subroutine to get the number of entries in bibcodes and bibcodes_main
#****************************************************************************
sub get_counts {
    my $count1 = $dbh2->prepare(qq(select count(*) from bibcodes));
    my $count2 = $dbh2->prepare(qq(select count(*) from bibcodes_main));
    $count1->execute();
    my ($bib_count) = $count1->fetchrow_array;
    $count1->finish;
    $count2->execute();
    my ($bibaux_count) = $count2->fetchrow_array;
    $count2->finish;
    return ($bib_count, $bibaux_count);
}

#****************************************************************************
# Subroutine to get list of bibcodes where the article needs to be read
#****************************************************************************
sub get_art_list {
    my $sqlh1 = $dbh1->prepare(qq (select bibcode from bibcodes_work where 
				   (status not in ("OK", "NA", "Q", "W") and 
				   read_flag = "Y") or read_flag = null or 
				   (read_flag = "Y" and pub_form = "art0")));
    $sqlh1->execute();
    my @list;
    while (my ($bibcode) = $sqlh1->fetchrow_array) {
	push @list, $bibcode;
    }
    $sqlh1->finish;
    return @list;
}

#****************************************************************************
# Subroutine to get list of bibcodes from ads and put them into bibcodes_work
#****************************************************************************
sub get_bibcodes {
    print2log("Getting bibcodes from $abs_source for $month/$year\n");
    my (@date) = localtime;
    my $yr = $date[5] + 1900;
    my $timestamp = sprintf "$yr-%02d-%02d_%02d:%02d:%02d", 
    $date[4], $date[3], $date[2], $date[1], $date[0];
    if ($param{test}) {
	system `/home/arcops/src/Bibcodes/test_get_list_${abs_source} $month $year $timestamp`;
    }
    else {
	system `/home/arcops/src/Bibcodes/get_list_${abs_source} $month $year $timestamp`;
    }

    my $query = $dbh1->prepare(qq(select count(*) from bibcodes_work 
				  where bibcode = ?));
    # Use this insert if this publication is not in the bib2pub table
    my $insert1 = $dbh1->prepare(qq(insert into bibcodes_work 
				   (bibcode, source, loc_date, year, month)
				   values (?, ?, getdate(), ?, ?)));
    # Use this insert if this publication is in the bib2pub table
    my $insert2 = $dbh1->prepare(qq(insert into bibcodes_work 
				   (bibcode, source, loc_date, year, month,
				    pub_type, pub_form, refereed)
				   values (?, ?, getdate(), ?, ?, ?, ?, ?)));

    my $total_bibcodes = 0;
    my $entered_bibcodes = 0;

    my $dir = "/data/mola/chandracite/${abs_source}/";
    $dir = "./" if $param{test};
    my $file = "abstract_$year$month.$timestamp";
    my $file2 = "abstract_$year${month}.orig.$timestamp.gz";

    open (LIST, "$dir$file") ||
	die "Sorry, couldn't open $dir$file: $!\n";
    while (<LIST>) {
	chomp;
	my $bibcode = $_;
	next if $bibcode =~ /tmp/;
	$total_bibcodes++;
	$query->execute($bibcode);
	my $count = $query->fetchrow_array;
	$query->finish;
	if ($count == 0) {
	    my ($bibstring) = match_pub($bibcode);
	    if ($bibstring eq "none") {
		$insert1->execute($bibcode, $abs_source, $year, $month);
		$insert1->finish;
	    }
	    else {
		$insert2->execute($bibcode, $abs_source, $year, $month, 
				  $bib_def{$bibstring}{'pub_type'}, 
				  $bib_def{$bibstring}{'pub_form'}, 
				  $bib_def{$bibstring}{'refereed'});
	    }
	    title_insert($bibcode, $abs_source);
	    $entered_bibcodes++;
	}
    }
    close LIST;
    print "$entered_bibcodes entered out of $total_bibcodes submitted\n";
    print2log("$entered_bibcodes entered out of $total_bibcodes submitted\n");
    if ($entered_bibcodes == 0) {
	unlink "$dir$file";
	unlink "$dir$file2";
    }
}

#****************************************************************************
# Subroutine to get default publication information
#****************************************************************************
sub match_pub {
    my ($bibcode) = @_;
    my $bibstring = "";
    while (my ($string, $value) = each(%bib_def)) {
	my $found = "no";
	$found = "yes" if ($bibcode =~ /$string/);
	$bibstring = $string if $found eq "yes";
    }
    $bibstring = "none" if !$bibstring;
    return $bibstring;
}

#****************************************************************************
# Subroutine to get pub_date from ads for a bibcode
#****************************************************************************
sub get_pub_date {
    my ($bibcode) = @_;
    my ($month, $year);
    # Need to get pub_date from bibcodes_work because there is no
    # article for ADS to link to
    my $sqlh = $dbh1->prepare(qq(select month, year from bibcodes_work 
				 where bibcode = ?));
    $sqlh->execute($bibcode);
    ($month, $year) = $sqlh->fetchrow_array;
    $sqlh->finish;

    $month = "0$month" if $month < 10;
    return "$month/15/$year";
}

#****************************************************************************
# Subroutine to get abstract summary from ads; also creates the netscape 
# session.
#****************************************************************************
sub get_summary {
    my ($bibcode) = @_;
#    print "$bibcode\n";

#    This is now commented out because Alberto pointed us to a
#    different proxy server
#    $bibcode =~ s/%/%25/;  # one has to escape the % (%25) in %26 for the 
                            # -remote option in Netscape
    print "$bibcode\n";
    #system `netscape -remote 'openURL(http://adsabs.harvard.edu/cgi-bin/nph-bib_query?bibcode=$bibcode)'`;
    my $url = qq(netscape -remote 'openURL(http://80-adsabs.harvard.edu.ezp1.harvard.edu/cgi-bin/nph-bib_query?bibcode=$bibcode)');
#    print $url, "\n";
    system($url);
    #system `netscape -remote 'openURL("http://80-adsabs.harvard.edu.ezp2.harvard.edu/cgi-bin/nph-bib_query?bibcode=$bibcode")'`;
}

#****************************************************************************
# Subroutine to create the Get Abstracts page
#****************************************************************************
sub do_GetAbstracts {
    $get_abs->configure(-state => 'disabled');
    $cat_art->configure(-state => 'disabled');
    print2log("----- Get Abstracts -----\n");
    my $abs_frame = $work_frame->Frame(-borderwidth => 2,
				       -relief => 'ridge',
				       -label => "Retrieve bibcodes from ads"
				       )->pack;

    my $button_frame = $abs_frame->Frame->pack(-side => 'bottom',
					 -fill => 'none');
    $get_bibs = $button_frame->Button(-text => "Get Bibcodes",
				     -state => 'disabled',
				     -command => sub {
					 get_bibcodes();
					 $get_abs->configure
					     (-state => 'disabled');
					 $cat_art->configure
					     (-state => 'disabled');
				     }
				     )->pack(-side => 'left',
					     -fill => 'none');
    $cancel = $button_frame->Button(-text => "Cancel",
				    -command => sub {
					$abs_frame->destroy 
					    if Tk::Exists($abs_frame);
					$get_abs->configure
					    (-state => 'normal');
					$cat_art->configure
					    (-state => 'normal');
					$abs_source = "";
					$month = "";
					$year = "";
				    })->pack(-side => 'left',
					     -fill => 'none');
    my $bib_frame = $abs_frame->Frame(-borderwidth => 2,
				       -relief => 'flat',
				       )->pack(-side => 'top');
    
    my $source_frame = $bib_frame->Frame(-label => "ADS db"
					    )->pack(-side => 'left',
						    -padx => 50);
    
    foreach (qw/AST PHY INST/) {
	$source_frame->Radiobutton(-text => $_,
				   -value => $_,
				   -variable => \$abs_source,
				   -width => 6,
				   -anchor => 'w',
				   -command => \&abs_get_on
				   )->pack(-side => 'top',
					   -fill => 'none');
    }
    my %mon = ("Jan" => '01',
	       "Feb" => '02',
	       "Mar" => '03',
	       "Apr" => '04',
	       "May" => '05',
	       "Jun" => '06',
	       "Jul" => '07',
	       "Aug" => '08',
	       "Sep" => '09',
	       "Oct" => '10',
	       "Nov" => '11',
	       "Dec" => '12');
    my $mon_frame = $bib_frame->Frame(-label => "Month",
				      )->pack(-side => 'left',
					      -padx => 15,
					      -fill => 'none');
    my $mon_list = $mon_frame->Scrolled("Listbox", -scrollbars => 'e',
					-selectmode => "single",
					-exportselection => 0,
					-width => 5,
					-height => 3,
					-selectbackground => 'white')->
					    pack(-side => 'top');
    $mon_list->insert('end', qw/Jan Feb Mar Apr May Jun Jul 
		      Aug Sep Oct Nov Dec/);

    foreach my $key (qw/Jan Feb Mar Apr May Jun Jul 
		     Aug Sep Oct Nov Dec/) {
	$mon_list->bind('<Button-1>', 
			sub { $month = 
				  $mon{$mon_list->get($mon_list->curselection())};
			      abs_get_on();
			  });
    }

    my $year_frame = $bib_frame->Frame(-label => "Year",
				       )->pack(-side => 'left',
					       -padx => 15,
					       -fill => 'none');
    my $year_list = $year_frame->Scrolled("Listbox", -scrollbars => 'e',
					  -selectmode => "single",
					  -exportselection => 0,
					  -width => 5,
					  -height => 3,
					  -selectbackground => 'white')->
                                              pack(-side => 'top');
    $year_list->insert('end', qw/1999 2000 2001 2002 2003 2004 2005 2006 
		       2007 2008 2009 2010/);
    foreach (qw/1999 2000 2001 2002 2003 2004 2005 2006 
	     2007 2008 2009 2010/) {
	$year_list->bind('<Button-1>', 
			sub { $year = 
				  $year_list->get($year_list->curselection());
			      abs_get_on();
			  });
    }
}

#****************************************************************************
# Subroutine to create the Categorize Articles page
#****************************************************************************
sub do_CatPap {
    $get_abs->configure(-state => 'disabled');
    $cat_art->configure(-state => 'disabled');
    print2log("----- Read Articles -----\n");
    @list = get_art_list();
    $total_bibs = scalar @list;
    $total_bibs--;
    $count = 1;
    my $bibcode = $list[$count];
    get_params($bibcode);
    get_summary($bibcode);

    # Bibcode frame
    my $bib_frame = $work_frame->Frame(-borderwidth => 2,
				       -relief => 'ridge',
				       -label => "Read and Categorize Articles",
				       )->pack(-side => 'top');
    
    my $ads_frame = $bib_frame->Frame(-borderwidth => 2,
				       -relief => 'flat',
				       -label => "$ads_db: $bibcode\n$count of $total_bibs")->pack;
    
    my $button_frame = $bib_frame->Frame(-borderwidth => 2,
					  -relief => 'flat'
					  )->pack(-side => 'bottom',
						  -pady => 20,
						  -fill => 'none');
    $previous = $button_frame->Button(-text => "Previous",
				      -state => "disabled",
				      -command => sub {
					  $count--;
					  $count = 0 if $count < 0;
					  $bibcode = $list[$count];
					  $previous->configure
					      (-state => 'disabled') if 
						  Exists($previous) and
						      $count == 0;
					  get_params($bibcode);
					  $ads_frame->configure(-label => "$ads_db: $bibcode\n$count of $total_bibs");
					  get_summary($bibcode);
					  $cat_button->configure
                                              (-state => 'normal') 
                                              if $read_flag eq 'Y';
					  $cat_button->configure
                                              (-state => 'disabled') 
                                              if $read_flag eq 'N';
					  $next->configure
					      (-state => 'normal');
					  $next->configure
					      (-state => 'disabled') if 
						  $count == scalar @list - 1;
				      })->pack(-side => 'left',
					       -fill => 'none');
    $next = $button_frame->Button(-text => "Next", 
				  -command => sub {
				      $count++;
				      $count = scalar @list - 1 
					  if $count > scalar @list - 1;
				      $previous->configure
					  (-state => 'normal');
				      $next->configure
					  (-state => 'disabled') if 
					      $count == scalar @list - 1;
				      $bibcode = $list[$count];
				      get_params($bibcode);
				      $ads_frame->configure(-label => "$ads_db: $bibcode\n$count of $total_bibs");
				      get_summary($bibcode);
				      $cat_button->configure
                                          (-state => "disable") 
                                              unless $read_flag eq 'Y';
				  })->pack(-side => 'left',
					   -fill => 'none');
    $cancel = $button_frame->Button(-text => "Cancel",
				    -command => sub {
					$bib_frame->destroy 
					    if Tk::Exists($bib_frame);
					$get_abs->configure
					    (-state => 'normal');
					$cat_art->configure
					    (-state => 'normal');
				    })->pack(-side => 'left',
					     -fill => 'none');
    
    
    my $read_flag_frame = $bib_frame->Frame(-label => "read_flag"
					    )->pack(-side => 'left',
						    -padx => 50);
    
    foreach (qw/Y N Null/) {
	$read_flag_frame->Radiobutton(-text => $_,
				      -value => $_,
				      -variable => \$read_flag,
				      -width => 10,
				      -anchor => 'w',
				      -command => sub{
					  set_read($bibcode) 
					      if (Exists($cat_button));
				      }
				      )->pack(-side => 'top',
					      -fill => 'none');
    }

    $cat_button = $bib_frame->Button(-text => "Categorize Paper",
				     -command => sub {
					 do_CatArt($bibcode);
					 $previous->
					     configure(-state => 'disabled');
					 $next->
					     configure(-state => 'disabled');
					 $cancel->
					     configure(-state => 'disabled');
				     }
				     )->pack(-side => 'right',
					     -padx => 50);
    $cat_button->configure(-state => "disable") unless $read_flag eq 'Y';
}

#****************************************************************************
# Subroutine to create the Categorize Article page
#****************************************************************************
sub do_CatArt {
    my ($bibcode) = @_;
    $obs_list = "";
    get_params($bibcode);
    if (! Exists($cat)) {
	$cat = $mw->Toplevel();
	$cat->title("Categorize Article - $bibcode");
	$cat->geometry("+0+200");
	my $button_frame = $cat->Frame->pack(-side => 'bottom',
					     -fill => 'none');
	$abs_submit = $button_frame->Button(-text => "Submit",
					    -command => sub {
						submit_pap_cat($bibcode);
						$cancel_art->
						    configure(-state => 
							      'disabled')
							if (Exists($cancel_art));
						if (Exists($previous) and
						    $count == 0) {
						    $previous->configure
							(-state => 'disabled');
						}
						else {
						    $previous->configure
							(-state => 'normal');
						}
						$next->configure
						    (-state => 'normal');
						$next->configure
						    (-state => 'disabled') if 
							$count ==  
							    scalar @list - 1;
                                                $cancel-> configure
                                                    (-state => 'normal');
					    }
					    )->pack(-side => 'left',
						    -fill => 'none');
	pap_submit_on();
	$cancel_art = $button_frame->Button(-text => "Cancel",
					    -command => sub {
						$cat->destroy 
						    if Tk::Exists($cat);
						if (Exists($previous) and
						    $count == 0) {
						    $previous->configure
							(-state => 'disabled');
						}
						else {
						    $previous->configure
							(-state => 'normal');
						}
						$next->configure
						    (-state => 'normal');
						$next->configure
						    (-state => 'disabled') if 
							$count ==  
							    scalar @list - 1;
                                                $cancel-> configure
                                                    (-state => 'normal');
					    })->pack(-side => 'left',
						     -fill => 'none');

	my $left_frame = $cat->Frame()->pack(-side => 'left');

	my $middle_frame = $cat->Frame()->pack(-side => 'left');

	my $right_frame = $cat->Frame()->pack(-side => 'left');

	my $pubform_frame = $left_frame->Frame(-label =>"Publication Form",
					       )->pack(-side => 'top',
						       -padx => 15,
						       -fill => 'none');
	foreach ("Article",
		 "Abstract",
		 "Memo",
		 "Data",
		 "Errata",
		 "Article (abstract only)",
		 "Title") {
	    $pubform_frame->Radiobutton(-text => $_,
					-anchor => 'w',
					-value => $pub_form{$_},
					-variable => \$pub_form,
					-width => 30,
					-background => 'white',
					-command => sub {
					    pap_submit_on();},
					)->pack(-side => 'top');
	}

	my $pubtype_frame = $left_frame->Frame(-label =>"Publication Type",
					       )->pack(-side => 'top',
						       -padx => 15,
						       -fill => 'none');
	foreach ("Book",
		 "Government Publication",
		 "Thesis",
		 "Journal",
		 "Proceedings",
		 "Circular",
		 "Review",
		 "Newsletter",
		 "On-Line Data Catalog",
		 "Multimedia") {
	    $pubtype_frame->Radiobutton(-text => $_,
					-anchor => 'w',
					-value => $pub_type{$_},
					-variable => \$pub_type,
					-width => 30,
					-background => 'white',
					-command => sub {
					    pap_submit_on();},
					)->pack(-side => 'top');
	}

	my $read_flag_frame = $left_frame->Frame(-label => "Refereed"
					    )->pack(-side => 'top',
						    -padx => 15);
    
	foreach (qw/Y N Null/) {
	    $read_flag_frame->Radiobutton(-text => $_,
					  -value => $_,
					  -variable => \$refereed,
					  -width => 10,
					  -anchor => 'w',
					  -background => 'white',
					  -command => sub{
					      pap_submit_on();}
					  )->pack(-side => 'top');
	}

	my $work_frame = $left_frame->Frame(-label => "Working Comments",
					     )->pack(-side => 'top',
						     -fill => 'none');
	my $work_entry = $work_frame->Entry(-textvariable => \$work_comment,
					    -width => 30,
					    -background => 'white',
					    )->pack(-side => 'top');

	my $status_frame = $middle_frame->Frame(-label => "Status",
					      )->pack(-side => 'top',
						      -padx => 15,
						      -fill => 'none');
	foreach ("OK",
		 "Confirmation requested",
		 "Confirmation to be requested",
		 "Journal not available on-line",
		 "Not Chandra related",
		 "Bibcode not found",
		 "Hold") {
	    $status_frame->Radiobutton(-text => $_,
				       -anchor => 'w',
				       -value => $status{$_},
				       -variable => \$status,
				       -width => 30,
				       -background => 'white',
				       -command => sub {
					   pap_submit_on();},
				       )->pack(-side => 'top');
	}

	my $cat_frame = $middle_frame->Frame(-label => "Category",
				    )->pack(-side => 'top',
					    -padx => 15,
					    -fill => 'none');
	foreach (qw/1 2 3 4 5/) {
	    $cat_frame->Radiobutton(-text => $category{$_}, 
				    -value => $_,
				    -variable => \$category,
				    -width => 35,
				    -anchor => 'w',
				    -background => 'white',
				    -justify => 'left',
				    -command => sub{
					pap_submit_on();
					obsid_on();
				    }
				    )->pack(-side => 'top');
	}

	my $obsid_frame = $middle_frame->Frame(-label => "Obsid(s) - comma separated",
					       )->pack(-side => 'top',
						       -pady => 15,
						       -fill => 'none');
	$obsid_entry = $obsid_frame->Entry(-textvariable => \$obs_list,
					   -width => 30,
					   -validate => 'key',
					   -validatecommand => sub{
					       $abs_submit->
						   configure(-state => 
							     'normal');
					       ($_[1] =~ /[\d,\s]/) ||
						   ($_[0] =~ /\d+/);
					   },

					   -invalidcommand => sub {
					       $obsid_frame->bell;
					   }
					   )->pack(-side => 'top');
	obsid_on();

	my $inst_frame = $right_frame->Frame(-label => "Instrument",
				     )->pack(-side => 'top',
					     -padx => 15,
					     -fill => 'none');
	my $acis_cb = $inst_frame->Checkbutton(-text => 'ACIS',
					       -variable => \$acis,
					       -width => 20,
					       -anchor => 'w',
					       -background => 'white',
					       -onvalue => 1,
					       -offvalue => 0)->
						   pack(-side => 'top');
	my $hrc_cb = $inst_frame->Checkbutton(-text => 'HRC',
					      -variable => \$hrc,
					      -width => 20,
					      -anchor => 'w',
					      -background => 'white',
					      -onvalue => 1,
					      -offvalue => 0)->
						  pack(-side => 'top');
	my $letg_cb = $inst_frame->Checkbutton(-text => 'LETG',
					       -variable => \$letg,
					       -width => 20,
					       -anchor => 'w',
					       -background => 'white',
					       -onvalue => 1,
					       -offvalue => 0)->
						   pack(-side => 'top');
	my $hetg_cb = $inst_frame->Checkbutton(-text => 'HETG',
					       -variable => \$hetg,
					       -width => 20,
					       -anchor => 'w',
					       -background => 'white',
					       -onvalue => 1,
					       -offvalue => 0)->
						   pack(-side => 'top');
	my $hrma_cb = $inst_frame->Checkbutton(-text => 'HRMA',
					       -variable => \$hrma,
					       -width => 20,
					       -anchor => 'w',
					       -background => 'white',
					       -onvalue => 1,
					       -offvalue => 0)->
						   pack(-side => 'top');
	my $pcad_cb = $inst_frame->Checkbutton(-text => 'PCAD',
					       -variable => \$pcad,
					       -anchor => 'w',
					       -width => 20,
					       -background => 'white',
					       -onvalue => 1,
					       -offvalue => 0)->
						   pack(-side => 'top');
	my $ephin_cb = $inst_frame->Checkbutton(-text => 'EPHIN',
						-variable => \$ephin,
						-width => 20,
						-anchor => 'w',
						-background => 'white',
						-onvalue => 1,
						-offvalue => 0)->
						    pack(-side => 'top');
	my $ops_cb = $inst_frame->Checkbutton(-text => 'Operations',
						-variable => \$ops,
						-width => 20,
						-anchor => 'w',
						-background => 'white',
						-onvalue => 1,
						-offvalue => 0)->
						    pack(-side => 'top');
	my $software_cb = $inst_frame->Checkbutton(-text => 'Software',
						-variable => \$software,
						-width => 20,
						-anchor => 'w',
						-background => 'white',
						-onvalue => 1,
						-offvalue => 0)->
						    pack(-side => 'top');
	my $multiwave_cb = $inst_frame->Checkbutton(-text => 'Multi-wavelenth',
						-variable => \$multiwave,
						-width => 20,
						-anchor => 'w',
						-background => 'white',
						-onvalue => 'Y',
						-offvalue => 0)->
						    pack(-side => 'top');
	my $followup_cb = $inst_frame->Checkbutton(-text => 'Follow-up',
						-variable => \$followup,
						-width => 20,
						-anchor => 'w',
						-background => 'white',
						-onvalue => 'Y',
						-offvalue => 0)->
						    pack(-side => 'top');
	my $theory_cb = $inst_frame->Checkbutton(-text => 'Theory to Explain',
						-variable => \$theory,
						-width => 20,
						-anchor => 'w',
						-background => 'white',
						-onvalue => 'Y',
						-offvalue => 0)->
						    pack(-side => 'top');

	my $dataset_frame = $right_frame->Frame(-label => "CXC Datasets",
				     )->pack(-side => 'top',
					     -padx => 30,
					     -fill => 'none');
	foreach my $set (sort keys %cxc_sets) {
	    my $set_cb = $dataset_frame->Checkbutton(-text => $set,
						     -variable => \$cxc_sets{$set}{'flag'},
						     -width => 25,
						     -anchor => 'w',
						     -background => 'white',
						     -onvalue => 1,
						     -offvalue => 0)->
							 pack(-side => 'top');
	}
    }
    else {
	$cat->deiconify();
	$cat->raise();
    }
}

#****************************************************************************
# Subroutine to get the read flag from bibcodes_work
#****************************************************************************
sub get_params {
    my ($bibcode) = @_;
    my ($obsid_list, $cxc_list);
    my $sqlh1 = $dbh1->prepare(qq(select read_flag, status, comment, ref_id, 
				  obs_list, acis, hrc, letg, hetg, hrma,
				  pcad, ephin, operations, software, 
				  multiwave, followup, theory, 
				  source, pub_type, pub_form, 
				  refereed, cxc_set from bibcodes_work 
				  where bibcode = ?));
    $sqlh1->execute($bibcode);
    ($read_flag, $status, $work_comment, 
     $category, $obsid_list, $acis, $hrc,
     $letg, $hetg, $hrma, $pcad, $ephin, 
     $ops, $software, $multiwave, $followup, 
     $theory, $ads_db, $pub_type, 
     $pub_form, $refereed, $cxc_list) = $sqlh1->fetchrow_array;
    $sqlh1->finish;
    if ($obsid_list == 1) {
	# get the obsids and put them into a string
	my $obsq = $dbh1->prepare(qq(select obsid from obs_list where 
				     bibcode = ?));
	$obsq->execute($bibcode);
	while (my ($obsid) = $obsq->fetchrow_array) {
	    $obs_list .= "$obsid, ";
	}
	$obsq->finish;
	$obs_list =~ s/, $//;
    }
    # Reinitialize %cxc_sets
    foreach my $set (keys %cxc_sets) {
	$cxc_sets{$set}{'flag'} = 0;
    }
    if ($cxc_list eq "Y") {
	# get the cxc_sets and put them into the cxc_sets hash
	my $setq1 = $dbh1->prepare(qq(select set_id from bib2set_work where 
				     bibcode = ?));
	my $setq2 = $dbh2->prepare(qq(select dataset from datasets where 
				      set_id = ?));
	$setq1->execute($bibcode);
	while (my ($set_id) = $setq1->fetchrow_array) {
	    $setq2->execute($set_id);
	    my ($set) = $setq2->fetchrow_array;
	    $setq2->finish;
	    $cxc_sets{$set}{'flag'} = 1;
	}
	$setq1->finish;
    }
    $read_flag = "Null" if !$read_flag;
    $pub_form = "Null" if !$pub_form;
    $pub_type = "Null" if !$pub_type;
    $refereed = "Null" if !$refereed;
}

#****************************************************************************
# Subroutine to set the read flag
#****************************************************************************
sub set_read {
    my ($bibcode) = @_;

    if ($read_flag eq 'Y') {
	$cat_button->configure(-state => "normal");
	my $query = $dbh1->prepare(qq(update bibcodes_work 
				      set read_flag = ? 
				      where bibcode = ?));
	$query->execute($read_flag, $bibcode);
	$query->finish;
    }
    else {
	$cat_button->configure(-state => "disabled");
	if ($read_flag eq 'N') {
	    my $query = $dbh1->prepare(qq(update bibcodes_work 
					  set read_flag = ? 
					  where bibcode = ?));
	    $query->execute($read_flag, $bibcode);
	    $query->finish;

	    clean_bibcodes($bibcode);
	}
	else {
	    my $query = $dbh1->prepare(qq(update bibcodes_work 
					  set read_flag = null 
					  where bibcode = ?));
	    $query->execute($bibcode);
	    $query->finish;

	    clean_bibcodes($bibcode);
	}
    }
    print2log("read_flag set to $read_flag for $bibcode in bibcodes_work\n");
}


#****************************************************************************
# Subroutine to turn get abstracts on
#****************************************************************************
sub abs_get_on {
    $get_bibs->configure(-state => 'normal') if ($abs_source and $month and
						$year);
}

#****************************************************************************
# Subroutine to turn paper submit on
#****************************************************************************
sub pap_submit_on {
    if ($pub_type =~ /Null/ or !$pub_form =~ /Null/ or !$refereed =~ /Null/) {
	$abs_submit->configure(-state => 'disabled');
    }
    elsif ($status and $category) {
	if ($category != 1 or ($category == 1 and 
			       $pub_form =~ /abs|memo|art0/)) {
	    $abs_submit->configure(-state => 'normal');
	}
	else {
	    if ($status !~ /OK|U/) {
		$abs_submit->configure(-state => 'normal');
	    }
	    else {
		my $stat = 0;
		foreach my $set (keys %cxc_sets) {
		    if ($cxc_sets{$set}{'flag'} == 1) {
			$stat = 1;
		    }
		}
		my (@obsids) = split /,/, $obs_list;
		foreach my $obsid (@obsids) {
		    $obsid =~ s/^\s+//;
		    $obsid =~ s/\s+$//;
		    $stat = 1 if ($obsid =~ /^\d+$/);
		}
		if ($stat == 1 or $status !~ /OK/) {
		    $abs_submit->configure(-state => 'normal');
		}
		$abs_submit->configure(-state => 'normal') if $stat == 1;
		$abs_submit->configure(-state => 'disabled') if $stat == 0;
	    }
	}
    }
    else {
	$abs_submit->configure(-state => 'disabled');
    }
    if ($status =~ /NA|J|Q|H/) {
	$abs_submit->configure(-state => 'normal');
    }

}

#****************************************************************************
# Subroutine to turn obsid entry on; the obsid is white when active, grey when
# not active.
#****************************************************************************
sub obsid_on {
    if ($category =~ /1/ and $pub_form !~ /abs|memo/) {
	$obsid_entry->configure(-state => 'normal',
				-background => 'white');
    }
    else {
	$obsid_entry->configure(-state => 'normal',
				-background => 'light grey');
	$obsid_entry->configure(-state => 'disabled');
    }
}

#****************************************************************************
# Subroutine to categorize a paper
#****************************************************************************
sub submit_pap_cat {
    my ($bibcode) = @_;
    my $type_q = $dbh2->prepare(qq(select type from axafocat..target 
				   where obsid = ?));
    my $pi_info_q = $dbh2->prepare(qq(select first, last, institution from 
				      axafocat..target t, 
				      axafocat..prop_info o, 
				      axafusers..person_short p where 
				      obsid = ? 
				      and t.ocat_propid = o.ocat_propid and 
				      piid = pers_id));
    my $coi_info_q = $dbh2->prepare(qq(select first, last, institution from 
				       axafocat..target t, 
				       axafocat..prop_info o, 
				       axafusers..person_short p where 
				       obsid = ? 
				       and t.ocat_propid = o.ocat_propid and 
				       coin_id = pers_id));

    # delete entries from bib2set_work and repopulate with the new list
    my $delete_sets = $dbh1->prepare(qq(delete from bib2set_work where 
					bibcode = ?));
    $delete_sets->execute($bibcode);
    $delete_sets->finish;

    # add entries into cxc_sets
    my $insert_set = $dbh1->prepare(qq(insert into bib2set_work values 
				       (?, ?)));
    my $cxc_set = "N";
    foreach my $dataset (keys %cxc_sets) {
	if ($cxc_sets{$dataset}{'flag'} == 1) {
	    $cxc_set = "Y";
	    $insert_set->execute($cxc_sets{$dataset}{'set_id'}, $bibcode);
	    $insert_set->finish;
	}
    }

    my (@obsids) = split /,/, $obs_list;

    # delete entries from obs_list the repopulate with the new list
    my $delete_obsids = $dbh1->prepare(qq(delete from obs_list where 
					  bibcode = ?));
    $delete_obsids->execute($bibcode);
    $delete_obsids->finish;

    # add entries into obs_list
    my $insert_obsid = $dbh1->prepare(qq(insert into obs_list values (?, ?)));
    my $stat = 0;
    my %list;
    foreach my $obsid (@obsids) {
	$obsid =~ s/^\s+//;
	$obsid =~ s/\s+$//;
	if ($obsid =~ /^\d+$/){
	    $stat = 1;
	    $list{$obsid} = 1;
	}
    }
    foreach my $obsid (keys %list) { 
	$insert_obsid->execute($bibcode, $obsid);
	$insert_obsid->finish;
    }

    my $query = qq(update bibcodes_work set status = ?, obs_list = ?,
		   ref_id = ?, acis = ?, hrc = ?, letg = ?,
		   hetg = ?, hrma = ?, pcad = ?, ephin = ?, operations = ?,
		   software = ?, multiwave = ?, followup = ?, theory = ?, 
		   pub_form = ?, pub_type = ?, refereed = ?, cxc_set = ? 
		   where bibcode = ?);

    my $sub1 = $dbh1->prepare($query);
    $sub1->execute($status, $stat, $category, 
		   $acis, $hrc, $letg, $hetg, $hrma,
		   $pcad, $ephin, $ops, $software, $multiwave, 
		   $followup, $theory, $pub_form, $pub_type, 
		   $refereed, $cxc_set, $bibcode);
    $sub1->finish;
    print2log("$bibcode updated in bibcodes_work\n");

    my $next_bibid = $dbh2->prepare(qq(select max(bib_id) from bibcodes_main));
    $next_bibid->execute();
    my ($bib_id) = $next_bibid->fetchrow_array;
    $bib_id++;
    if ($status eq "OK") {
	clean_bibcodes($bibcode);

	# Populate the bib2set table
	my $insert_set = $dbh2->prepare(qq(insert into bib2set values (?, ?)));
	my $cxc_set = "N";
	foreach my $set (keys %cxc_sets) {
	    if ($cxc_sets{$set}{'flag'} == 1) {
		$insert_set->execute($bib_id, $cxc_sets{$set}{'set_id'});
		$cxc_set = "Y";
		print2log("Inserted into cxc_set: $bib_id, $set\n");
	    }
	}

	# Populate bibcodes_main
	if ($category !~ /1/) {
	    # Update the instrument columns from datasets
	    if ($cxc_set =~ /Y/) {
		my $setq1 = $dbh1->prepare(qq(select obsid from set2obsid
					      where set_id = ?));
		my $setq2 = $dbh2->prepare(qq(select instrument, grating from 
					      axafocat..target where 
					      obsid = ?));
		foreach my $set (keys %cxc_sets) {
		    if ($cxc_sets{$set}{'flag'} == 1) {
			$setq1->execute($cxc_sets{$set}{'set_id'});
			while (my($obs) = $setq1->fetchrow_array) {
			    $setq2->execute($obs);
			    my ($inst, $grat) = $setq2->fetchrow_array;
			    $setq2->finish;
			    $acis = 1 if ($inst =~ /ACIS/);
			    $hrc = 1 if ($inst =~ /HRC/);
			    $letg = 1 if ($grat =~ /LETG/);
			    $hetg = 1 if ($grat =~ /HETG/);
			}
			$setq1->finish;
		    }
		}
	    }

	    my $sub2 = $dbh2->prepare(qq(insert into bibcodes_main 
					 (bibcode, ads_db, ref_id, pub_date, 
					  acis, hrc, letg, hetg, hrma,
					  pcad, ephin, operations, software,
					  multiwave, followup, theory, 
					  comment, bib_id,
					  cxc_set, pub_type, pub_form,
					  refereed) values (?, ?, ?, ?, ?, ?,
							    ?, ?, ?, ?, ?, ?,
							    ?, ?, ?, ?, ?, ?,
							    ?, ?, ?, ?)));
	    my ($pub_date) = get_pub_date($bibcode);
	    $sub2->execute($bibcode, $ads_db, $category, $pub_date, 
			   $acis, $hrc, $letg, $hetg, $hrma, 
			   $pcad, $ephin, $ops, $software, 
			   $multiwave, $followup, $theory, 
			   $work_comment, $bib_id, 
			   $cxc_set, $pub_type, $pub_form, $refereed);
	    $sub2->finish;
	    print2log("Inserted into bibcodes_main: $bibcode; $category; $pub_date\n");

	    kwd_insert($bibcode);

	    $cat->destroy if Tk::Exists($cat);
	    if (Exists($previous) and $count == 0) {
		$previous->configure(-state => 'disabled');
	    }
	    else {
		$previous->configure(-state => 'normal');
	    }
	    $next->configure(-state => 'normal');
	    $next->configure(-state => 'disabled') if 
		$count == scalar @list - 1;
	    $cancel-> configure(-state => 'normal');
	}
	else {
	    my $sub2 = $dbh2->prepare(qq(insert into bibcodes_main 
					 (bibcode, ads_db, ref_id, pub_date, 
					  comment, bib_id, cxc_set, pub_type,
					  pub_form, refereed, software, 
					  operations, multiwave, followup, 
					  theory) values 
					 (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)));
	    my ($pub_date) = get_pub_date($bibcode);
	    $sub2->execute($bibcode, $ads_db, $category, $pub_date, 
			   $work_comment, $bib_id, $cxc_set,
			   $pub_type, $pub_form, $refereed, $software, 
			   $ops, $multiwave, $followup, $theory);
	    $sub2->finish;
	    print2log("Inserted into bibcodes_main: $bibcode; $category; $pub_date\n");
	    kwd_insert($bibcode);
	    %obsid = ();
	    $obs_list =~ s/^\s+//;
	    $obs_list =~ s/\s+$//;
	    $obs_list =~ s/,$//;
	    my (@chars) = split //, $obs_list;
	    my $length = scalar @chars;

	    # Parse the obsid list
	    if ($obs_list =~ /,/) {
		my (@obsid) = split /,/, $obs_list;
		foreach my $obsid (@obsid) {
		    $obsid =~ s/^\s+//;
		    $obsid =~ s/\s+$//;
		    $obsid{$obsid} = "";
		}
	    }
	    elsif ($obsid =~ /\s+/) {
		my (@obsid) = split /,/, $obs_list;
		foreach my $obsid (@obsid) {
		    $obsid =~ s/^\s+//;
		    $obsid =~ s/\s+$//;
		    $obsid{$obsid} = "" if $obsid;
		}
	    }
	    else {
		$obsid{$obs_list} = "" if $obs_list;
	    }

	    my ($label_text, $prop_flag);
	    my $nonCal_flag = "N";
	    # Add the selected datasets to the obsid list
	    my $get_obsids = $dbh1->prepare(qq(select obsid from set2obsid 
					       where set_id = ?));
	    foreach my $dataset (keys %cxc_sets) {
		if ($cxc_sets{$dataset}{'flag'} == 1) {
		    if ($category == 1 and $pub_form !~ /abs|memo|art0/) {
			$get_obsids->execute($cxc_sets{$dataset}{'set_id'});
			while (my ($obs) = $get_obsids->fetchrow_array) {
			    $obsid{$obs} = "";
			}
			$get_obsids->finish;
		    }
		}
	    }

	    foreach my $obsid (keys %obsid) {
		$type_q->execute($obsid);
		my ($type) = $type_q->fetchrow_array;
		$type_q->finish;
		if (!$type) {
		    $nonCal_flag = "Y";
		    my @button;
		    $type = "Unknown";
		    $label_text = "Obsid $obsid: not in Ocat\n";
		    $prop_flag = "N";
		    push @button, $type, $label_text, $prop_flag;
		    $obsid{$obsid} = \@button;
		}
		elsif ($type !~ /CAL/) {
		    $nonCal_flag = "Y";
		    my @button;
		    $pi_info_q->execute($obsid);
		    my ($pi_first, $pi_last, $pi_inst) = 
			$pi_info_q->fetchrow_array;
		    $pi_info_q->finish;
		    $coi_info_q->execute($obsid);
		    my ($coi_first, $coi_last, $coi_inst) = 
			$coi_info_q->fetchrow_array;
		    $coi_info_q->finish;
		    $label_text = "Obsid $obsid\t$type\nPI: $pi_last, $pi_first; $pi_inst\nCoI: $coi_last, $coi_first; $coi_inst\n";
		    $prop_flag = "Y";
		    push @button, $type, $label_text, $prop_flag;
		    $obsid{$obsid} = \@button;
		}
		else{
		    my @button;
		    push @button, $type, "foo", "N";
		    $obsid{$obsid} = \@button;
		}
	    }

	    # Create the obsid page to check if paper is a proposal paper if
	    # there are non-Cal obsids
	    if ($nonCal_flag =~ /Y/ ) {
		if (!Exists($obsid_page)) {
		    $obsid_page = $mw->Toplevel();
		    $obsid_page->title("Proposal Flag for non-Cal Observations");
		    $obsid_page->minsize(450, 300);
		    $obsid_page->geometry("+0+450");
    
		    my $button_frame = $obsid_page->Frame->pack(-side => 
								'bottom',
								-pady => 15,
								-fill => 
								'none');
		    my $obs_submit = $button_frame->Button(-text => "Submit",
							   -command => sub {
							       submit_pap($bibcode);
							   }
							   )->pack(-side => 
								   'left',
								   -fill => 
								   'none');
		    my $cancel_obs = $button_frame->Button(-text => "Cancel",
							   -command => sub {
							       $obsid_page->destroy 
								   if Tk::Exists($obsid_page);
							       $cancel_art->
								   configure
								       (-state
									=> 
									'normal');
							   })->pack(-side => 'left',
								    -fill => 'none');
		    
		    require Tk::Pane;		    
		    my $obsid_frame = $obsid_page->
			Scrolled("Pane", -scrollbars => "ow",
				 -borderwidth => 2,
				 -relief => 'ridge',
				 -height => 300)->pack(-side => 'top',
						      -pady => 15);

		    foreach my $obsid (keys %obsid) {
			if ($obsid{$obsid}[0] !~ /CAL/) {
			    my $obs_frame = $obsid_frame->Frame(-label => 
								$obsid{$obsid}[1],
								-labelPack => 
								[-side => 'right',
								 -padx => 15,],
								-width => 500
								)->pack(-side =>
									'top');
			    
			    foreach (qw/Y N/) {
				$obs_frame->Radiobutton(-text => $_,
							-value =>$_,
							-variable => 
							\$obsid{$obsid}[2],
							)->pack(-side => 'left',
								-fill => 
								'none');
			    }
			}
		    }
		}
	        else {
		    $obsid_page->deiconify();
		    $obsid_page->raise();
		}
	    }
	    else {
		submit_pap($bibcode);
	    }
	}
    }
    elsif($status =~ /NA/)  {
	clean_bibcodes($bibcode);
	$cat->destroy if Tk::Exists($cat);
	if (Exists($previous) and $count == 0) {
	    $previous->configure(-state => 'disabled');
	}
	else {
	    $previous->configure(-state => 'normal');
	}
	$next->configure(-state => 'normal');
	$next->configure(-state => 'disabled') if $count == scalar @list - 1;
	$cancel-> configure(-state => 'normal');
    }
    else {
	$cat->destroy if Tk::Exists($cat);
	if (Exists($previous) and $count == 0) {
	    $previous->configure(-state => 'disabled');
	}
	else {
	    $previous->configure(-state => 'normal');
	}
	$next->configure(-state => 'normal');
	$next->configure(-state => 'disabled') if $count == scalar @list - 1;
	$cancel-> configure(-state => 'normal');
    }
}

#****************************************************************************
# Subroutine to insert title/author information
#****************************************************************************
sub title_insert {
    my ($bibcode, $ads_db) = @_;
    my $bibq = "$bibcode&db_key=$ads_db";
    my $ads_query = new Astro::ADS::Query(Bibcode => $bibq);
    $ads_query->url("adsabs.harvard.edu");
    my $result = $ads_query->querydb();
    my $paper = $result->poppaper();
    if (!$paper) {
	print "$bibcode: bibcode not found\n";
    }
    else {
	my ($title) = $paper->title();
	my ($first_author) = $paper->authors();
	my ($query, $insert);
	eval {
	    $query = qq(insert into bib_author_title values ("$bibcode", "$first_author", "$title"));
	    $insert = $dbh1->do($query);
	};
	if ($@) {
	    print "Insert issue; please check /data/mola/chandracite/SQL/bibcat.sql\n";
	    printsql($query)
	}
    }
}

#****************************************************************************
# Subroutine to insert keywords
#****************************************************************************
sub kwd_insert {
    my ($bibcode) = @_;
    my $get_bib_id = $dbh2->prepare(qq(select bib_id from bibcodes_main 
				       where bibcode = ?));
    my $kwd_insert = $dbh2->prepare(qq(insert into bib2keyword values 
				       (?, ?, ?, ?)));
    my $get_std_id = $dbh2->prepare(qq(select std_id from stdkwd_links 
				       where keyword = ?));
    my $bibq = "$bibcode&db_key=$ads_db";
    my $ads_query = new Astro::ADS::Query(Bibcode => $bibq);
    $ads_query->url("adsabs.harvard.edu");
    my $result = $ads_query->querydb();
    my $paper = $result->poppaper();
    if (!$paper) {
	print "$bibcode: bibcode not found\n";
    }
    else {
	$get_bib_id->execute($bibcode);
	my ($bib_id) = $get_bib_id->fetchrow_array;
	$get_bib_id->finish;
	my @keywords = $paper->keywords();
	my $count = 0;
	foreach my $keyword (@keywords) {
	    chomp $keyword;
	    $keyword =~ s/^\s+//;
	    $keyword =~ s/\s+$//;
	    my $kwd_string = lc "$keyword";  # lower case the string
	    $kwd_string =~ s/\s//g;          # remove all spaces
	    $kwd_string =~ s/\W//g;          # remove puncuation
	    $kwd_string =~ s/^\d+//;         # remove leading digits
	    
#	    print "$keyword\n\t$kwd_string\n";
	    if ($kwd_string) {
		$get_std_id->execute($kwd_string);
		my ($std_id) = $get_std_id->fetchrow_array;
		$get_std_id->finish;
		$kwd_insert->execute($bib_id, $keyword, 
				     $kwd_string, $std_id);
		$kwd_insert->finish;
		$count++;
	    }
	}
	print2log "Inserted into $count entries into bib2keyword: $bibcode\n" 
	    if ($count > 0);
    }
	
}

#****************************************************************************
# Subroutine to submit a paper with proposal flags
#****************************************************************************
sub submit_pap {
    my ($bibcode) = @_;
    $previous->configure(-state => 'disabled') 
	if Exists($previous) and $count == 0;
    $next->configure(-state => 'disabled') 
	if $count == scalar @list - 1;

    my $query = $dbh2->prepare(qq(select bib_id from bibcodes_main where 
				  bibcode = ?));
    $query->execute($bibcode);
    my ($bib_id) = $query->fetchrow_array;
    $query->finish;
    my $instrument = $dbh2->prepare(qq(select instrument, grating from 
				       axafocat..target where obsid = ?));
    my $insert1 = $dbh2->prepare(qq(insert into bibcodes (obsid, bibcode, 
							  pub_date, 
							  prop_paper, 
							  bib_id) 
				    values (?, ?, ?, ?, ?)));
    foreach my $obsid (keys %obsid) {
	my $prop_flag = $obsid{$obsid}[2];
	my $pub_date = get_pub_date($bibcode);
	$insert1->execute($obsid, $bibcode, $pub_date, 
			 $prop_flag, $bib_id);
	$insert1->finish;
	print2log("Inserted $bibcode, $obsid, $pub_date into bibcodes.\n");

	# Update the instrument bits in bibcodes_main
	$instrument->execute($obsid);
	my ($inst, $grat) = $instrument->fetchrow_array;
	$instrument->finish;
	if ($inst =~ /ACIS/) {
	    my $update = $dbh2->prepare(qq(update bibcodes_main 
					   set acis = 1 where bibcode = ?));
	    $update->execute($bibcode);
	    $update->finish;
	}
	if ($inst =~ /HRC/) {
	    my $update = $dbh2->prepare(qq(update bibcodes_main 
					   set hrc = 1 where bibcode = ?));
	    $update->execute($bibcode);
	    $update->finish;
	}
	if ($grat =~ /HETG/) {
	    my $update = $dbh2->prepare(qq(update bibcodes_main 
					   set hetg = 1 where bibcode = ?));
	    $update->execute($bibcode);
	    $update->finish;
	}
	if ($grat =~ /LETG/) {
	    my $update = $dbh2->prepare(qq(update bibcodes_main 
					   set letg = 1 where bibcode = ?));
	    $update->execute($bibcode);
	    $update->finish;
	}
    }
    $obsid_page->destroy if Tk::Exists($obsid_page);
    $cat->destroy if Tk::Exists($cat);
}

#****************************************************************************
# Subroutine to delete entries from bibcode_main
#****************************************************************************
sub clean_bibcodes {
    my ($bibcode) = @_;
    my $query = $dbh2->prepare(qq(select count(*) from bib2set s, 
				  bibcodes_main m where s.bib_id = m.bib_id 
				  and bibcode like '$bibcode'));
    $query->execute();
    my ($count) = $query->fetchrow_array;
    $query->finish;

    if ($count > 0) {
	my $del = $dbh2->prepare(qq(delete from bib2set where bib_id = 
				    (select bib_id from bibcodes_main where 
				     bibcode like '$bibcode')));
	$del->execute;
	$del->finish;
	print2log("$count records with bibcode $bibcode were deleted from bib2set\n");
    }
 
    $query = $dbh2->prepare(qq(select count(*) from bibcodes_main 
			       where bibcode = ?));
    $query->execute($bibcode);
    ($count) = $query->fetchrow_array;
    $query->finish;

    if ($count > 0) {
	my $del = $dbh2->prepare(qq(delete from bibcodes_main 
				    where bibcode like '$bibcode'));
	$del->execute();
	$del->finish;
	print2log("$count records with bibcode $bibcode were deleted from bibcodes_main\n");
    }
    $query = $dbh2->prepare(qq(select count(*) from bibcodes 
			       where bibcode = ?));
    $query->execute($bibcode);
    ($count) = $query->fetchrow_array;
    $query->finish;

    if ($count > 0) {
	my $del = $dbh2->prepare(qq(delete from bibcodes 
				    where bibcode like '$bibcode'));
	$del->execute();
	$del->finish;
	print2log("$count records with bibcode $bibcode were deleted from bibcodes\n");
    }

    $query = $dbh2->prepare(qq(select count(*) from bib2keyword kwd, 
			       bibcodes_main m where kwd.bib_id = m.bib_id 
			       and bibcode = ?));
    $query->execute($bibcode);
    ($count) = $query->fetchrow_array;
    $query->finish;

    if ($count > 0) {
	my $del = $dbh2->prepare(qq(delete from bib2keyword kwd,
				    bibcodes_main m where 
				    kwd.bib_id = m.bib_id and
				    bib_id like '$bibcode'));
	$del->execute();
	$del->finish;
	print2log("$count records with bibcode $bibcode were deleted from bib2keyword\n");
    }
}

__END__

=head1 USAGE

bibcat [options]

=head1 OPTIONS

B<bibcat> uses long option names.  You can type as few characters as
are necessary to match the option name.

=over 4

=item B<-U> (user)

username for logging onto sql server

=item B<-help>

displays documentation for B<bibcat>

=item B<-version>

displays the version

=item B<-verbose>

displays required options

=item B<-test>

connects to the test server installation

=back

=head1 DESCRIPTION

This script creates a gui for categorizing Chandra bibcodes.

=head1 AUTHOR

Sherry L. Winkelman
