#
# A collection of tcl input/output routines for gap4 databases...
#
# Ben Tubby (bt1) 11/10/00.
#


package gapio;

@ISA = qw(Exporter);
@EXPORT = qw(setup_gap4_environment
             write_note
             return_gap_contig_lengths
             write_note2
             database_information
             check_gap_database
             create_tag_file
             write_tags
             return_no_of_contigs
             return_contig_order
             return_all_readings
             return_read_info
             Return_names_and_identifiers
             new_return_read_info
             return_contig_readinfo
             get_contig_list_info
             get_largest_contig
             get_contig_order_hash
             );
             
             
use strict;


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

{
    my $stash_path;

    sub setup_gap4_environment {
	if (defined($stash_path)) { return $stash_path; }

	my $machine = `uname -srm`;
	chomp($machine);
	
	unless ($machine) {
	    die "Error: 'uname' didn't return a machine identifier.\n";
	}
	
	$machine =~ s/ /-/g;
	$machine =~ s/SunOS-4.*/sun/;
	$machine =~ s/IRIX.*/sgi/;
	$machine =~ s/SunOS-5.*/solaris/;
	$machine =~ s/OSF.*alpha/alpha/;
	$machine =~ s/Linux.*i.86/linux/;
	$machine =~ s/Linux.*ia64/linux-ia64/;
	$machine =~ s/Linux.*x86_64/linux-x86_64/;
	$machine =~ s/Linux.*/linux/;
	$machine =~ s/FreeBSD.*/linux/;
	$machine =~ s/Darwin.*/macosx/;
	
	$ENV{MACHINE}          = $machine;
	$ENV{STADENROOT}       = "/usr/local/badger/gap4_production";
	$ENV{STADTABL}         = "$ENV{STADENROOT}/tables";
	$ENV{STADLIB}          = "$ENV{STADENROOT}/lib";
	if (exists($ENV{LD_LIBRARY_PATH})) {
	    $ENV{LD_LIBRARY_PATH}  = "$ENV{STADENROOT}/lib/${machine}-binaries:$ENV{LD_LIBRARY_PATH}";
	} else {
	    $ENV{LD_LIBRARY_PATH}  = "$ENV{STADENROOT}/lib/${machine}-binaries";
	}
	$ENV{TCL_LIBRARY}      = "$ENV{STADENROOT}/lib/tcl";
	$ENV{TK_LIBRARY}       = "$ENV{STADENROOT}/lib/tk";
	
	$stash_path = "$ENV{STADENROOT}/${machine}-bin/stash";
	return $stash_path;
    }
}

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

sub write_note{
    my ($pr, $pver, $note_to_add, $reading_id)= @_;


    my $gap4sh = &setup_gap4_environment();


    my $output;
    my $script = <<EOF;
    set io [ open_db -name $pr -version $pver -access rw]
    set note [new_note -io \$io -type INFO -to reading -number $reading_id]
    puts \$note
    set edit [edit_note -io \$io -note \$note -comment {$note_to_add}]
    puts \$edit    
    close_db -io \$io\nexit\n
EOF
    
    open(GAP, "echo '$script' | $gap4sh |") || die "Couldn't run $gap4sh $!\n";
    
    while (<GAP>) {
        $output = $_;
    }   
    close(GAP) || die "Error running $gap4sh $!\n";
    chomp $output;
    return $output;
}

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

