genex-cvs-commit Mailing List for GeneX Gene Expression Database (Page 34)

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

Update of /cvsroot/genex/genex-www/status/2003/may
In directory usw-pr-cvs1:/tmp/cvs-serv27695/may

Log Message:
Directory /cvsroot/genex/genex-www/status/2003/may added to the repository

Update of /cvsroot/genex/genex-www/status/2003/mar
In directory usw-pr-cvs1:/tmp/cvs-serv27695/mar

Log Message:
Directory /cvsroot/genex/genex-www/status/2003/mar added to the repository

Update of /cvsroot/genex/genex-www/status/2003/jun
In directory usw-pr-cvs1:/tmp/cvs-serv27695/jun

Log Message:
Directory /cvsroot/genex/genex-www/status/2003/jun added to the repository

Update of /cvsroot/genex/genex-www/status/2003/jan
In directory usw-pr-cvs1:/tmp/cvs-serv27695/jan

Log Message:
Directory /cvsroot/genex/genex-www/status/2003/jan added to the repository

Update of /cvsroot/genex/genex-www/status/2003/jul
In directory usw-pr-cvs1:/tmp/cvs-serv27695/jul

Log Message:
Directory /cvsroot/genex/genex-www/status/2003/jul added to the repository

Update of /cvsroot/genex/genex-www/status/2003/dec
In directory usw-pr-cvs1:/tmp/cvs-serv27695/dec

Log Message:
Directory /cvsroot/genex/genex-www/status/2003/dec added to the repository

Update of /cvsroot/genex/genex-www/status/2003/feb
In directory usw-pr-cvs1:/tmp/cvs-serv27695/feb

Log Message:
Directory /cvsroot/genex/genex-www/status/2003/feb added to the repository

Update of /cvsroot/genex/genex-www/status/2003/aug
In directory usw-pr-cvs1:/tmp/cvs-serv27695/aug

Log Message:
Directory /cvsroot/genex/genex-www/status/2003/aug added to the repository

Update of /cvsroot/genex/genex-www/status/2003/apr
In directory usw-pr-cvs1:/tmp/cvs-serv27695/apr

Log Message:
Directory /cvsroot/genex/genex-www/status/2003/apr added to the repository

Update of /cvsroot/genex/genex-www/status/2003
In directory usw-pr-cvs1:/tmp/cvs-serv27554/2003

Log Message:
Directory /cvsroot/genex/genex-www/status/2003 added to the repository

Update of /cvsroot/genex/genex-www/status/2002/dec
In directory usw-pr-cvs1:/tmp/cvs-serv27417/dec

Log Message:
Directory /cvsroot/genex/genex-www/status/2002/dec added to the repository

Update of /cvsroot/genex/genex-www/status/2002/nov
In directory usw-pr-cvs1:/tmp/cvs-serv27417/nov

Log Message:
Directory /cvsroot/genex/genex-www/status/2002/nov added to the repository

Update of /cvsroot/genex/genex-www/status/2002
In directory usw-pr-cvs1:/tmp/cvs-serv27058/2002

Log Message:
Directory /cvsroot/genex/genex-www/status/2002 added to the repository

Update of /cvsroot/genex/genex-www/status
In directory usw-pr-cvs1:/tmp/cvs-serv26939

Added Files:
	status_main.ssi status_menu.ssi 
Log Message:
main content