sub return_gap_contig_lengths{
    my ($pr, $pver, $CONTIG_LENGTH_CUTOFF) = @_;


    my $gap4sh = &setup_gap4_environment();    
    #print "\n* gapio::return_gap_contig_lengths using >$gap4sh< *\n";
    
    my %contig_lengths;

    my $script = <<EOF;
    load_package gap
    set io [ open_db -name $pr -version $pver -access r ]
    set clist ""
    set num_contigs [db_info num_contigs \$io]
    for {set i 1} {\$i <= \$num_contigs} {incr i} {
    set nc [expr \$num_contigs - (\$i-1)]
    set order [contig_order_to_number -io \$io -order \$i]
    set c [io_read_contig \$io \$order]
    set l [keylget c length]
    set r [keylget c left]
    set m [io_read_reading \$io [keylget c left]]
    set contig_name [io_read_text \$io [keylget m name]]
    lappend clist "\$r \$contig_name \$l \$i \$num_contigs "
    }
    puts \$clist 
    close_db -io \$io\nexit\n
EOF

    open(GAP, "echo '$script' | $gap4sh |") || die "ERROR: Couldn't run $gap4sh $!\n";    
    my $contig_count = 0;
    my $subset_contig_count = 0;
 
    while (<GAP>) {
        while (/\{(.*?)\}/g) {
            my ($c_id, $read_id,$length,$cn,$numc) = split(" ", $1);
            $contig_count++;
            if ($length >= $CONTIG_LENGTH_CUTOFF){
                $contig_lengths{$c_id} = $length;
               # print "$length $c_id\n";
                $subset_contig_count++;
            }
        }
    }
    close(GAP) || die "ERROR: Error running $gap4sh $!\n";
    return (\%contig_lengths, $contig_count, $subset_contig_count);
}



#################################################################################
sub write_note2{
    #
    # Much better version of the above..  The calling code constructs $tcl_string
    # which contains all the tcl to execute.  As this was about 6000 lines of tcl,
    # the only way to feed it to gap4sh was to write it all to a file.  
    #

    my ($pr, $pver, $tcl_string, $debug)= @_;
    
    my $gap4sh = &setup_gap4_environment();    
    print "\n* gapio::write_note2 using >$gap4sh< *\n";

    my $output;
#    print "\n$tcl_string\n";

    open(TOGAP, "> /tmp/gap4_script.$$") || die "Couldn't open /tmp/gap4_script.$$ $!\n";
    print TOGAP "load_package gap\n";
    print TOGAP $tcl_string;
    close(TOGAP) || die "Error writing /tmp/gap4_script.$$ $!\n";

    open(GAP, "$gap4sh /tmp/gap4_script.$$ |") || die "Couldn't run $gap4sh $!\n";
    while (<GAP>) {
        $output = $_;
    }   
    close(GAP) || die "Error running $gap4sh $!\n";

    unlink("/tmp/gap4_script.$$") unless $debug;

    chomp $output;
    return $output;
}

#################################################################################
sub database_information{
    #
    # This routine returns a hash ref contains LOTS of database specific
    # information.  No. Contigs, no reads etc./..
    #
    #
    my ($pr, $pver)= @_;
    
    my $gap4sh = &setup_gap4_environment();    

    my $output;
    my $script = <<EOF;
    load_package gap
    set io [ open_db -name $pr -version $pver -access r]
    puts [ io_read_database \$io ]
    close_db -io \$io\nexit\n
EOF
    
    open(GAP, "echo '$script' | $gap4sh |") || die "Couldn't run $gap4sh $!\n";
    
      
    my %info;
    while (<GAP>) {
       # print $_;
        
        while (/\{(.*?)\}/g) {
            my ($key, $val) = split(" ", $1);
            $info{$key} = $val;
        }
    }

    close(GAP) || die "Error running $gap4sh\n";
    
    return \%info;
}

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

sub check_gap_database{
    my ($pr, $pver)= @_;
    
    my $output;
    my $gap4sh = setup_gap4_environment();
    my $script = <<EOF;
load_package gap
set io [ open_db -name $pr -version $pver -access r]
check_database -io \$io
close_db -io \$io
exit
EOF

    open(GAP, "echo '$script' | $gap4sh |") || die "Couldn't run $gap4sh $!\n";
    while (<GAP>) {
        $output = $_;
    }   
    close(GAP) || die "Error running $gap4sh\n";
    chomp $output;

    
    if ($output =~ /is logically consistent/){
        # database is fine...
        return 0;
    }else{
        # database is knackered...
        return 1;
    }
}

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

sub create_tag_file{
    my ($pr, $pver, $oligo_arrayref, $tag_type, $tag_description, $debug) = @_;
    
    #
    # Given an array of oligo sequences, this routine
    # returns a string in the format of a staden template tag block.
    # (containing 1 entry for each sequence)
    # currently pretty specific to consedoligos2gap, but stuff could be passed in
    #
    # bt1 25/04/01
    #

    my $gap4sh = &setup_gap4_environment();
    print "** Using >$gap4sh< **\n" if ($debug); 

    #print "o Project: $pr.$pver\n" if ($debug);
   
    my $date = localtime();

    #
    # Construct tcl script...
    #
    my $script =
    "load_package gap
     set io [ open_db -name $pr -version $pver -access r]
     set db [io_read_database \$io]
     set nreads [keylget db num_readings]\n";       
    
    foreach my $se (@{$oligo_arrayref}){
        my ($primer, $direction) = split ("_", $se);
        my $s = <<EOF;
        for {set i 1} {\$i <= \$nreads} {incr i} {
            set r [io_read_reading \$io \$i]
            set seq [io_read_text \$io [keylget r sequence]]
            set dseq [depad_seq \$seq tr]
            set pos [string first $primer \$dseq]
            if {\$pos != -1} {  
                set st \$tr(\$pos)
                set start [expr {\$st+1}]
                set end \$tr([expr {\$pos+[string length $primer]}])
                puts "OLIGO:$primer ID:\$i START:\$start END:\$end DIRECTION:$direction"
                #puts "start(when un-padded):\$pos length:[string length $primer]"
            } else {
                # complement the primer to search
                set compprimer [complement_seq $primer]
                set pos [string first \$compprimer \$dseq]
                if {\$pos != -1} {
                    set st \$tr(\$pos)
                    set start [expr {\$st+1}]
                    set end \$tr([expr {\$pos+[string length $primer]}])
                    puts "OLIGO:\$compprimer ID:\$i START:\$start END:\$end DIRECTION:$direction"
                    #puts "COMPLEMENTED primer ($primer) start(when un-padded):\$pos length:[string length $primer]"
                 } else {
                  #  puts ":("
                 }        
            }
}
EOF

    $script = "$script"."$s";
    }
    $script = "$script". "close_db -io \$io\nexit\n";
  
#  print "$script" if ($debug);
    
    my $tmpfile = "/tmp/gap_tcl.tmp";
    print "\no Writing tcl script in $tmpfile\n" if ($debug);
    open (TMP, ">$tmpfile") || die "Failed to open tcl tmp file for writing $!";
    print TMP $script;
    close TMP || die "Failed to close $!";

    #
    # Feed the created script into gap4 and catch the necessary output lines...
    #
    my $output = "";
    print "o Searching for incarnations of each sequence in the database $pr.$pver...\n\n" if ($debug);
    #open(GAP, "echo '$script' | $gap4sh |") || die "Couldn't run $gap4sh $!\n";
    
    # this method works with larger tcl scripts...
    open(GAP, "/bin/cat $tmpfile | $gap4sh |") || die "Couldn't run $gap4sh $!\n";
    while (<GAP>) {
        chomp $_;
        print "- $_\n";
        if ($_ =~ /^OLIGO:(\S+)\sID:(\d+)\sSTART:(\d+)\sEND:(\d+)\sDIRECTION:(.*)/){
            my $block = "{$2\n".
                        "$tag_type - $3..$4\n".
                        "Sequence $1\n".
                        "$tag_description\n".
                        "$5\n".
                        "Tag added: $date}\n";
            $output = "$output"."$block";
        }  
    }
    close(GAP) || die "Error running $gap4sh\n";
    
    return ($output);
}

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