--- NEW FILE: status_main.ssi ---
<!--Main content -->

  <table border="2" bgcolor="#BFD8D8" width="100%" cellpadding="15" cellspacing="5">
    <tr valign="top" bgcolor="#D8E4F7">
      <th><big>November 7th, 2002</big></th>
    </tr>
    <tr bgcolor="#D8E4F7">
      <td>
	<p>	
	<b><u>Caltech Update - Diane Trout</u></b><br>
	</p>

	<p>
	<b>Current accomplishments:</b><br>
	* Built a number of packages to help install genex<br>
	* Helped brandon with some of the bugs he's run into with installing<br>
	  genex.<br>
	* A whole lot of meetings<br>
	</p>

	<p>
	<b>Next week:</b><br>
	* Work on conneting novosoft xmi reader to pymerase (high priority) <br>
	  (for both an internal project as well as Python-Mage)<br>
	* Fix issues that brandon found in pymerase (high)<br>
	* Work on connecting pymerase to GeneX's new security model (mid)<br>
	* Build debs for Bio::Mage & GeneX (low)<br>
	</p>

	<p>
	<b>Problems:</b><br>
	* Haven't had time to work on debs or preping a download site to be<br>
	  hosted on sourceforge.<br>
	</p>

	<hr>
	<p>
	<b><u>Caltech Update - Brandon King</u></b>
	</p>

	<p>
	<b>Summery:</b><br>
	* Installed GeneX 2.x with help from Diane and Jason<br>
	* Started uploading QuantArray test data to GeneX 2.x<br>
	* No form to upload ExperimentSets (looks like now fixed), used SQL as shorterm solution<br>
   	* Successfully generated and uploaded ArrayDesigns<br>
   	* Tested uploading of existing FeatureExtractionSoftware, detected entry and didn't upload. =o)<br>
   	* Tried to upload QuantArray expression data, ran into bugs, submited bug reports<br>
	* Worked on testing and updating pymerase to help prerpare for GeneX 2.x and MAGE support.<br>
	</p>

	<p>
	<b>Next Week:</b><br>
	* Finish Uploading QuantArray expression data<br>
	* Create GenePix FeatureExtractionSoftware XML file<br>
	* Create ArrayDesign from GenePix data<br>
	* Upload GenePix expression data<br>
	* Help Diane update Pymerase<br>
	</p>

	<p>
	<b>Problems:</b><br>
	* Usual bugs found in development projects.<br>
	</p>

	<p>
	<b>Future:</b><br>
	* Look into ways of helping out with GeneX project more effeciently<br>
	</p>

	<p>
	<b>New or Changing Priorities:</b><br>
	* No changes, yet.<br>
	</p>

	<p>
	<b>Random Ideas:</b><br>
	* Maybe using a format similar to this for weekly updates, where Summery, Next Week, and Problems are most important to include.<br>
	* Go to lunch =o) <br>
	</p>

	<hr>
	<p>
	<b><u>UCI Update - Harry Mangalam</u></b>
	</p>
	<p>
	...And thanks to Brandon ans Diane for the biff to the butt for getting
	this started.
	</p>

	<p>
	Over the last 2 months, I've been mostly working on analysis add-ons and
	tweaks to GeneX and related gene expression paths, with the emphasis on
	OpenDX:
	</p>
	<p>
	     Open Data Explorer (DX) is an advanced visualization system
	     developed by IBM over the last 15 years.  It was initially a
	     commercial product aimed at high end visualization markets, using
	     advance single and multi-CPU Unix  workstations.  In 1999, as
	     part of their Deep Computing Initiative, IBM released the source
	     code to DX as Open Source.  Over the years since, it has been
	     ported to Linux and Windows, and continues to improve.  It is
	     particularly notable as complex visualizations can be programmed
	     visually by means of 'drag and dropping' icons representing data
	     transformations onto a canvas and 'wiring' them together by means
	     of connecting input and output tabs together with mouse clicks.
	         One problem with DX is that while it is an exceptional
	     visualization environment, it was developed prior to the current
	     emphasis on accessing data from relational databases, relying on
	     the large data file formats that were (and still are) standard in
	     these fields - primarily HDF and netCDF.  This is a problem
	     particularly for the gene expression field, where data is
	     progressively stored in relational databases to support complex
	     queries.
	     [see <a href="http://www.opendx.org">http://www.opendx.org</a>]
	</p>

	<p>
	Mostly this has been in pursuit of a Perl-OpenDX link so that a module
	can be added to a visual DX net allowing arbitrary Perl code to be run
	on the input.  There are various problems - DX prefers to operate on
	particular types of data fields, not the simple string input that Perl
	favors, but there are many possibilitiess, high among them using Perl's
	DBI to suck data from RDBs and format it for DX to do automated analysis
	and visualization on.
	</p>

	<p>
	Status: I've gotten some DX-Perl modules built, but am still a ways away
	from a solid generic module.
	</p>

	<p>
	A close second priority is the integration of the R statistical language
	in the same way - compile it as a shared lib and have it communicate to
	DX via sockets in the same way that I have Perl doing.  R is actually a
	better fit as it has an idea about data objects and already has support
	for many of the interconversions of data types that DX supports.
	</p>

	<p>
	A logical 3rd candidate would be Python, as it theoretically integrates
	more easily with C apps than Perl and there is already a Python project
	for interacting with DX (tho it seems to be for controlling DX from
	Python than rolling Python into DX.)
	</p>

	<p>
	The other project is the updating and converting to commandline scripts
	those cgi analysis scripts that were included in the GeneX 1.0 release.
	  These include the CyberT significance testing, the Eisen/Sherlock
	clustering code, (now incorporating Swaine Lin Chen's slcview heatmap
	generation), and Karen's Rcluster codes.
	</p>

	<p>
	These updates should be making their way back into the CVS tree very
	soon.  Currently they are designed to work with a tree of
	QuantArray-formatted replicates, soing significance testing on all of
	the subgroups and then a summary significance test on all the subgroups
	(this last summary test is specific to the experiment, so it may not be
	appro for all expt'al designs).
	</p>

	<p>
	I'm also just about finished a larger descriptive page describing the
	software in more detail and will post the location as soon as it's
	ready, probably next week.
	</p>

	<p>
	My last noise is a suggestion of starting to put together ideas for
	making an external GUI app that does nothing but query the GeneX DB and
	makes the output available as:
	- tab-delimited spreadsheet-like files
	- MAGE-ML
	- N-dimensional file such as netCDF/HDF/XDF
	- maybe a few others
	</p>

	<p>
	My suggestion would be to use Python and Qt so that it runs
	cross-platform, using either the Qt designer (or BlackAdder if it EVER
	sees the light of day).  The Python bindings seem to be more stable and
	coherent than for Perl. 
	</p>

	<hr>
	<p>
	<b><u>UVa Update - Tom Laudeman</u></b>
	</p>
	<p>
	Following Harry's good example, here's what we're up to:
	</p>

	<p>
	We're showing GeneX to end users this morning. We gave it to the Microarray Center people last week, but they've had a lull in orders.
	</p>

	<p>
	Jodi/Teela has finished the Analysis Tree schema. I think it has 8 tables. This schema allows for the linking analyses together, and for the analysis module plugins.
	</p>

	<p>
	Teela has been working on the analysis tree backend.
	</p>

	<p>
	I've got the trees drawing correctly, nodes delete, add, and rename. Trees render correctly no matter how complex. I created this before the db was ready, so I've been integrating with the Analysis Tree schema.
	</p>

	<p>
	The tree drawing is way cool. We can set up accounts on reed6.med for people who want to see it.
	</p>

	<hr>
	<p>
	<b><u>Open Informatics Update - Jason Stewart</u></b>
	</p>
<p>
Here's the status for me and my sub-contractors, Mark Wilkinson, and
Hyojoo Kang.
</p>

Mark: 
Added sysadmin tools for doing users/group mainenance and
created Mason front ends for them.

Hyojoo: 
Created a Java GUI for creating QT Dimensions that uses the MAGE-Java
API and thus can export MAGE-ML. The MAGE-ML QT Dimension is needed to
configure the data loader.

<p>
<b>Jason:</b><br>
</p>

<p>
Planning<br>
========<br>
I've been getting ready to switch to Postgres7.3
</p>

<p>
Service<br>
=======<br>
Helped Brandon get Genex-2.0a1 running at Caltech
</p>

<p>
Genex-2<br>
=====
</p>

<p>
New Tools<br>
--<br>
* create user tools for adding Group's and ExperimentSet's and created a
  mason front end for them.
</p>

* Install - now uses a MANIFEST file. This file documents all local
 files to be installed and where they will be installed. This is a
 substitutable file (created from MANIFEST.in), so it is possible to
 use the Config.pm values.

<p>
Schema changes<br>
--<br>
* ExperimentSet - removed creation_date column. This information can
  be found by using the Audit trail.
</p>

<p>
Modifications to Perl API<br>
--<br>
* XMLUtils.pm - changed the internals of xml2sql() to use the new SQL
  writing functions in Connect.pm. Added creation of rules to all
  security views for INSERT/UPDATE/DELETE. Removed permission granting
  code to make it more generic. Added support for a single master
  sequence to be used by all tables.
</p>

<p>
* create_genex_db.pl - modified to handle granting of permissions.
</p>

Goals for next week 
=================== 
Finish rules code - need to fix problem with GroupSec table having
ro/rw_groupname fkeys to itself.

Ensure that ArrayDesign importer can handle Affy U133 files.

Add ability to data loader to import .CEL data and MAS5 data.

      </td>
    </tr>
  </table>

<!-- End of Content -->

--- NEW FILE: status_menu.ssi ---
 <!-- Nav Bar Table -->
  <table width="100%" bgcolor="#8FF8FF" cellspacing="0" cellpadding="10">
    <tr><th><big>Weekly Status Updates</big></th></tr>
    <tr>

      <td>
	- <b><a href="http://genex.sourceforge.net">GeneX Release Home</a></b><br>
	- <b><a href="http://sourceforge.net/projects/genex/">GeneX Dev Home</a></b><br>
      </td>
    </tr>

    <tr>

      <td>
	<b><u>2003 Updates</u></b><br>
	  - <b>December</b><br>
	  - <b>November</b><br>
	  - <b>October</b><br>

	  - <b>September</b><br>
	  - <b>August</b><br>
	  - <b>July</b><br>
	  - <b>June</b><br>
	  - <b>May</b><br>

	  - <b>April</b><br>
	  - <b>March</b><br>
	  - <b>February</b><br>
	  - <b>January</b><br>
      </td>

    </tr>
    <tr>
      <td> 
	<b><u>2002 Updates</u></b><br>
	  - <b>December</b><br>
	  - <b><a href="http://genex.sourceforge.net/status/2002/nov/">November</a></b><br>
      </td>

    </tr>

    <tr>
      <td>
	<b><u>GeneX Development Supported By:</u></b><br>
	<a href="http://sourceforge.net">
	  <img src="http://sourceforge.net/sflogo.php?group_id=12416" 
	       width="88" height="31" border="0" 
	       alt="SourceForge Logo">
	</a>
      </td>

    </tr>
 </table>
 <!-- End Nav Bar Table -->

Update of /cvsroot/genex/genex-www/status
In directory usw-pr-cvs1:/tmp/cvs-serv26629

Added Files:
	index.shtml 
Log Message:
weekly status updates

--- NEW FILE: index.shtml ---
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN" "http://www.w3.org/TR/REC-html40/loose.dtd">
<HTML>
  <HEAD> <TITLE>GeneX @ SourceForge</TITLE></HEAD>

  <BODY bgcolor="white">
    <center>
      <table border="1" cellpadding="0" cellspacing="0" width="800">
	  <tr>
	    <td bgcolor="#FFFFBB" colspan="2">
	      <img src="http://genex.sourceforge.net/graphics/genex_banner.png" alt="genex banner">
	    </td>
	  </tr> 
	  <tr> <!-- start Nav Bar table -->
	    <td width="25%" valign="top"> 

	      <!--#include virtual="status_menu.ssi"-->

	    </td>
	    <td align="LEFT" VALIGN="top">

	      <!--#include virtual="status_main.ssi"-->

	    </td>
	  </tr>
	  <tr bgcolor="#8FB9AA">
	    <th colspan="2">
	      <!-- The Page Footer goes here -->
	      <!--#include virtual="../content/footer.ssi"-->
	    </th>
	  </tr>
      </table>
    </center>
  </BODY>
</HTML>

Update of /cvsroot/genex/genex-www/status
In directory usw-pr-cvs1:/tmp/cvs-serv24986/status

Log Message:
Directory /cvsroot/genex/genex-www/status added to the repository

Update of /cvsroot/genex/genex-server/site/webtools
In directory usw-pr-cvs1:/tmp/cvs-serv2238

Modified Files:
      Tag: Rel-1_0_1-branch
	analysis_tree_lib.pl sql_lib.pl 
Log Message:
Fixed delete. Fixed default an_pk in insert_tree().

Index: analysis_tree_lib.pl
===================================================================
RCS file: /cvsroot/genex/genex-server/site/webtools/Attic/analysis_tree_lib.pl,v
retrieving revision 1.1.2.23
retrieving revision 1.1.2.24
diff -C2 -d -r1.1.2.23 -r1.1.2.24
*** analysis_tree_lib.pl	8 Nov 2002 21:22:53 -0000	1.1.2.23
--- analysis_tree_lib.pl	8 Nov 2002 21:53:42 -0000	1.1.2.24
***************
*** 26,30 ****

      $sth = getq("insert_tree_node", $dbh);
!     $sth->execute($tree_pk,-1); # ana_fk zero, no parent
      insert_security($dbh, $us_fk, $us_fk, 0);

--- 26,30 ----

      $sth = getq("insert_tree_node", $dbh);
!     $sth->execute($tree_pk,-1,1); # ana_fk one, no parent
      insert_security($dbh, $us_fk, $us_fk, 0);

***************
*** 269,273 ****
  	$sth->execute($tree{update_an_fk}, $tree{update_node_pk});
      }
!     elsif (exists($tree{delete}))
      {
  	my $s_node;
--- 269,273 ----
  	$sth->execute($tree{update_an_fk}, $tree{update_node_pk});
      }
!     elsif (exists($tree{delete_node_pk}))
      {
  	my $s_node;
***************
*** 395,399 ****
  <input type=\"hidden\" name=\"name_$node\" value=\"$tree{$node}[0]\">
  <input type=\"hidden\" name=\"parent_$node\" value=\"$parent{$node}\">";
! 		    if ($node > 0) # UI prevents root deletion, and so does code in edit_atree2.pl
  		    {
  			# $html .="<input type=\"submit\" name=\"delete_$node\" value=\"Delete\">";
--- 395,399 ----
  <input type=\"hidden\" name=\"name_$node\" value=\"$tree{$node}[0]\">
  <input type=\"hidden\" name=\"parent_$node\" value=\"$parent{$node}\">";
! 		    if ($node != $tree{root}) # UI prevents root deletion, and so does code in edit_atree2.pl
  		    {
  			# $html .="<input type=\"submit\" name=\"delete_$node\" value=\"Delete\">";

Index: sql_lib.pl
===================================================================
RCS file: /cvsroot/genex/genex-server/site/webtools/Attic/sql_lib.pl,v
retrieving revision 1.1.2.2
retrieving revision 1.1.2.3
diff -C2 -d -r1.1.2.2 -r1.1.2.3
*** sql_lib.pl	8 Nov 2002 21:22:53 -0000	1.1.2.2
--- sql_lib.pl	8 Nov 2002 21:53:42 -0000	1.1.2.3
***************
*** 45,48 ****
--- 45,52 ----
  	$sql = "select name,an_pk from analysis order by name";
      }
+     elsif ($q_name eq "delete_tree_node")
+     {
+ 	$sql = "delete from node where node_pk=?";
+     }

      if (defined($sql))

Update of /cvsroot/genex/genex-server/site/webtools
In directory usw-pr-cvs1:/tmp/cvs-serv23584a

Modified Files:
      Tag: Rel-1_0_1-branch
	analysis_tree_lib.pl edit_atree2.pl edit_atree1.html 
	edit_atree1.pl sql_lib.pl 
Added Files:
      Tag: Rel-1_0_1-branch
	choose_tree.html choose_tree.pl insert_tree.pl test_tree.pl 
Log Message:
Database integration, some arrays turned to hashes, more data carried through
the web pages. Delete seems broken. Add works. Change untested.

--- NEW FILE: choose_tree.html ---
<html><head><title>Update Experimental Conditions</title></head>
<body bgcolor="#FFFFFF">
  <table width="600" border=0 cellpadding=0 cellspacing=0>
    <tr><td align=top><img src="../graphics/genex_logo.jpg" align="left">GeneX Experimental Conditions Update<br><br>
    <a href="./">Return to Genex Member Home</a><br>
    </td>
  </tr>
  </table>
<br>

<form action="edit_atree1.pl" method=POST>
  {select_tree} <br>
  <br>
  <br>
  <input type="submit" name="Submit" value="Next">
  &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<a href="./">Cancel</a> 
</form>
<br>
</body>
</html>

--- NEW FILE: choose_tree.pl ---
#!/usr/bin/perl

use strict;
use CGI;
use CGI::Carp qw(fatalsToBrowser);

require "sessionlib.pl"; # automatically loads analysis_tree_lib.pl and sql_lib.pl

main:
{
    my $dbh = new_connection();
    (my $all_html) = readtemplate("choose_tree.html");
    my $select_tree = select_tree($dbh); # analysis_tree_lib.pl
    $all_html =~ s/{select_tree}/$select_tree/;
    print "Content-type: text/html\n\n$all_html\n";
    $dbh->disconnect();
}

--- NEW FILE: insert_tree.pl ---
#!/usr/bin/perl

use strict;
use CGI;
use CGI::Carp qw(fatalsToBrowser);

require "sessionlib.pl";

main:
{
    my $q = new CGI;
    my $dbh = new_connection();
    my $tree_pk = insert_tree($dbh);
    my $url = index_url(); # see sessionlib.pl
    $url =~ s/(.*)\/.*/$1\/edit_atree1.pl/;
    print "Location: $url?&tree_pk=$tree_pk\n\n";
    $dbh->disconnect();
}

--- NEW FILE: test_tree.pl ---
#!/usr/bin/perl

use strict;
require "./sessionlib.pl";
# auto requires analysis_tree_lib.pl and sql_lib.pl

main:
{
    my $dbh = new_connection();
    read_db($dbh,1);
    analyze_tree();
    print_tree_info();
    print_children_info();
    print_generation_info();

    # tile();                 # creates @table
    # tile_pass2();           # modifies @table fixing mis-aligned zeroth row nodes

    pass1();                  # creates @table
    pass2();                  # modifies @table fixing mis-aligned zeroth row nodes
    tile_color();             # reads @table, creates @colors
    #tile_connect();           # modifies @table adding img tags
    my $html = render_html(); # reads @table, @colors

    open(OUT, "> ./test.html") || die "couldn't open test.html\n";
    print OUT "<html><body>$html</body></html>\n";
    close(OUT);

    print_ascii_tree();
    $dbh->disconnect();
}

Index: analysis_tree_lib.pl
===================================================================
RCS file: /cvsroot/genex/genex-server/site/webtools/Attic/analysis_tree_lib.pl,v
retrieving revision 1.1.2.22
retrieving revision 1.1.2.23
diff -C2 -d -r1.1.2.22 -r1.1.2.23
*** analysis_tree_lib.pl	7 Nov 2002 17:43:36 -0000	1.1.2.22
--- analysis_tree_lib.pl	8 Nov 2002 21:22:53 -0000	1.1.2.23
***************
*** 3,9 ****
  use strict;

! my @tree;
! my @parent;
! my @children;
  my %node2g;
  my @generation;
--- 3,9 ----
  use strict;

! my %tree;
! my %parent;
! my %children;
  my %node2g;
  my @generation;
***************
*** 16,19 ****
--- 16,36 ----
  $::analysis_tree_lib_loaded = 1; # quiet compile warnings

+ 
+ sub insert_tree
+ {
+     my $dbh = $_[0];
+     my $sth = getq("insert_tree", $dbh);
+     $sth->execute();
+     my $us_fk = get_us_fk($dbh);
+     my $tree_pk = insert_security($dbh, $us_fk, $us_fk, 0);
+ 
+     $sth = getq("insert_tree_node", $dbh);
+     $sth->execute($tree_pk,-1); # ana_fk zero, no parent
+     insert_security($dbh, $us_fk, $us_fk, 0);
+ 
+     $dbh->commit;
+     return $tree_pk;
+ }
+ 
  #
  # Build an HTML select tag based on a query from the tree table.
***************
*** 24,28 ****
      my $sth = getq("select_tree", $dbh);
      $sth->execute() || die "Query select_tree execute error: $DBI::errstr\n";
!     my $st_html = "<select name=\"select_tree\">\n";
      while((my $name, my $tree_pk) = $sth->fetchrow_array())
      {
--- 41,45 ----
      my $sth = getq("select_tree", $dbh);
      $sth->execute() || die "Query select_tree execute error: $DBI::errstr\n";
!     my $st_html = "<select name=\"tree_pk\">\n";
      while((my $name, my $tree_pk) = $sth->fetchrow_array())
      {
***************
*** 37,47 ****
  sub select_node
  {
!     my @test_names = ("Choose Hybs", "Quality Control", "Stat Analysis", "Westfall & Young", "R Cluster", "QA2", "GO", "TreeView", "XCluster", "Test", "NNormal", "ProcA", "Cluster2", "Cyber T", "Subset", "StatMatch", "PVal", "Multi");
! 
      my $select_str = "<select name=\"select_node\">\n";
!     for(my $xx = 0; $xx<=$#test_names; $xx++)
      {
! 	$select_str .= "<option value=\"$test_names[$xx]\">$test_names[$xx]</option>\n";
      }
      $select_str .= "</select>\n";
      return $select_str;
--- 54,66 ----
  sub select_node
  {
!     my $dbh = $_[0];
!     my $sth = getq("select_analysis", $dbh);
!     $sth->execute() || die "Query select_analysis excute fails.\n$DBI::errstr\n";
      my $select_str = "<select name=\"select_node\">\n";
!     while((my $test_name, my $an_pk) = $sth->fetchrow_array())
      {
! 	$select_str .= "<option value=\"$an_pk\">$test_name</option>\n";
      }
+     $sth->finish();
      $select_str .= "</select>\n";
      return $select_str;
***************
*** 69,75 ****
  	    $m_width[$node] = 0;
  	    my $cc;
! 	    for($cc=0; $cc<=$#{$children[$node]}; $cc++)
  	    {
! 		my $chw = ($m_width[$children[$node][$cc]]);
  		$m_width[$node] += $chw;
  	    }
--- 88,94 ----
  	    $m_width[$node] = 0;
  	    my $cc;
! 	    for($cc=0; $cc<=$#{$children{$node}}; $cc++)
  	    {
! 		my $chw = ($m_width[$children{$node}[$cc]]);
  		$m_width[$node] += $chw;
  	    }
***************
*** 101,107 ****
      # Layout children of generation $xx, and special case the root.
      # Need to layout children of parent nodes so siblings are together.
!     $col += int(($m_width[0]/2));
!     $table[$row][$col] = 0;
!     @{$loc{0}} = ($row, $col);               # Also put node's location into the %loc hash
      $row+=2;
      my $offset;
--- 120,126 ----
      # Layout children of generation $xx, and special case the root.
      # Need to layout children of parent nodes so siblings are together.
!     $col += int(($m_width[$tree{root}]/2));
!     $table[$row][$col] = $tree{root};
!     @{$loc{$tree{root}}} = ($row, $col);               # Also put node's location into the %loc hash
      $row+=2;
      my $offset;
***************
*** 132,138 ****
  	    # then decrement $col.
  	    # 
! 	    for(my $cc=0; $cc<=$#{$children[$parent]}; $cc++)
  	    {
! 		$node = $children[$parent][$cc];
  		$offset = int(($loc{$parent}[1] - ($m_width[$parent]/2)) + ($m_width[$node]/2));
  		$cumu_pos = $col + int((($m_width[$node])/2));
--- 151,157 ----
  	    # then decrement $col.
  	    # 
! 	    for(my $cc=0; $cc<=$#{$children{$parent}}; $cc++)
  	    {
! 		$node = $children{$parent}[$cc];
  		$offset = int(($loc{$parent}[1] - ($m_width[$parent]/2)) + ($m_width[$node]/2));
  		$cumu_pos = $col + int((($m_width[$node])/2));
***************
*** 179,186 ****
  	{
  	    $parent = $generation[$xx][$yy];
! 	    for(my $cc=0; $cc<=$#{$children[$parent]}; $cc++)
  	    {
! 		$node = $children[$parent][$cc];
! 		$siblings = $#{$children[$parent]}+1;
  		# old $offset = ((int((($m_width[$parent])))) - $loc{$parent}[1])/$siblings;
  		$offset = int(($loc{$parent}[1] - ($m_width[$parent]/2)) + ($m_width[$node]/2));
--- 198,205 ----
  	{
  	    $parent = $generation[$xx][$yy];
! 	    for(my $cc=0; $cc<=$#{$children{$parent}}; $cc++)
  	    {
! 		$node = $children{$parent}[$cc];
! 		$siblings = $#{$children{$parent}}+1;
  		# old $offset = ((int((($m_width[$parent])))) - $loc{$parent}[1])/$siblings;
  		$offset = int(($loc{$parent}[1] - ($m_width[$parent]/2)) + ($m_width[$node]/2));
***************
*** 217,222 ****
--- 236,244 ----
      pass1();                  # creates @table, @loc
      pass2();                  # modifies @table, @loc fixing mis-aligned zeroth row nodes
+     write_log("after pass2: $table[0][0]");
      tile_color();             # reads @table, creates @colors
+     write_log("after tile_color: $table[0][0]");
      tile_connect();           # modifies @table adding img tags, reads @loc
+     write_log("after tile_connect: $table[0][0]");
      my $html = render_html(); # reads @table, @colors

***************
*** 226,277 ****
  }

  sub write_db
  {
!     my @tree = @{$_[0]};
!     my $fn = "/var/genres/twl8n/tree.txt";
!     open(OUT, "> $fn") || die "Canont write $fn\n";
!     for(my $tc=0; $tc<=$#tree; $tc++)
      {
! 	if ($tree[$tc][1] >= 0)
  	{
! 	    print OUT "$tree[$tc][0],$tree[$tc][1]\n";
  	}
      }
-     close(IN);
  }

  sub read_db
  {
!     my $fn = "/var/genres/twl8n/tree.txt";
!     open(IN, "< $fn") || die "Cannot read $fn\n";;
!     my $tc = 0;
!     while(my $temp = <IN>)
!     {
! 	($tree[$tc][0], $tree[$tc][1]) = split(',',$temp);
! 	$tc++;
!     }
!     close(IN);
! 
!     if (1 == 0)
      {
! 	@{$tree[0]} = ("Choose Hybs", 0); # root has itself as parent
! 	@{$tree[1]} = ("Quality Control", 0);
! 	@{$tree[2]} = ("Stat Analysis", 1);
! 	@{$tree[3]} = ("Westfall & Young", 1);
! 	@{$tree[4]} = ("R Cluster", 3);
! 	@{$tree[5]} = ("QA2", 2);
! 	@{$tree[6]} = ("GO", 3);
! 	@{$tree[7]} = ("TreeView", 2);
! 	@{$tree[8]} = ("XCluster", 2);
! 	@{$tree[9]} = ("Test", 6);
! 	@{$tree[10]} = ("NNormal", 7);
! 	@{$tree[11]} = ("ProcA", 9);
! 	@{$tree[13]} = ("Cluster2", 3);
! 	@{$tree[12]} = ("Cyber T", 0);
! 	@{$tree[13]} = ("Subset", 12);
! 	@{$tree[14]} = ("StatMatch", 13);
! 	@{$tree[15]} = ("PVal" , 3);
! 	@{$tree[16]} = ("Multi", 3);
      }
  }

--- 248,328 ----
  }

+ #
+ # local copy of %tree since this one comes from the web page?
+ #
  sub write_db
  {
!     my $dbh = $_[0];
!     my %tree = %{$_[1]};
!     my $sth;
!     
!     if (exists($tree{add_an_fk}))
      {
! 	$sth = getq("insert_tree_node", $dbh);
! 	#  tree_fk, parent_fk, an_fk
! 	$sth->execute($tree{tree_pk},  $tree{add_parent}, $tree{add_an_fk});
!     }
!     elsif (exists($tree{update_node_pk}))
!     {
! 	$sth = getq("update_tree_node", $dbh);
! 	# ana_fk, node_pk
! 	$sth->execute($tree{update_an_fk}, $tree{update_node_pk});
!     }
!     elsif (exists($tree{delete}))
!     {
! 	my $s_node;
! 	my @nstack;
! 	$sth = getq("delete_tree_node", $dbh);
! 	if ($tree{delete}[1] == $tree{root})
  	{
! 	    return ; # don't allow deletion of the root of the tree;
! 	}
! 	push(@nstack, $tree{delete_node_pk});
! 	delete($tree{delete_node_pk}); # delete the extra hash element created as a delete carrier
! 	my $lc = 0;
! 	while($#nstack >= 0)
! 	{
! 	    $s_node = pop(@nstack);
! 	    $sth->execute($s_node); # delete the record
! 	    delete($tree{$s_node}); # delete the element
! 	    foreach my $node (keys(%tree))
! 	    {
! 		if ($node !~ m/\d+/)
! 		{
! 		    next; # only do numeric nodes. We now have $tree{"root"}, $tree{delete}, etc.
! 		}
! 		if ($tree{$node}[1] == $s_node)
! 		{
! 		    push(@nstack, $node);
! 		}
! 		$lc++;
! 		if ($lc > 100) 
! 		{
! 		    die "inf. loop\n";
! 		}
! 	    }
  	}
      }
  }

  sub read_db
  {
!     my $dbh = $_[0];
!     my $tree_pk = $_[1];
!     my $sth = getq("read_tree", $dbh);
!     $sth->execute($tree_pk) || die "Query read_tree execute error: $DBI::errstr\n";
!     while(( my $node_pk, my $name, my $parent_key, my $an_fk) = $sth->fetchrow_array())
      {
! 	if ($parent_key == -1)
! 	{
! 	    $tree{root} = $node_pk;
! 	}
! 	push(@{$tree{$node_pk}}, $name);
! 	push(@{$tree{$node_pk}}, $parent_key);
! 	push(@{$tree{$node_pk}}, $an_fk);
! 	push(@{$tree{$node_pk}}, $tree_pk);
! 	# write_log("pk:$node_pk n:$name p:$parent_key a:$an_fk t:$tree_pk");
      }
+     return $tree{root};
  }

***************
*** 288,296 ****
  	    {
  		# special case for the root
! 		if (($parent[$table[$xx][$yy]] != $prev_parent) || ($table[$xx][$yy] == 0))
  		{
! 		    # print "p: $parent[$table[$xx][$yy]] pp: $prev_parent\n";
  		    $gc++;
! 		    $prev_parent = $parent[$table[$xx][$yy]];
  		}
  		$colors[$xx][$yy] = $choices[$gc%5];
--- 339,347 ----
  	    {
  		# special case for the root
! 		if (($parent{$table[$xx][$yy]} != $prev_parent) || ($table[$xx][$yy] == 0))
  		{
! 		    # print "p: $parent{$table[$xx][$yy]} pp: $prev_parent\n";
  		    $gc++;
! 		    $prev_parent = $parent{$table[$xx][$yy]};
  		}
  		$colors[$xx][$yy] = $choices[$gc%5];
***************
*** 325,331 ****
--- 376,384 ----
  	for(my $yy=0; $yy<=$tmax; $yy++)
  	{
+ 	    write_log("$xx,$yy:$table[$xx][$yy]");
  	    if (defined($table[$xx][$yy]))
  	    {
  		my $node = $table[$xx][$yy];
+ 		write_log("node: $node");
  		if ($node =~ m/img/)
  		{
***************
*** 340,345 ****
  		    $html .= "
  <td width=\"75\" bgcolor=\"$colors[$xx][$yy]\">
! <input type=\"hidden\" name=\"name_$node\" value=\"$tree[$node][0]\">
! <input type=\"hidden\" name=\"parent_$node\" value=\"$parent[$node]\">";
  		    if ($node > 0) # UI prevents root deletion, and so does code in edit_atree2.pl
  		    {
--- 393,398 ----
  		    $html .= "
  <td width=\"75\" bgcolor=\"$colors[$xx][$yy]\">
! <input type=\"hidden\" name=\"name_$node\" value=\"$tree{$node}[0]\">
! <input type=\"hidden\" name=\"parent_$node\" value=\"$parent{$node}\">";
  		    if ($node > 0) # UI prevents root deletion, and so does code in edit_atree2.pl
  		    {
***************
*** 349,353 ****
  		    }
  $html .= "($node)<input type=\"image\" border=\"0\" name=\"edit_$node\" src=\"../graphics/pencil.gif\" width=\"25\" height=\"25\"><br>
! <div align=\"center\"><font size=\"-1\">$tree[$node][0]<br><input type=\"radio\" name=\"node_number\" value=\"$node\">\n";
  		    $html .= "</font></div></td>\n";
  		}
--- 402,406 ----
  		    }
  $html .= "($node)<input type=\"image\" border=\"0\" name=\"edit_$node\" src=\"../graphics/pencil.gif\" width=\"25\" height=\"25\"><br>
! <div align=\"center\"><font size=\"-1\">$tree{$node}[0]<br><input type=\"radio\" name=\"node_number\" value=\"$node\">\n";
  		    $html .= "</font></div></td>\n";
  		}
***************
*** 381,387 ****
  	for(my $yy=0; $yy<=$tmax; $yy++)
  	{
! 	    if ($table[$xx][$yy] > 0)
  	    {
! 		my $parent = $parent[$table[$xx][$yy]];
  		$px = $loc{$parent}[0];
  		$py = $loc{$parent}[1];
--- 434,440 ----
  	for(my $yy=0; $yy<=$tmax; $yy++)
  	{
! 	    if ($table[$xx][$yy] > $tree{root})
  	    {
! 		my $parent = $parent{$table[$xx][$yy]};
  		$px = $loc{$parent}[0];
  		$py = $loc{$parent}[1];
***************
*** 466,470 ****
  	for(my $yy=0; $yy<=$#{$generation[$xx-1]}; $yy++)
  	{
! 	    my $num_children = $#{$children[$generation[$xx-1][$yy]]}; 
  	    # If there are no children, the $num_children will be -1 since 
  	    # it is an array index. If so, we still have to increment the
--- 519,523 ----
  	for(my $yy=0; $yy<=$#{$generation[$xx-1]}; $yy++)
  	{
! 	    my $num_children = $#{$children{$generation[$xx-1][$yy]}}; 
  	    # If there are no children, the $num_children will be -1 since 
  	    # it is an array index. If so, we still have to increment the
***************
*** 477,482 ****
  	    for(my $nc=0; $nc<=$num_children; $nc++)
  	    {
! 		my $node = $children[$generation[$xx-1][$yy]][$nc];
! 		my $kid_count = $#{$children[$node]} +1;
  		$gen_max = 0;  # highest column number of my children; used to align parent above sibling columns
  		if ($row >= 2) # only check this after we've layed out at least one generation
--- 530,535 ----
  	    for(my $nc=0; $nc<=$num_children; $nc++)
  	    {
! 		my $node = $children{$generation[$xx-1][$yy]}[$nc];
! 		my $kid_count = $#{$children{$node}} +1;
  		$gen_max = 0;  # highest column number of my children; used to align parent above sibling columns
  		if ($row >= 2) # only check this after we've layed out at least one generation
***************
*** 484,490 ****
  		    for(my $gg=0; $gg<=$#{$table[$row-2]}; $gg++)
  		    {
! 			for(my $cc=0; $cc<=$#{$children[$node]}; $cc++)
  			{
! 			    if (($table[$row-2][$gg] == $children[$node][$cc]) && ($gg > $gen_max))
  			    {
  				$gen_max = $gg;
--- 537,543 ----
  		    for(my $gg=0; $gg<=$#{$table[$row-2]}; $gg++)
  		    {
! 			for(my $cc=0; $cc<=$#{$children{$node}}; $cc++)
  			{
! 			    if (($table[$row-2][$gg] == $children{$node}[$cc]) && ($gg > $gen_max))
  			    {
  				$gen_max = $gg;
***************
*** 535,539 ****
  	for(my $gg=0; $gg<=$#{$table[$row-2]}; $gg++)
  	{
! 	    for(my $cc=0; $cc<=$#{$children[0]}; $cc++)
  	    {
  		if (($table[$row-2][$gg] > 0) && ($kid_min == 0))
--- 588,592 ----
  	for(my $gg=0; $gg<=$#{$table[$row-2]}; $gg++)
  	{
! 	    for(my $cc=0; $cc<=$#{$children{$tree{root}}}; $cc++)
  	    {
  		if (($table[$row-2][$gg] > 0) && ($kid_min == 0))
***************
*** 541,545 ****
  		    $kid_min = $table[$row-2][$gg];
  		}
! 		if (($table[$row-2][$gg] == $children[0][$cc]) && ($gg > $gen_max))
  		{
  		    $gen_max = $gg;
--- 594,598 ----
  		    $kid_min = $table[$row-2][$gg];
  		}
! 		if (($table[$row-2][$gg] == $children{$tree{root}}[$cc]) && ($gg > $gen_max))
  		{
  		    $gen_max = $gg;
***************
*** 575,579 ****
  	    {
  		# get parent's x coord
! 		my $parent_node = $parent[$table[$yy][$xx]];
  		my $parent_x;
  		my $node_x = $xx;
--- 628,632 ----
  	    {
  		# get parent's x coord
! 		my $parent_node = $parent{$table[$yy][$xx]};
  		my $parent_x;
  		my $node_x = $xx;
***************
*** 617,634 ****
      # into account.
      # 
!     $node2g{0} = 0;
!     push(@{$generation[$node2g{0}]}, 0);
!     $parent[0] = 0;
!     for($xx = 0; $xx<=$#tree; $xx++)
      {
! 	for($yy = $xx+1; $yy<=$#tree; $yy++)
  	{
! 	    if ($tree[$yy][1] == $xx)
  	    {
! 		# print "$xx $tree[$xx][0] is parent of $tree[$yy][0] $tree[$yy][1]\n";
! 		$parent[$yy] = $xx;           # we can only have one parent
! 		push(@{$children[$xx]}, $yy); # add self to parent's children list
! 		$node2g{$yy} = $node2g{$parent[$yy]} + 1;
! 		push(@{$generation[$node2g{$yy}]}, $yy);
  	    }
  	}
--- 670,710 ----
      # into account.
      # 
!     foreach my $node (keys(%tree))
      {
! 	if ($node !~ m/\d+/)
  	{
! 	    next; # only do numeric nodes. We now have $tree{"root"}
! 	}
! 	if ($tree{$node}[1] == -1)
! 	{
! 	    # parent and children need to be hashes due to 
! 	    # sparse data
! 	    $parent{$node} = -1;                          # we can only have one parent
! 	    $node2g{$node} = 0;                           # my generation zero
! 	    push(@{$generation[$node2g{$node}]}, $node);  # add self to my generation's list
! 	    last;
! 	}
!     }
!     #$node2g{0} = 0;
!     #push(@{$generation[$node2g{0}]}, 0);
!     #$parent{0} = 0;
!     foreach my $parent (keys(%tree))
!     {
! 	if ($parent == -1)
! 	{
! 	    next;
! 	}
! 	foreach my $node (keys(%tree))
! 	{
! 	    if ($node !~ m/\d+/)
  	    {
! 		next; # only do numeric nodes. We now have $tree{"root"}
! 	    }
! 	    if ($tree{$node}[1] == $parent)
! 	    {
! 		$parent{$node} = $parent;                     # we can only have one parent
! 		push(@{$children{$parent}}, $node);           # add self to parent's children list
! 		$node2g{$node} = $node2g{$parent{$node}} + 1; # my generation is my parent's generation +1
! 		push(@{$generation[$node2g{$node}]}, $node);  # add self to my generation's list
  	    }
  	}
***************
*** 638,652 ****
  sub print_tree_info
  {
!     for(my $xx=0;  $xx<=$#parent; $xx++)
      {
! 	if ($xx == 0)
  	{
! 	    print "\"$tree[$xx][0]\" is the root. ";
  	}
  	else
  	{
! 	    print "\"$tree[$xx][0]\"'s parent is \"$tree[$parent[$xx]][0]\". ";
  	}
! 	my $num_children = $#{$children[$xx]}+1;
  	if ($num_children > 0)
  	{
--- 714,729 ----
  sub print_tree_info
  {
!     #for(my $xx=0;  $xx<=$#parent; $xx++)
!     foreach my $node (keys(%parent))
      {
! 	if ($node == $tree{root})
  	{
! 	    print "\"$tree{$node}[0]\" is the root. ";
  	}
  	else
  	{
! 	    print "\"$tree{$node}[0]\"'s parent is \"$tree{$parent{$node}}[0]\". ";
  	}
! 	my $num_children = $#{$children{$node}}+1;
  	if ($num_children > 0)
  	{
***************
*** 659,665 ****
  		print "$num_children children. ";
  	    }
! 	    foreach my $child (@{$children[$xx]})
  	    {
! 		print "\"$tree[$child][0]\" ";
  	    }
  	}
--- 736,742 ----
  		print "$num_children children. ";
  	    }
! 	    foreach my $child (@{$children{$node}})
  	    {
! 		print "\"$tree{$child}[0]\" ";
  	    }
  	}
***************
*** 675,686 ****
  sub print_children_info
  {
!     for(my $xx=0; $xx<=$#children; $xx++)
      {
! 	if ($#{$children[$xx]} >= 0)
  	{
! 	    print "Children $xx: ";
! 	    for(my $yy=0; $yy<=$#{$children[$xx]}; $yy++)
  	    {
! 		print "($xx,$yy) $children[$xx][$yy] ";
  	    }
  	    print "\n";
--- 752,764 ----
  sub print_children_info
  {
!     # for(my $xx=0; $xx<=$#children; $xx++)
!     foreach my $node (keys(%children))
      {
! 	if ($#{$children{$node}} >= 0)
  	{
! 	    print "Children $node: ";
! 	    for(my $yy=0; $yy<=$#{$children{$node}}; $yy++)
  	    {
! 		print "($node,$yy) $children{$node}[$yy] ";
  	    }
  	    print "\n";
***************
*** 706,709 ****
--- 784,788 ----
  sub print_ascii_tree
  {
+     print "pre a:$table[0][0]\n";
      print "   0 1 2 3 4 5 6 7 8 91011121314151617181920\n";
      for(my $xx=$#table; $xx>=0; $xx--)
***************
*** 714,717 ****
--- 793,797 ----
  	{
  	    if ($table[$xx][$yy] < 10) { print " ";}
+ 	    # print "$xx,$yy:$table[$xx][$yy]\n";
  	    if (defined($table[$xx][$yy]))
  	    {

Index: edit_atree2.pl
===================================================================
RCS file: /cvsroot/genex/genex-server/site/webtools/Attic/edit_atree2.pl,v
retrieving revision 1.1.2.4
retrieving revision 1.1.2.5
diff -C2 -d -r1.1.2.4 -r1.1.2.5
*** edit_atree2.pl	6 Nov 2002 16:38:58 -0000	1.1.2.4
--- edit_atree2.pl	8 Nov 2002 21:22:53 -0000	1.1.2.5
***************
*** 15,25 ****
      my $us_fk = get_us_fk($dbh);

!     my @tree = read_tree($q);
!     write_db(\@tree);

      my $url = index_url(); # see sessionlib.pl
      $url =~ s/(.*)\/.*/$1\/edit_atree1.pl/;
!     print "Location: $url?message=$message\n\n";

      $dbh->disconnect();
  }
--- 15,27 ----
      my $us_fk = get_us_fk($dbh);

!     my %tree = read_tree($q);
!     write_db($dbh, \%tree);

      my $url = index_url(); # see sessionlib.pl
      $url =~ s/(.*)\/.*/$1\/edit_atree1.pl/;
!     my $tree_pk = $q->param("tree_pk");
!     print "Location: $url?tree_pk=$tree_pk\n\n";

+     $dbh->commit();
      $dbh->disconnect();
  }
***************
*** 29,33 ****
      my $q = $_[0];
      my %ch = $q->Vars();
!     my @tree;

      foreach my $key (keys(%ch))
--- 31,35 ----
      my $q = $_[0];
      my %ch = $q->Vars();
!     my %tree;

      foreach my $key (keys(%ch))
***************
*** 36,41 ****
  	if ($key =~ m/name_(\d+)/)
  	{
! 	    $tree[$1][0] = $ch{$key};
! 	    $tree[$1][1] = $ch{"parent_$1"};
  	}
      }
--- 38,43 ----
  	if ($key =~ m/name_(\d+)/)
  	{
! 	    $tree{$1}[0] = $ch{$key};
! 	    $tree{$1}[1] = $ch{"parent_$1"};
  	}
      }
***************
*** 47,59 ****
      if (exists($ch{add}))
      {
! 	my $tmax = $#tree;
! 	$tmax++;
! 	$tree[$tmax][0] = $ch{select_node};
! 	$tree[$tmax][1] = $active_node; 
! 	# write_log("Adding $tmax: $tree[$tmax][0],$tree[$tmax][1]");
      }
      if (exists($ch{change}))
      {
! 	$tree[$active_node][0] = $ch{select_node};
      }
      elsif(exists($ch{"delete_$active_node\.x"}))
--- 49,63 ----
      if (exists($ch{add}))
      {
! 	#
! 	# The single new node gets a special key "new", instead of a node_pk.
! 	# It'll get a node_pk later.
! 	#
! 	$tree{add_an_fk} = $ch{select_node};
! 	$tree{add_parent} = $active_node; 
      }
      if (exists($ch{change}))
      {
! 	$tree{update_node_pk} = $active_node;
! 	$tree{update_an_fk} = $ch{select_node};
      }
      elsif(exists($ch{"delete_$active_node\.x"}))
***************
*** 62,122 ****
  	# Just use the .x
  	# The node_number radio button has to be clicked to set $active_node
! 	@tree = delete_node($active_node,\@tree);
      }
!     return @tree;
  }

- sub delete_node
- {
-     my $node = $_[0];
-     my @tree = @{$_[1]};
-     my $s_node;
-     my @nstack;
-     if ($node == 0)
-     {
- 	return @tree; # don't allow deletion of the root of the tree;
-     }
-     push(@nstack, $node);
-     my $lc = 0;
-     while($#nstack >= 0)
-     {
- 	$s_node = pop(@nstack);
- 	$tree[$s_node][1] = (-1); # deleted.
- 	# write_log("deleting $s_node\n");
- 	for(my $xx=0; $xx<=$#tree; $xx++)
- 	{
- 	    if ($tree[$xx][1] == $s_node)
- 	    {
- 		# write_log("xx:$xx s_node:$s_node pushing: $xx stack size:$#nstack\n");
- 		push(@nstack, $xx);
- 	    }
- 	    $lc++;
- 	    if ($lc > 100) 
- 	    {
- 		die "inf. loop\n";
- 	    }
- 	}
-     }
-     for(my $xx=0; $xx<=$#tree; $xx++)
-     {
- 	if ($tree[$xx][1] == -1)
- 	{
- 	    if ($xx < $#tree)
- 	    {
- 		for(my $yy=$xx+1; $yy<=$#tree; $yy++)
- 		{
- 		    my $temp = $yy-1;
- 		    $tree[$yy-1][0] = $tree[$yy][0];
- 		    $tree[$yy-1][1] = $tree[$yy][1];
- 		    if ($tree[$yy][1] >= $xx)
- 		    {
- 			$tree[$yy-1][1]--;
- 		    }
- 		}
- 	    }
- 	    $#tree--; # remove the last, now unused, node of the tree.
- 	}
-     }

-     return @tree;
- }
--- 66,75 ----
  	# Just use the .x
  	# The node_number radio button has to be clicked to set $active_node
! 	$tree{delete_node_pk} = $active_node;
      }
!     $tree{tree_pk} = $ch{tree_pk};
!     $tree{root} = $ch{root};
!     return %tree;
  }

Index: edit_atree1.html
===================================================================
RCS file: /cvsroot/genex/genex-server/site/webtools/Attic/edit_atree1.html,v
retrieving revision 1.1.2.4
retrieving revision 1.1.2.5
diff -C2 -d -r1.1.2.4 -r1.1.2.5
*** edit_atree1.html	6 Nov 2002 16:38:58 -0000	1.1.2.4
--- edit_atree1.html	8 Nov 2002 21:22:53 -0000	1.1.2.5
***************
*** 12,15 ****
--- 12,17 ----

  <form action="edit_atree2.pl" method=POST>
+ <input type="hidden" name="tree_pk" value="{tree_pk}">
+ <input type="hidden" name="root" value="{root}">
    {atree} <br>
    <br>

Index: edit_atree1.pl
===================================================================
RCS file: /cvsroot/genex/genex-server/site/webtools/Attic/edit_atree1.pl,v
retrieving revision 1.1.2.1
retrieving revision 1.1.2.2
diff -C2 -d -r1.1.2.1 -r1.1.2.2
*** edit_atree1.pl	1 Nov 2002 16:30:48 -0000	1.1.2.1
--- edit_atree1.pl	8 Nov 2002 21:22:53 -0000	1.1.2.2
***************
*** 11,26 ****
  {
      my $q = new CGI;
!     my $sty_pk = $q->param("sty_pk");

      my $dbh = new_connection();
!     my $us_fk = get_us_fk($dbh);
! 
!     read_db();
      my $atree = render_at();
!     my $select_node = select_node();

      (my $all_html) = readtemplate("edit_atree1.html");

      $all_html =~ s/{message}//s;
      $all_html =~ s/{select_node}/$select_node/sg;
      $all_html =~ s/{atree}/$atree/sg;
--- 11,26 ----
  {
      my $q = new CGI;
!     my $tree_pk = $q->param("tree_pk");

      my $dbh = new_connection();
!     my $root = read_db($dbh, $tree_pk);
      my $atree = render_at();
!     my $select_node = select_node($dbh);

      (my $all_html) = readtemplate("edit_atree1.html");

      $all_html =~ s/{message}//s;
+     $all_html =~ s/{tree_pk}/$tree_pk/sg;
+     $all_html =~ s/{root}/$root/sg;
      $all_html =~ s/{select_node}/$select_node/sg;
      $all_html =~ s/{atree}/$atree/sg;

Index: sql_lib.pl
===================================================================
RCS file: /cvsroot/genex/genex-server/site/webtools/Attic/sql_lib.pl,v
retrieving revision 1.1.2.1
retrieving revision 1.1.2.2
diff -C2 -d -r1.1.2.1 -r1.1.2.2
*** sql_lib.pl	7 Nov 2002 17:43:36 -0000	1.1.2.1
--- sql_lib.pl	8 Nov 2002 21:22:53 -0000	1.1.2.2
***************
*** 1,3 ****
--- 1,5 ----

+ use strict;
+ 
  $::sql_lib_loaded = 1;
  $::sql_lib_loaded = 1; # quiet compile warnings
***************
*** 7,11 ****
      my $q_name = $_[0];
      my $dbh    = $_[1];
!     my @args   = @{$_[2]};
      my $us_fk  = get_us_fk($dbh);
      my $sth; 
--- 9,16 ----
      my $q_name = $_[0];
      my $dbh    = $_[1];
!     if ($_[2])
!     {
! 	my @args   = @{$_[2]};
!     }
      my $us_fk  = get_us_fk($dbh);
      my $sth; 
***************
*** 13,25 ****
      my $wclause;
      my $ok_flag = 0;

!     if ($qname == "select_tree")
      {
- 	$ok_flag = 1;
  	($fclause, $wclause) = write_where_clause("tree", "tree_pk", $us_fk );
! 	my $sql = "select name,tree_pk from tree,$fclause where $wclause order by name";
      }

!     if ($ok_flag)
      {
  	$sth = $dbh->prepare($sql) || die "$sql\n$DBI::errstr\n";
--- 18,50 ----
      my $wclause;
      my $ok_flag = 0;
+     my $sql;

!     if ($q_name eq "select_tree")
      {
  	($fclause, $wclause) = write_where_clause("tree", "tree_pk", $us_fk );
! 	$sql = "select name,tree_pk from tree,$fclause where $wclause order by name";
!     }
!     elsif ($q_name eq "insert_tree")
!     {
! 	$sql = "insert into tree (name) values ('Tree')";
!     }
!     elsif ($q_name eq "insert_tree_node")
!     {
! 	$sql = "insert into node (tree_fk,parent_key,an_fk) values (?,?,?)";
!     }
!     elsif ($q_name eq "read_tree")
!     {
! 	$sql = "select node_pk, analysis.name, parent_key, an_fk from node, analysis where tree_fk=? and an_fk=an_pk";
!     }
!     elsif ($q_name eq "update_tree_node")
!     {
! 	$sql = "update node set an_fk=? where node_pk=?"
!     }
!     elsif ($q_name eq "select_analysis")
!     {
! 	$sql = "select name,an_pk from analysis order by name";
      }

!     if (defined($sql))
      {
  	$sth = $dbh->prepare($sql) || die "$sql\n$DBI::errstr\n";

Update of /cvsroot/genex/genex-server/Genex/scripts
In directory usw-pr-cvs1:/tmp/cvs-serv30529

Modified Files:
	user-insert.pl.in 
Log Message:
removed my generate_user.pl.in from the repository in favour of Jasons user-insert.pl.in   Fixed some of the logic in user-insert.pl.in, maded other small changes to help it talk to the HTML file as well as being standalone.

Index: user-insert.pl.in
===================================================================
RCS file: /cvsroot/genex/genex-server/Genex/scripts/user-insert.pl.in,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** user-insert.pl.in	13 Oct 2002 19:19:09 -0000	1.3
--- user-insert.pl.in	8 Nov 2002 13:34:07 -0000	1.4
***************
*** 13,17 ****

  use strict;
! use blib;
  use Carp;
  use Getopt::Long;
--- 13,17 ----

  use strict;
! #use blib;
  use Carp;
  use Getopt::Long;
***************
*** 25,42 ****
  use Bio::Genex::ContactType;

! my $pub_groupname = '%%GENEX_PUBLIC_GROUP%%';
! my $su_groupname = '%%GENEX_SUPERUSER_GROUP%%';

  my %OPTIONS;
  $OPTIONS{dbname} = '%%DB_NAME%%';
  my $rc = GetOptions(\%OPTIONS,
! 		    'new_user=s',
! 		    'new_pass=s',
! 		    'username=s',
! 		    'password=s',
! 		    'dbname=s',
! 		    'debug',
! 		    'no_group',
! 		    'organization=s',
  		    'contact_person=s',
  		    'contact_person_phone=s',
--- 25,43 ----
  use Bio::Genex::ContactType;

! #my $pub_groupname = '%%GENEX_PUBLIC_GROUP%%';
! #my $su_groupname = '%%GENEX_SUPERUSER_GROUP%%';

  my %OPTIONS;
  $OPTIONS{dbname} = '%%DB_NAME%%';
  my $rc = GetOptions(\%OPTIONS,
! 		    'username=s',  # Clients username
! 		    'password=s',  # clients password
! 		    'new_user=s',  # new genex user username
! 		    'new_pass=s', # new genex user password
! 		    'new_pass2=s',# retype
! 		    'dbname=s',  # name of the database
! 		    'debug',      # dedbug mode?
! 		    'no_group',  # don't unclude group info
! 		    'organization=s', 
  		    'contact_person=s',
  		    'contact_person_phone=s',
***************
*** 48,51 ****
--- 49,55 ----
  		    'org_fax=s',
  		    'url=s',
+ 			'ro_groupname=s',
+ 			'rw_groupname=s',
+ 			
  		   );

***************
*** 87,90 ****
--- 91,96 ----
  die "Must specify --new_pass\n$USAGE"
    unless exists $OPTIONS{new_pass};
+ die "Passwords don't match\n$USAGE"
+   if ($OPTIONS{new_pass2}&&($OPTIONS{new_pass} ne $OPTIONS{new_pass2}));
  die "Must specify --username\n$USAGE"
    unless exists $OPTIONS{username};
***************
*** 92,100 ****
    unless exists $OPTIONS{password};

! my $dbh = Bio::Genex::Connect->new(USER=>$OPTIONS{username},
! 				   PASSWORD=>$OPTIONS{password},
! 				   DBNAME=>$OPTIONS{dbname},
! 				   TRANSACTION=>1,
! 				  );
  die "Couldn't login to DB: Bad username or password"
    unless defined $dbh;
--- 98,112 ----
    unless exists $OPTIONS{password};

! $OPTIONS{ro_groupname} = '%%GENEX_PUBLIC_GROUP%%'
! 	unless $OPTIONS{ro_groupname};
! $OPTIONS{rw_groupname} = '%%GENEX_SUPERUSER_GROUP%%'
! 	unless $OPTIONS{rw_groupname};
! 
! my $dbh = Bio::Genex::Connect->new(
! 	USER=>$OPTIONS{username},
! 	PASSWORD=>$OPTIONS{password},
! 	DBNAME=>$OPTIONS{dbname},
! 	TRANSACTION=>1,
! 	);
  die "Couldn't login to DB: Bad username or password"
    unless defined $dbh;
***************
*** 110,121 ****

  my ($pub_group) = Bio::Genex::GroupSec->get_objects($dbh,
! 						   $pub_groupname);
  $dbh->error(@error_args,
! 	    msg=>"Group $pub_groupname doesn't exist in DB",
  	   ) unless defined $pub_group;
  my ($su_group) = Bio::Genex::GroupSec->get_objects($dbh,
! 						   $su_groupname);
  $dbh->error(@error_args,
! 	    msg=>"Group $su_groupname doesn't exist in DB",
  	   ) unless defined $su_group;

--- 122,133 ----

  my ($pub_group) = Bio::Genex::GroupSec->get_objects($dbh,
! 						   $OPTIONS{ro_groupname});
  $dbh->error(@error_args,
! 	    msg=>"Group $OPTIONS{ro_groupname} doesn't exist in DB",
  	   ) unless defined $pub_group;
  my ($su_group) = Bio::Genex::GroupSec->get_objects($dbh,
! 						   $OPTIONS{rw_groupname});
  $dbh->error(@error_args,
! 	    msg=>"Group $OPTIONS{rw_groupname} doesn't exist in DB",
  	   ) unless defined $su_group;

***************
*** 140,144 ****
  my $c = Bio::Genex::Contact->new(contact_person=>$OPTIONS{contact_person},
  				 ro_groupname_obj=>$pub_group,
! 				 rw_groupname_obj=>$g,
  				);

--- 152,156 ----
  my $c = Bio::Genex::Contact->new(contact_person=>$OPTIONS{contact_person},
  				 ro_groupname_obj=>$pub_group,
! 				 rw_groupname_obj=>$g, # either his own group or the su group
  				);

Update of /cvsroot/genex/genex-server/G2G/mason
In directory usw-pr-cvs1:/tmp/cvs-serv27869

Added Files:
	user-insert.html.in 
Log Message:
removed generate_user.html.in renamed it to user-insert.html.in so that it corresponds to Jasons standalone script.  Changed various features in the html to make them compatible with the standalone script.  Changed the logic of the html to make it consistent with the standalone script.  added new variables that the script needs.  the script prints all errors to STDERR, and those can not be caught by the mason html, so much of the error reporting is dead. A generic but helpful error message is generated in any case that the mason script can't trap by itself.  Requires that the standalone script be movd into the /usr/local/genex/bin folder, or equivalent.

--- NEW FILE: user-insert.html.in ---
% if (($response_page eq "NEW") || ($response_page eq "badUP") || ($response_page eq "badORG")) { 
        <center>
        <h1>Create New Genex User</h1>
        <form action="user-insert.html"><br>
        <br>
% if ($response_page eq "badUP"){
        <h3><font color="red">Your information was incomplete.  You must supply:
        <ul>
        <li>A valid database username and password
        <li>A username for your new user
        <li>A password for your new user (and matching confirmation)
        <li>Your new users Contact Name
        </ul>
        </font></h3>
% $new_user = ""; $new_pass = ""; $new_pass2="";        
% }
% if ($response_page eq "badContact"){
        <h3><font color="red">You must provide a Contact Name</font></h3>
% $organization = "";
% }
        <center>Database Login Username - <input name="username" width="12"><br><br></center>
        <center>Database Login Password - <input name="password" type="password" width="12"><br><br></center>
        <table cellpadding="2" cellspacing="2" border="0"
         style="width: 70%; text-align: left; margin-left: auto; margin-right: auto;"
         title="Enter the following information for your user"
         summary="information about the new genex user">
          <caption><br>
          </caption>  <tbody>
            <tr>
              <td valign="top">New Username<br>
              </td>
              <td valign="top"><input name="new_user" type="text" width="12" value="<% $username %>"></td>
              <td valign="top"><br>
              <br>
              </td>
              <td valign="top"><br>
              <br>
              </td>
            </tr>
            <tr>
              <td valign="top">New Password<br></td>
              <td valign="top"><input name="new_pass" type="password" width="12" value="<% $new_pass %>"></td>
              <td valign="top">Confirm Password<br></td>
              <td valign="top"><input name="new_pass2" type="password" width="12" value="<% $new_pass2 %>"></td>
            </tr>
            <tr>
              <td valign="top"><br><input type="checkbox" name="no_group" value=1> 
              </td>
              <td valign="top"><br>Don't Generate New Group For This User
              </td>
              <td valign="top"><br>
              <br>
              </td>
              <td valign="top"><br>
              <br>
              </td>
            </tr>
            <tr>
              <td valign="top">Contact:<br>
              <br>
              </td>
              <td valign="top"><br>
              <br>
              </td>
              <td valign="top"><br>
              <br>
              </td>
              <td valign="top"><br>
              <br>
              </td>
            </tr>
            <tr>
              <td valign="top"><br>
              <br>
              </td>
              <td valign="top">Name (required)<br>
              <br>
              </td>
              <td valign="top"><input type="text" name="contact_person" width="30" value="<% $contact_person %>"></td>
              <td valign="top"><br>
              <br>
              </td>
            </tr>
            <tr>
              <td valign="top"><br>
              <br>
              </td>
              <td valign="top">Phone<br>
              <br>
              </td>
              <td valign="top"><input type="text" name="contact_person_phone" width="30" value="<% $contact_person_phone %>"></td>
              <td valign="top"><br>
              <br>
              </td>
            </tr>
            <tr>
              <td valign="top"><br>
              <br>
              </td>
              <td valign="top">Email<br>
              <br>
              </td>
              <td valign="top"><input type="text" name="contact_person_email" width="30" value="<% $contact_person_email %>"></td>
              <td valign="top"><br>
              <br>
              </td>
            </tr>
            <tr>
              <td valign="top">Organization:<br>
              </td>
              <td valign="top"><br>
              <br>
              </td>
              <td valign="top"><br>
              <br>
              </td>
              <td valign="top"><br>
              <br>
              </td>
            </tr>
            <tr>
              <td valign="top"><br>
              <br>
              </td>
              <td valign="top">Name<br>
              <br>
              </td>
              <td valign="top"><input name="organization" type="text" width="30" value="<% $organization %>">
             </td>
              <td valign="top"><br>
              <br>
              </td>
            </tr>
            <tr>
              <td valign="top"><br>
              <br>
              </td>
              <td valign="top">Phone<br>
              <br>
              </td>
              <td valign="top"><input name="org_phone" type="text" width="30" value="<% $org_phone %>">  
          </td>
              <td valign="top"><br>
              <br>
              </td>
            </tr>
            <tr>
              <td valign="top"><br>
              <br>
              </td>
              <td valign="top">Toll-free<br>
              <br>
              </td>
              <td valign="top"><input name="org_toll_free_phone" type="text" value="<% $org_toll_free_phone %>" width="30"></td>
              <td valign="top"><br>
              <br>
              </td>
            </tr>
            <tr>
              <td valign="top"><br>
              <br>
              </td>
              <td valign="top">Fax<br>
              <br>
              </td>
              <td valign="top"><input name="org_fax" type="text" width="30" value="<% $org_fax %>">    
         </td>
              <td valign="top"><br>
              <br>
              </td>
            </tr>
            <tr>
              <td valign="top"><br>
              <br>
              </td>
              <td valign="top">Email<br>
              </td>
              <td valign="top"><input name="org_email" type="text" width="30" value="<% $org_email %>">  
          </td>
              <td valign="top"><br>
              <br>
              </td>
            </tr>
            <tr>
              <td valign="top"><br>
              <br>
              </td>
              <td valign="top">URL<br>
              <br>
              </td>
              <td valign="top"><input name="url" type="text" width="30" value="<% $url %>"></td>
              <td valign="top"><br>
              <br>
              </td>
            </tr>
            <tr>
              <td valign="top"><br>
              <br>
              </td>
              <td valign="top">Mailing Address<br>
              </td>
              <td valign="top" colspan="2"><textarea width="40" height="7" name="org_mail_address"><% $org_mail_address %></textarea></td>
            </tr>
            <tr>
              <td valign="top"><br>
              <br>
              </td>
              <td valign="top"><br>
              <br>
              </td>
              <td valign="top"><br>
              <br>
              </td>
              <td valign="top"><br>
              <br>
              </td>
            </tr>

          </tbody>
        </table>
        <br>
        <input name="submitted" type="hidden" value="true">
        <input type="submit" name="submit" value="Create This User"><br>
        <br>
        <br>
        last modified Nov 7, 2002<br>
        </center>
% }

% if ($response_page eq "DONE"){

        <div style="text-align: center;">
        <h1>Genex User Created</h1>

% } elsif (!($response_page eq "NEW")){
    User Creation Failed.  You may be attempting to create a user who already exists.  Please back up and try again.
% }

<%attr>
  action=>'%%GENEX_WORKSPACE_URL%%/user-insert.html'
  name=>'Create New Genex User'
  path=>'%%GENEX_WORKSPACE_URL%%/user-insert.html'
</%attr>
<%args>
    $username => ""
    $password => ""
    $new_user => ""
    $new_pass => ""
    $new_pass2 => ""
    $ro_groupname => ""
    $rw_groupname => ""
    $organization => ""
    $org_phone => ""
    $org_toll_free_phone => ""
    $org_fax => ""
    $org_email => ""
    $org_mail_address => ""
    $url => ""
    $contact_person => ""
    $contact_person_phone => ""
    $contact_person_email => ""
    $submitted => ""
    $debug => 0
    $no_group => ""
</%args>
<%once>;
</%once>
<%init>;
my $VERSION = '$Id: user-insert.html.in,v 1.1 2002/11/08 13:30:04 mwilkinson Exp $ ';
use Carp;
use Getopt::Long;
use File::Basename;
%%GENEX_EXTRALIBS%%
use Bio::Genex;
use Bio::Genex::Connect;
use Bio::Genex::UserSec;
use Bio::Genex::Contact;
use Bio::Genex::GroupLink;

my %OPTIONS; 
$OPTIONS{dbname} = "%%DB_NAME%%";
# set predictable default if this variable doesn't exist;

my $response_page;
my $commandline;
my @all;

unless ($submitted eq "true"){ # first time only, never clicked the button
    $response_page="NEW";
} else {
    if  (((!$username) ||
        (!$password)) ||
        (!$new_user) ||
        (!$new_pass) ||
        (!$new_pass2) ||
        ($new_pass ne $new_pass2)){
        $response_page="badUP"; # BAD USERNAME/PASSWORD
    } elsif (!$contact_person){
        $response_page="badContact"; # BAD ORGANIZATION
    } else {
        my $db=Bio::Genex::Connect->new(
            USER=>$OPTIONS{SU_USERNAME},
            PASSWORD=>$OPTIONS{SU_PASSWORD},
            DBNAME=>$OPTIONS{dbname},
            );
            my $perl = '%%START_PERL%%' ;
            $perl =~ s/^\#\!//;
            $commandline = "$perl %%GENEX_BIN_DIR%%/user-insert.pl ".
                "--username='$username' ".
                "--password='$password' ".
                "--new_user='$new_user' ".
                "--new_pass='$new_pass' ".
                "--new_pass2='$new_pass2' ".
                "--dbname='$OPTIONS{dbname}' ".
                "--organization='$organization' ".
                "--contact_person='$contact_person' ".
                "--contact_person_phone='$contact_person_phone' ".
                "--contact_person_email='$contact_person_email' ".
                "--org_email='$org_email' ".
                "--org_mail_address='$org_mail_address' ".
                "--org_phone='$org_phone' ".
                "--org_toll_free_phone='$org_toll_free_phone' ".
                "--org_fax='$org_fax' ".
                "--url='$url' ";
            if ($no_group){$commandline .="--no_group "}

            open (IN, "$commandline |") || die "cant start script $!\n";
            my $response;
            push @all, "result:\n";
            while ($response = <IN>){
                push @all, $response;
                chomp $response;
                last if ($response eq "Finished");
            }
            if ($response eq "Finished"){
                $response_page="DONE";
            } else {
                $response_page="badOPTS";
            }
    }
}
</%init>

Update of /cvsroot/genex/genex-server/Genex/scripts
In directory usw-pr-cvs1:/tmp/cvs-serv9691/Genex/scripts

Modified Files:
	mbad-insert.pl.in 
Log Message:
* scripts/mbad-insert.pl.in (Repository): 
fixed compile bug precedence error

Index: mbad-insert.pl.in
===================================================================
RCS file: /cvsroot/genex/genex-server/Genex/scripts/mbad-insert.pl.in,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** mbad-insert.pl.in	7 Nov 2002 14:48:48 -0000	1.3
--- mbad-insert.pl.in	8 Nov 2002 04:51:28 -0000	1.4
***************
*** 288,293 ****
    $dbh->error(@error_args,
  	      no_errstr=>1,
! 	      message=>"Didn't find the proper number of features. Was expecting " . scalar keys %features . ", but found $count")
!     unless scalar keys %features == $count;
    print STDERR "Found $count data lines\n" if $OPTIONS{debug};
  }
--- 288,293 ----
    $dbh->error(@error_args,
  	      no_errstr=>1,
! 	      message=>"Didn't find the proper number of features. Was expecting " . (scalar keys %features) . ", but found $count")
!     unless (scalar keys %features) == $count;
    print STDERR "Found $count data lines\n" if $OPTIONS{debug};
  }

Update of /cvsroot/genex/genex-server/G2G/mason/workspace-comps
In directory usw-pr-cvs1:/tmp/cvs-serv9404/G2G/mason/workspace-comps

Added Files:
	.cvsignore 
Log Message:
usual

--- NEW FILE: .cvsignore ---
footer.mason
header.mason
main.mason
nav.mason

Update of /cvsroot/genex/genex-server/site/webtools
In directory usw-pr-cvs1:/tmp/cvs-serv28335

Modified Files:
      Tag: Rel-1_0_1-branch
	add_analysis.pl 
Log Message:
Updated to reflect new tables

Index: add_analysis.pl
===================================================================
RCS file: /cvsroot/genex/genex-server/site/webtools/Attic/add_analysis.pl,v
retrieving revision 1.1.2.1
retrieving revision 1.1.2.2
diff -C2 -d -r1.1.2.1 -r1.1.2.2
*** add_analysis.pl	7 Nov 2002 19:18:35 -0000	1.1.2.1
--- add_analysis.pl	7 Nov 2002 20:43:59 -0000	1.1.2.2
***************
*** 3,14 ****
  =head1 NAME

!   act_analysis -  add an analysis to the list of possible analyses

  =head1 SYNOPSIS

!  ./act_analysis

  =head1 DESCRIPTION
!   The act_analysis is intended to configure an new analysis for use 
   with in the gene analsys system.  It does the following:
     - adds appropriate records to the database based on the config file
--- 3,14 ----
  =head1 NAME

!   add_analysis -  add an analysis to the list of possible analyses

  =head1 SYNOPSIS

!  ./add_analysis

  =head1 DESCRIPTION
!   The add_analysis is intended to configure an new analysis for use 
   with in the gene analsys system.  It does the following:
     - adds appropriate records to the database based on the config file
***************
*** 32,42 ****
          'up', { ARGCOUNT => ARGCOUNT_LIST },
          'filetype',{ ARGCOUNT => ARGCOUNT_LIST },
          'sp', { ARGCOUNT => ARGCOUNT_LIST },
!         'outputfile', { ARGCOUNT => ARGCOUNT_LIST,},
!         'inputfile', { ARGCOUNT => ARGCOUNT_LIST,});
      $config->define('configfile', {ARGCOUNT => ARGCOUNT_ONE},
                      'action', {ARGCOUNT => ARGCOUNT_ONE},
                      'debug', {ARGCOUNT => ARGCOUNT_ONE});
!     $config->getopt(\@ARGV);

--- 32,43 ----
          'up', { ARGCOUNT => ARGCOUNT_LIST },
          'filetype',{ ARGCOUNT => ARGCOUNT_LIST },
+         'extension',{ ARGCOUNT => ARGCOUNT_LIST },
          'sp', { ARGCOUNT => ARGCOUNT_LIST },
!         'analysisfile', { ARGCOUNT => ARGCOUNT_LIST,});
      $config->define('configfile', {ARGCOUNT => ARGCOUNT_ONE},
                      'action', {ARGCOUNT => ARGCOUNT_ONE},
                      'debug', {ARGCOUNT => ARGCOUNT_ONE});
!     my $success = $config->getopt(\@ARGV);
!     usage() if (! $success);

***************
*** 44,48 ****
      my $debug = $config->get('debug');
      usage() if (!defined $cfgfile);
!     $config->file($cfgfile);

      modifyDB($config);
--- 45,51 ----
      my $debug = $config->get('debug');
      usage() if (!defined $cfgfile);
!     usage() if (!defined $config->get('action'));
!     $success = $config->file($cfgfile);
!     die "Invalid config file format" if (! $success);

      modifyDB($config);
***************
*** 69,78 ****
               $action);  

!         # we need to add the input links to filetypes
!         act_file_links($dbh, "input", $config->get('inputfile'), 
!             $config->get('name'), $action);    
! 
!         # we need to add the output links to filetypes
!         act_file_links($dbh, "output", $config->get('outputfile'),
              $config->get('name'), $action);    

--- 72,77 ----
               $action);  

!         # we need to add the links to filetypes
!         act_file_links($dbh, $config->get('analysisfile'), 
              $config->get('name'), $action);    

***************
*** 82,85 ****
--- 81,87 ----
          # we need to add the userparams
          act_userparams($dbh, $config->get('up'), $config->get('name'), $action);    
+ 
+         # insert appropriate values in extension table
+         act_extension($dbh, $config->get('extension'), $action);
      }
      elsif ($action eq "remove")
***************
*** 88,110 ****
          # order to adding

!         # we need to add the input links to filetypes
!         act_file_links($dbh, "input", $config->get('inputfile'), 
!             $config->get('name'), $action);    

!         # we need to add the output links to filetypes
!         act_file_links($dbh, "output", $config->get('outputfile'),
              $config->get('name'), $action);    

!         # we need to add the sysparams
          act_sysparams($dbh, $config->get('sp'), $config->get('name'), $action);

!         # we need to add the userparams
          act_userparams($dbh, $config->get('up'), $config->get('name'), $action);

!         # we need to add the analysis
          act_analysis($dbh, $config->get('name'), $config->get('cmdstr'),
               $action);  
!         # insert appropriate values in appropriate tables
!         # we need to add filetypes (optional)
          act_filetype($dbh, $config->get('filetype'), $action);    
      } 
--- 90,111 ----
          # order to adding

!         # delete appropriate values in extension table
!         act_extension($dbh, $config->get('extension'), $action);

!         # we need to delete the links to filetypes
!         act_file_links($dbh, $config->get('analysisfile'),
              $config->get('name'), $action);    

!         # we need to delete the sysparams
          act_sysparams($dbh, $config->get('sp'), $config->get('name'), $action);

!         # we need to delete the userparams
          act_userparams($dbh, $config->get('up'), $config->get('name'), $action);

!         # we need to delete the analysis
          act_analysis($dbh, $config->get('name'), $config->get('cmdstr'),
               $action);  
! 
!         # we need to delete filetypes (optional)
          act_filetype($dbh, $config->get('filetype'), $action);    
      } 
***************
*** 158,165 ****
      my %rec = %$record;
      my $name = $rec{name};
-     my $ext = $rec{extension};
      my $comment = $rec{comment};

!     checkValidFields([ "name" ], ["name", "extension", "comment"], $record);

      if ($action eq "remove")
--- 159,165 ----
      my %rec = %$record;
      my $name = $rec{name};
      my $comment = $rec{comment};

!     checkValidFields([ "name" ], ["name", "comment"], $record);

      if ($action eq "remove")
***************
*** 169,174 ****
      else
      {
!       $stm = "insert into filetypes (name, extension, comment) " . 
!         "values ('$name', '$ext', '$comment');";
      }
      print "$stm\n" if $debug;
--- 169,174 ----
      else
      {
!       $stm = "insert into filetypes (name, comment) " . 
!         "values ('$name', '$comment');";
      }
      print "$stm\n" if $debug;
***************
*** 199,214 ****
  } # act_analysis   

  sub act_file_links
  {
!   my ($dbh, $table, $filelist, $name, $action) = @_;    

    my $stm = "";
    my $record;

!   $table = "analysis_ft_input_link" if $table eq "input";
!   $table = "analysis_ft_output_link" if $table eq "output";

    # select the analysis pk for the analysis
!   $stm = $dbh->prepare("select anal_pk from analysis where name = '$name'");
    $stm->execute();

--- 199,261 ----
  } # act_analysis   

+ sub act_extension
+ {
+   my ($dbh, $ext, $action) = @_;    
+ 
+   my $stm = "";
+   my $record;
+   my $table="extension";
+ 
+   my @records = parse_into_records(@$ext);
+ 
+   foreach $record (@records)
+   {
+     my %rec = %$record;
+ 
+     checkValidFields([ "filetype","ext" ], ["filetype", "ext"], $record);
+     
+     my $filetype = $rec{filetype};
+     my $ext = $rec{ext};
+ 
+     # select the filetypes pk for the filetype
+     $stm = $dbh->prepare("select ft_pk from filetypes where name= '$filetype'");
+     $stm->execute();
+ 
+     my $ft_fk = $stm->fetchrow_array();
+     if (!defined $ft_fk)
+     { 
+       warn "Unable to get filetypes key value for $filetype";
+     }
+     else
+     {
+         if ($action eq "remove")
+         {
+             $stm = "delete from $table where ft_fk = '$ft_fk'";
+         }
+         else
+         {
+             $stm = "insert into $table (ft_fk, extension) " . 
+                "values ('$ft_fk', '$ext');";
+         }
+         print "$stm\n" if $debug;
+         my $sth = $dbh->prepare( $stm ); 
+         $sth->execute();
+     }
+   }
+ } # act_file_links
+ 
+ 
  sub act_file_links
  {
!   my ($dbh, $filelist, $name, $action) = @_;    

    my $stm = "";
    my $record;
+   my $table="analysis_filetypes_link";

!   my @records = parse_into_records(@$filelist);

    # select the analysis pk for the analysis
!   $stm = $dbh->prepare("select an_pk from analysis where name = '$name'");
    $stm->execute();

***************
*** 221,229 ****
    }

!   foreach my $rec (@$filelist)
    {

      # select the filetypes pk for the filetype
!     $stm = $dbh->prepare("select ft_pk from filetypes where name = '$rec'");
      $stm->execute();

--- 268,282 ----
    }

!   foreach $record (@records)
    {
+     my %rec = %$record;
+ 
+     checkValidFields([ "filetype","input" ], ["filetype", "input"], $record);

+     my $filetype = $rec{filetype};
+     my $input = $rec{input};
+ 
      # select the filetypes pk for the filetype
!     $stm = $dbh->prepare("select ft_pk from filetypes where name= '$filetype'");
      $stm->execute();

***************
*** 231,235 ****
      if (!defined $ft_fk)
      { 
!       warn "Unable to get filetypes key value for $rec";
      }
      else
--- 284,288 ----
      if (!defined $ft_fk)
      { 
!       warn "Unable to get filetypes key value for $filetype";
      }
      else
***************
*** 237,246 ****
          if ($action eq "remove")
          {
!             $stm = "delete from $table where anal_fk = '$an_fk'";
          }
          else
          {
!             $stm = "insert into $table (anal_fk, ft_fk) " . 
!                "values ('$an_fk', '$ft_fk');";
          }
          print "$stm\n" if $debug;
--- 290,299 ----
          if ($action eq "remove")
          {
!             $stm = "delete from $table where an_fk = '$an_fk'";
          }
          else
          {
!             $stm = "insert into $table (an_fk, ft_fk, input) " . 
!                "values ('$an_fk', '$ft_fk', '$input');";
          }
          print "$stm\n" if $debug;
***************
*** 261,265 ****

    # select the analysis pk for the analysis
!   $stm = $dbh->prepare("select anal_pk from analysis where name = '$name'");
    $stm->execute();

--- 314,318 ----

    # select the analysis pk for the analysis
!   $stm = $dbh->prepare("select an_pk from analysis where name = '$name'");
    $stm->execute();

***************
*** 284,292 ****
      if ($action eq "remove")
      {
!       $stm = "delete from sys_parameter_names where anal_fk = '$an_fk'";
      }
      else
      {
!       $stm = "insert into sys_parameter_names (anal_fk, sp_name, sp_default) values ('$an_fk', '$name', $default);";
      }
      print "$stm\n" if $debug;
--- 337,345 ----
      if ($action eq "remove")
      {
!       $stm = "delete from sys_parameter_names where an_fk = '$an_fk'";
      }
      else
      {
!       $stm = "insert into sys_parameter_names (an_fk, sp_name, sp_default) values ('$an_fk', '$name', $default);";
      }
      print "$stm\n" if $debug;
***************
*** 308,312 ****

    # select the analysis pk for the analysis
!   $stm = $dbh->prepare("select anal_pk from analysis where name = '$name'");
    $stm->execute();

--- 361,365 ----

    # select the analysis pk for the analysis
!   $stm = $dbh->prepare("select an_pk from analysis where name = '$name'");
    $stm->execute();

***************
*** 334,342 ****
      if ($action eq "remove")
      {
!       $stm = "delete from user_parameter_names where anal_fk = '$an_fk'";
      }
      else
      {
!       $stm = "insert into user_parameter_names (anal_fk, up_name, up_display_name, up_type, up_default) values ('$an_fk', '$name', '$display_name', '$type', $default);";
      }
      print "$stm\n" if $debug;
--- 387,395 ----
      if ($action eq "remove")
      {
!       $stm = "delete from user_parameter_names where an_fk = '$an_fk'";
      }
      else
      {
!       $stm = "insert into user_parameter_names (an_fk, up_name, up_display_name, up_type, up_default) values ('$an_fk', '$name', '$display_name', '$type', $default);";
      }
      print "$stm\n" if $debug;
***************
*** 378,381 ****
  {
        print "Usage: \n";
!       print "./act_analysis.pl --configfile <filename>\n";
  } # usage
--- 431,435 ----
  {
        print "Usage: \n";
!       print "./act_analysis.pl --configfile <filename> --action <insert|remove>\n";
!       exit;
  } # usage

Update of /cvsroot/genex/genex-server/site/webtools/analysis
In directory usw-pr-cvs1:/tmp/cvs-serv20983

Added Files:
      Tag: Rel-1_0_1-branch
	qualityControl.cfg 
Log Message:
Initial draft

--- NEW FILE: qualityControl.cfg ---
## filetypes
filetype = name=qcin
filetype = comment=Input file for quality control
filetype = passin=--settings inputDataFile=

filetype = name=qcouttxt 
filetype = comment=Text output for quality control
filetype = passin=--settings outputTxt=

filetype = name=qcoutgph 
filetype = extension=pdf png jpg
filetype = comment=Graphic output for quality control

filetype = name=log
filetype = extension=txt
filetype = comment=Log file 

#extension
extension = filetype=qcin
extension = ext=txt

extension = filetype=qcouttxt
extension = ext=txt

extension = filetype=qcoutgph
extension = ext=pdf

extension = filetype=qcoutgph
extension = ext=png

extension = filetype=qcoutgph
extension = ext=jpg

# analysis
name = qualityControl
cmdstr = ./Rwrapper --kind qualityControl

#analysis_ft_input_link
inputfile = qcin

#analysis_ft_ouput_link
outputfile = qcouttxt
outputfile = qcoutgph

#user_parameter_names
up = name = graphFormat
up = display_name = File type of graphical output 
up = type=radio png pdf jpg
up = default=jpg

up = name=condLabels 
up = display_name=Labels for each of the conditions 
up = type=text

up = name=outputFile
up = display_name=Basename for analysis output files 
up = type=text
up = default=qcout

#sys_parameter_names
sp = name=conds

sp = name=inputDataFile

sp = name=fileURI

sp = name=path

Update of /cvsroot/genex/genex-server/site/webtools/analysis
In directory usw-pr-cvs1:/tmp/cvs-serv20463/analysis

Log Message:
Directory /cvsroot/genex/genex-server/site/webtools/analysis added to the repository
--> Using per-directory sticky tag `Rel-1_0_1-branch'

2002	Jan	Feb	Mar	Apr	May	Jun	Jul	Aug	Sep	Oct (267)	Nov (344)	Dec (119)
2003	Jan (23)	Feb (15)	Mar (16)	Apr (388)	May	Jun (4)	Jul	Aug	Sep (4)	Oct	Nov	Dec

genex-cvs-commit Mailing List for GeneX Gene Expression Database (Page 34)

genex-cvs-commit — CVS commit messages