sub write_tags{
    #
    # Reads $tagsfile from disk.  This contains tag blocks as follows;
    #
    # {-35                           contig NUMBER (not identifier) ignore minus 
    # OLIG - 20..40                  tag type and positions
    # Sequence ATGGGGAAAGGATAGTC     1. tag contents 
    # Template Xhi37g08} {-35        2. + start if next entry
    # OLIG - 60..125
    # Sequence ATGGGGAAAGGATAGTC
    # Template Xhi36c09}
    #
    # Use return_contig_order to get contig numbers...
    # e.g. ~bt1/badger-bin/get_gap_readings DM505L19 9 | grep 35
    #
    # James' comments;
    # Contig_or_gel_number is positive for that reading number and negative for 
    # the contig number (we will negate it internally). Type is the 4 letter 
    # stage type. Dir is +, - or = (both dirs). Range is a %d..%d such as 
    # 8145..8163; it's inclusive. And comment is just a multi-line text comment. 
    # So in other words it's identical to the format used by enter_tags except 
    # will all the experiment file format gubbins stripped out.
    #

    my ($pr, $pver, $tagsfile, $debug, $donot_complement_tags) = @_;
    
    #
    # Set stadenroot to the latest release from Mr Bonfield
    # Contains auto-finish routines...
    #
 
    my $gap4sh = &setup_gap4_environment();
    print "** Using >$gap4sh< **\n\n"; 

    my $output;
    my $script;

    if ($donot_complement_tags){

        $script = <<EOF;
        load_package gap
        set io [ open_db -name $pr -version $pver -access rw ]
        set fd [open $tagsfile r]
        set tags [read \$fd]
        close \$fd
        puts "Orig tags = \$tags"                                                                                                
        add_tags -io \$io -tags \$tags
        close_db -io \$io\nexit\n
EOF
     }else{
        $script = <<EOF;
        load_package gap
        set io [ open_db -name $pr -version $pver -access rw ]
        set fd [open $tagsfile r]
        set tags [read \$fd]
        close \$fd
        set new [complement_tag_list \$io \$tags] 
        puts "Orig tags = \$tags"                                                                                                
        puts "New tags  = \$new"    
        add_tags -io \$io -tags \$new
        close_db -io \$io\nexit\n
EOF
}

    print "\n$script\n" if ($debug);
    open(GAP, "echo '$script' | $gap4sh |") || die "Couldn't run $gap4sh $!\n";
    
    while (<GAP>) {
        $output = $_;
    }   
    close(GAP) || die "Error running $gap4sh\n";
}

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

sub return_no_of_contigs{
    #
    # Return the number of contigs in a gapdb.
    #
    my ($pr, $pver) = @_;
    
    my $gap4sh = setup_gap4_environment();
    print "Opening >$pr.$pver<\n";
    my $no_contigs;
    my $script = <<EOF;
    set io [ open_db -name $pr -version $pver -access rw ]
    puts [db_info num_contigs \$io]
    close_db -io \$io\nexit\n
EOF
    
    open(GAP, "echo '$script' | $gap4sh |") || die "Couldn't run $gap4sh $!\n";
    while (<GAP>) {
        $no_contigs = $_;
    }           
    close(GAP) || die "Error running $gap4sh\n";
    chomp $no_contigs;
    return $no_contigs;
}

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

sub return_contig_order{
    #
    # Returns a hash containing gap4 contig numbers (#no) keyed to 
    # contig order (contig 1 to no.contigs)
    #
    my ($pr, $pver) = @_;
    
    my %hash;
    my $gap4sh = &setup_gap4_environment();
    my $script = <<EOF;
    set io [ open_db -name $pr -version $pver -access r ]
    puts \$io
        set clist ""
    set num_contigs [db_info num_contigs \$io]
    for {set i 1} {\$i <= \$num_contigs} {incr i} {
        set order [contig_order_to_number -io \$io -order \$i]
        set c [io_read_contig \$io \$order]
        set r [keylget c left]
        append clist "\$r \$order"
    }
    puts "\$clist"
    close_db -io \$io\nexit\n
EOF
		
    print ">>>>>>>Opening >$pr.$pver<\n$script\n";
    open(GAP, "echo '$script' | $gap4sh |") || die "Couldn't run $gap4sh $!\n";
       while (<GAP>) {
        print ">$_<\n";
        
        while (/\{(.*?)\}/g) {
            my ($n, $c_id) = split(" ", $1);
            $hash{$c_id} = $n;
        }
    }
    close(GAP) || die "Error running $gap4sh\n";
    return %hash;
}

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

sub return_all_readings{
    #
    # Returns array of all readnames in database (all contigs)
    #
    my ($pr, $pver) = @_;
    
    my $script = <<EOF;
    set io [ open_db -name $pr -version $pver -access r ]
    set num_contigs [db_info num_contigs \$io]
    for {set i 1} {\$i <= \$num_contigs} {incr i} {
        set order [contig_order_to_number -io \$io -order \$i]
        set c [io_read_contig \$io \$order]
    for {set gel [keylget c left]} {\$gel != 0} {set gel [keylget g right]} {
        set g [io_read_reading \$io \$gel]
        puts "[io_read_text \$io [keylget g name]]"
        }
    }
    close_db -io \$io\nexit\n
EOF
    #puts "[io_read_text \$io [keylget g name]] [keylget g position]".
    #     "[keylget g sequence_length]"

    my $gap4sh = &setup_gap4_environment();
    open(GAP, "echo '$script' | $gap4sh |") || die "Couldn't run $gap4sh $!\n";
    my @reads;
 
    while (<GAP>) {
        chomp $_; 
        push @reads, $_;
    }
    close(GAP) || die "Error running $gap4sh\n";
    return @reads;
}

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

sub return_read_info{
    #
    # This routine returns the following read info
    # 139D8-11g5.q1c 57096                  723                   1135     1708
    # readname       start pos. in contig   end pos. in contig    #readno  #left 
    # end of contig read no
    #
    # STOP PRESS.  DO NOT USE THIS ROUTINE TO GET READNAMES AND IDENTIFIERS.  USE 
    # Return_names_and_identifiers INSTEAD.  I THINK THERE IS A BUG IN GAP4 ITESLF...
    # BT1/JAMES BONFIELD 10/1/01
    #

    my ($pr, $pver) = @_;

   # print "o Opening $pr.$pver..\n";
    my $gap4sh = &setup_gap4_environment();
    my $script = <<EOF;
    set io [ open_db -name $pr -version $pver -access r ]
    set num_contigs [db_info num_contigs \$io]
    for {set i 1} {\$i <= \$num_contigs} {incr i} {
        set order [contig_order_to_number -io \$io -order \$i]
        set c [io_read_contig \$io \$order]
    for {set gel [keylget c left]} {\$gel != 0} {set gel [keylget g right]} {
        set g [io_read_reading \$io \$gel]
        set readno [db_info get_read_num \$io [io_read_text \$io [keylget g name]]]
        set contigno [db_info chain_left \$io [io_read_text \$io [keylget g name]]]
        puts "[io_read_text \$io [keylget g name]] [keylget g position] [keylget g sequence_length] \$readno \$contigno"  
        }
    }
    close_db -io \$io\nexit\n
EOF

    open(GAP, "echo '$script' | $gap4sh |") || die "Couldn't run $gap4sh $!\n";
    my @readinfo;
    while (<GAP>) {
        chomp $_; 
        push @readinfo, $_;
    }
    close(GAP) || die "Error running $gap4sh\n";
    return \@readinfo;
}

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



sub Return_names_and_identifiers{
    #
    # Best way to get just the readnames and associated read identifiers(#) from a gapdb.
    # DONOT USE return_read_info to get this information.  THERE IS A BUG SOMEWHERE!!!!!!
    #
    
    # changed 25/01/01 . last line was "[io_read_text \$io [keylget g name]]  \$gel"
    
    # FROM http://www.mrc-lmb.cam.ac.uk:80/pubseq/scripting_manual/scripting_114.html
    #
    # 'start' The position of the last base in the left hand cutoff data (starting from 1). 
    # 'end'   The position of the first base in the right hand cutoff data (starting from 1). 
    #
    
    my ($pr, $pver) = @_;

    my $gap4sh = &setup_gap4_environment();
    print "** Using >$gap4sh< **\n\n"; 

    
    my $script = <<EOF;
    load_package gap
    set io [ open_db -name $pr -version $pver -access r ]
    set num_contigs [db_info num_contigs \$io]
    for {set i 1} {\$i <= \$num_contigs} {incr i} {
        set order [contig_order_to_number -io \$io -order \$i]
        set c [io_read_contig \$io \$order]
        for {set gel [keylget c left]} {\$gel != 0} {set gel [keylget g right]} {
            set g [io_read_reading \$io \$gel] 
             set start [keylget g start]
             set end [keylget g end]
            puts "[io_read_text \$io [keylget g name]]  \$start \$end \$gel"
        }
    }
    close_db -io \$io\nexit\n
EOF
    print "\n$script\n";
 
    open(GAP, "echo '$script' | $gap4sh |") || die "Couldn't run $gap4sh $!\n";
    my @readinfo;
    while (<GAP>) {
        chomp $_; 
      #  print ">$_<\n";
        push @readinfo, $_;
    }
    close(GAP) || die "Error running $gap4sh $!\n";
    return \@readinfo;
}

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

sub new_return_read_info{
    #
    # This routine returns the following read info
    # 139D8-11g5.q1c 57096                  723                   1135     1708
    # readname       start pos. in contig   end pos. in contig    #readno  #left
    #
    my ($pr, $pver) = @_;

#            set name [io_read_reading_name \$rnum]
   # print "o Opening $pr.$pver..\n";
    my $script = <<EOF;
    set io [ open_db -name $pr -version $pver -access r ]
    set num_contigs [db_info num_contigs \$io]
    set c [io_read_contig \$io 20]
    for {set rnum [keylget c left]} {\$rnum} {set rnum [keylget r right]} {  
        set r [io_read_reading \$io \$rnum]
        set name [io_read_text \$io [keylget r name]]
        set start [keylget r position] 
        set end [expr {\$start + [keylget r sequence_length]}]
       
        for {set i \$start} {\$i < \$end} {incr i} {
                lappend pos(\$i) \$name
                puts "*** pos(\$i) \$name ***" 
        }
        set clen [keylget c length]
        set clena \$clen-1    
        for {set i 1} {\$i <= \$clena} {incr i} {
            puts "Checking..."
            puts  ">>[lsearch -glob \$pos(\$i) J*]<<"
            if {[llength \$pos(\$i)] == 1 && [lsearch -glob \$pos(\$i) J*] != -1} {
            puts \$i:\$pos(\$i)
            }
        }
    }
    close_db -io \$io\nexit\n
EOF

    my $gap4sh = &setup_gap4_environment();
    open(GAP, "echo '$script' | $gap4sh |") || die "Couldn't run $gap4sh $!\n";
    my @readinfo;
    while (<GAP>) {
        chomp $_; 
        print ">$_<\n";
#        push @readinfo, $_;
    }
    close(GAP) || die "Error running $gap4sh $!\n";
 #   return @readinfo;
}

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

sub return_contig_readinfo{
    #
    # Returns array containing all reads in specific contig of gapdb.
    #
    my ($pr, $pver, $contig_order) = @_;
    
    my $data;
    my $script = <<EOF;
    set io [ open_db -name $pr -version $pver -access r ]
    set c [io_read_contig \$io $contig_order]
    for {set gel [keylget c left]} {\$gel != 0} {set gel [keylget g right]} {
        set g [io_read_reading \$io \$gel]
        puts "[io_read_text \$io [keylget g name]]"
   # puts "[io_read_reading \$io \$gel]"
    }
    close_db -io \$io\nexit\n
EOF

    my $gap4sh = &setup_gap4_environment();
    open(GAP, "echo '$script' | $gap4sh |") || die "Couldn't run $gap4sh $!\n";
    my $i = 0; #counter
    my @reads;
 
    while (<GAP>) {
        chomp $_;
        #print ">>>$_<<<\n";
        (/^(\S+)\s+\d+\s+\d+/);
        my $read = $1;
     #   print ">$read<\n";
        push @reads, $read;
    }
    close(GAP) || die "Error running $gap4sh $!\n";
    return @reads;
}

##################
# -*- gapNav -*- #
##################

sub get_contig_list_info {
    my($gap4sh,$pr,$ver,$contig_dat,$widgetref) = @_;
    
    # Processes the contigs modifying a hash 
    # of key 'contig_id' and an array value of
    # readname and contig length.
    #
    # gap4sh - stash handle
    # pr - project
    # ver - version
    # contig_dat - hash reference
    # widgetref - what it says.
    #
    
    $gap4sh = &setup_gap4_environment();
    
  my $script = <<LIST;
  load_package gap
  set io [ open_db -name $pr -version $ver -access r ]
  set clist ""
  set num_contigs [db_info num_contigs \$io]
  for {set i 1} {\$i <= \$num_contigs} {incr i} {
  set nc [expr \$num_contigs - (\$i-1)]
  set order [contig_order_to_number -io \$io -order \$i]
  set c [io_read_contig \$io \$order]
  set l [keylget c length]
  set r [keylget c left]
  set m [io_read_reading \$io [keylget c left]]
  set contig_name [io_read_text \$io [keylget m name]]
  lappend clist "\$r \$contig_name \$l \$i \$num_contigs "
  }
  puts \$clist 
  close_db -io \$io\nexit\n
LIST

  open(GAP, "echo '$script' | $gap4sh |") || die "Couldn't run $gap4sh $!\n";    
  while (<GAP>) {
    while (/\{(.*?)\}/g) {
      my ($c_id, $read_id,$length,$cn,$numc) = split(" ", $1);
      $$contig_dat{$c_id} = [$read_id,$length];
      my $count = int((100/$numc)*$cn);
      $$widgetref->configure(-text => "Loading contigs\nPlease wait!\n\n$count% of contigs loaded");
      $$widgetref->update('idletasks');
    }
  }
  close(GAP) || die "Error running $gap4sh\n";
}



sub get_largest_contig {

  #
  # Find the largest contig in a database. 
  # Assigns contig,start,end to $contigref,$fromref,$toref
  # 

  my($gap4sh,$pr,$ver,$var) = @_;

  my $large_contig = <<LARGE;
  load_package gap
  set io [ open_db -name $pr -version $ver -access r ]
  set info ""
  set contig [db_info longest_contig \$io]
  set c [io_read_contig \$io \$contig]
  set i [keylget c left]
  set l [keylget c length]
  lappend info "\$i \$l"
  puts \$info
  close_db -io \$io\nexit\n
LARGE
  open(BIG, "echo '$large_contig' | $gap4sh |") || die "Couldn't run $gap4sh $!\n";    
    while (<BIG>) {
      while(/\{(.*?)\}/g) {
	($$var{pcontig}, $$var{pto}) = split(/\s+/, $1);
	$$var{pfrom} = 1;
      }
    }
  close(BIG);
}

sub get_contig_order_hash {
  my($gap4sh,$pr,$ver) = @_;

  my %contig2id=();

my $contig2num = <<EOF;
  load_package gap
  set clist ""
  set io [ open_db -name $pr -version $ver -access r ]
  set num_contigs [db_info num_contigs \$io]
  for {set i 1} {\$i <= \$num_contigs} {incr i} {
    set order [contig_order_to_number -io \$io -order \$i]
    set c [io_read_contig \$io \$order]
    set r [keylget c left]
    lappend clist "\$r \$i"
  }
  puts \$clist
  close_db -io \$io\nexit\n
EOF
  
  open(GAP, "echo '$contig2num' | $gap4sh |") || die "Couldn't run $gap4sh $!\n";
while (<GAP>) {
  while (/\{(.*?)\}/g) {
    my ($id,$num) = split(" ",$1);
    $contig2id{$id} = $num;
  }
}
close(GAP);

return %contig2id;

}

1;

__END__

# RCS logging starts here...
#
# $Id: gapio.pm,v 1.33 2006/11/08 09:28:02 rmd Exp $
#
# $Log: gapio.pm,v $
# Revision 1.33  2006/11/08  09:28:02  rmd
# Still a few cases of running gap4sh rather than stash.  Fixed these so they
# now all call setup_gap4_environment to get the correct path.
#
# setup_gap4_environment now only runs the environment stuff once.
#
# Altered check_gap_database slightly as the script was not producing the right
# format.
#
# Revision 1.32  2006/09/19  09:19:14  rmd
# Added code ported from staden.profile to set $ENV{MACHINE} correctly.
# Now include derived machine name in paths instead of hard-coding 'alpha'.
#
# stash no longer needs the '-f' option.
#
# Revision 1.31  2006/08/29  09:20:30  jkb
# Fixed environment hacking so it doesn't break the trace server.
#
# Revision 1.30  2003/07/31 10:43:59  mng
# *** empty log message ***
#
# Revision 1.29  2003/07/31  09:08:29  mng
# *** empty log message ***
#
# Revision 1.28  2003/07/31  09:06:37  mng
# Added tcl and tk environment variables.
#
# Revision 1.27  2002/03/06  14:53:56  bt1
# *** empty log message ***
#
# Revision 1.26  2002/03/05  13:19:52  bt1
# Altered hardcoded path to stadenroot in setup_gap4_environment
# to use production version
#
# Revision 1.25  2001/11/15  14:47:19  mng
# ...exported setup_gap4_environment...
#
# Revision 1.24  2001/11/15  14:43:32  mng
# Made into a package. Now uses exporter.
#
# Revision 1.23  2001/09/11  14:53:05  bt1
# *** empty log message ***
#
# Revision 1.22  2001/09/11  14:52:13  bt1
# *** empty log message ***
#
# Revision 1.21  2001/08/22  15:46:25  bt1
# *** empty log message ***
#
# Revision 1.20  2001/08/22  15:43:49  bt1
# *** empty log message ***
#
# Revision 1.19  2001/08/22  13:46:12  bt1
# *** empty log message ***
#
# Revision 1.18  2001/06/25  12:47:33  bt1
# *** empty log message ***
#
# Revision 1.17  2001/06/25  12:31:36  bt1
# *** empty log message ***
#
# Revision 1.16  2001/06/25  11:42:40  bt1
# *** empty log message ***
#
# Revision 1.15  2001/06/25  11:32:58  bt1
# updated to look at LATEST gap distribution.
# Use the symbolic links in /usr/local/badger
# in future, the link /usr/local/badger/gap4_test should be updated.
# This module should sort itself out.
#
# Revision 1.14  2001/06/20  13:25:56  mng
# added get_contig_order_hash
#
# Revision 1.13  2001/06/20  10:23:31  mng
# *** empty log message ***
#
# Revision 1.12  2001/06/20  09:12:57  mng
# Added get_contig_list_info and get_largest_contig for gapNav
#
# Revision 1.11  2001/05/02  09:07:17  bt1
# *** empty log message ***
#
# Revision 1.10  2001/04/30  13:36:38  bt1
# Added &create_tag_file
#
# Revision 1.9  2001/04/19  10:54:35  bt1
# fixed up write_tags routine to call the new tcl script/hack
# to get the tags in at the correct positions when the sequence
# is complemented.
#
# Revision 1.8  2001/04/19  09:17:22  bt1
# modified add_tags
#
# Revision 1.7  2001/03/26  16:25:08  bt1
# *** empty log message ***
#
# Revision 1.6  2001/03/26  16:21:31  bt1
# *** empty log message ***
#
# Revision 1.5  2001/03/19  10:15:37  bt1
# fixed problems with multiple gap4 distributions
# updated  Return_names_and_identifiers routine to return sequence_length
#
# Revision 1.4  2001/03/13  14:16:45  bt1
# updated to use the latest version of gap4 (using sanger wrapper gap4sh)
# adeed setup_gap4_environment routine.
#
# Revision 1.3  2000/10/11  14:23:46  bt1
# Changed opendb call in check_gap_database to be readonly
#
# Revision 1.2  2000/10/11  14:02:34  bt1
# added logging
#
