Menu
▾
▴
genex-cvs-commit — CVS commit messages
You can subscribe to this list here.
| 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
|
|
From: <jas...@us...> - 2002-10-15 14:54:40
|
Update of /cvsroot/genex/genex-server/Genex/BlastHits In directory usw-pr-cvs1:/tmp/cvs-serv5861/Genex/BlastHits Modified Files: BlastHits.pm Log Message: new |
|
From: <jas...@us...> - 2002-10-15 14:52:58
|
Update of /cvsroot/genex/genex-server/Genex/XMLUtils
In directory usw-pr-cvs1:/tmp/cvs-serv5474/Genex/XMLUtils
Modified Files:
XMLUtils.pm.in
Log Message:
* XMLUtils/XMLUtils.pm.in (Repository):
xml2sql() now adds inherited columns to the views
Index: XMLUtils.pm.in
===================================================================
RCS file: /cvsroot/genex/genex-server/Genex/XMLUtils/XMLUtils.pm.in,v
retrieving revision 1.24
retrieving revision 1.25
diff -C2 -d -r1.24 -r1.25
*** XMLUtils.pm.in 11 Oct 2002 02:16:11 -0000 1.24
--- XMLUtils.pm.in 15 Oct 2002 14:52:55 -0000 1.25
***************
*** 538,543 ****
unless $table_name eq 'GroupLink';
}
my $columns = join(",\n", map {$table_name . '."' . $_->getAttribute('name'). '"'}
! @columns);
my $view = "$ {table_name}_view";
my $sql = <<SQL;
--- 538,547 ----
unless $table_name eq 'GroupLink';
}
+ my @inherited_columns;
+ if ($inherits_from ne 'none') {
+ @inherited_columns = $docs{$inherits_from}->getElementsByTagName('column');
+ }
my $columns = join(",\n", map {$table_name . '."' . $_->getAttribute('name'). '"'}
! @columns, @inherited_columns);
my $view = "$ {table_name}_view";
my $sql = <<SQL;
|
|
From: <jas...@us...> - 2002-10-15 14:51:37
|
Update of /cvsroot/genex/genex-server/Genex/FeatureExtractionSoftware
In directory usw-pr-cvs1:/tmp/cvs-serv4889/Genex/FeatureExtractionSoftware
Added Files:
FeatureExtractionSoftware.pm Makefile.PL
Log Message:
new
--- NEW FILE: FeatureExtractionSoftware.pm ---
##############################
#
# Bio::Genex::FeatureExtractionSoftware
#
##############################
package Bio::Genex::FeatureExtractionSoftware;
use strict;
use POSIX 'strftime';
use Carp;
use DBI;
use IO::File;
use Bio::Genex::Connect;
# import the fkey constants and undefined
use Bio::Genex qw(:ASSERT undefined error);
use Bio::Genex::Fkey qw(:FKEY);
use Class::ObjectTemplate::DB 0.27;
[...1115 lines suppressed...]
There exist other options such as C<Class::Struct> and
C<Class::MethodMaker> by Damian Conway which implement different forms
of automatic class creation.
=head1 BUGS
Please send bug reports to ge...@nc...
=head1 AUTHOR
Jason E. Stewart (je...@nc...)
=head1 SEE ALSO
perl(1).
=cut
1;
--- NEW FILE: Makefile.PL ---
sub MY::top_targets {
package MY; # so that "SUPER" works right
my $inherited = shift->SUPER::top_targets(@_);
$inherited =~ s/(man|html)ifypods//g;
$inherited;
}
WriteMakefile(
'NAME' => 'Bio::Genex::FeatureExtractionSoftware',
'SKIP' => [qw( test makeaperl manifypods htmlifypods xs_o static)],
'VERSION_FROM' => '../Genex.pm', # finds $VERSION
);
|
|
From: <jas...@us...> - 2002-10-15 14:51:08
|
Update of /cvsroot/genex/genex-server/Genex/MeasuredBioAssay
In directory usw-pr-cvs1:/tmp/cvs-serv4591/Genex/MeasuredBioAssay
Added Files:
Makefile.PL MeasuredBioAssay.pm
Log Message:
new
--- NEW FILE: Makefile.PL ---
sub MY::top_targets {
package MY; # so that "SUPER" works right
my $inherited = shift->SUPER::top_targets(@_);
$inherited =~ s/(man|html)ifypods//g;
$inherited;
}
WriteMakefile(
'NAME' => 'Bio::Genex::MeasuredBioAssay',
'SKIP' => [qw( test makeaperl manifypods htmlifypods xs_o static)],
'VERSION_FROM' => '../Genex.pm', # finds $VERSION
);
--- NEW FILE: MeasuredBioAssay.pm ---
##############################
#
# Bio::Genex::MeasuredBioAssay
#
##############################
package Bio::Genex::MeasuredBioAssay;
use strict;
use POSIX 'strftime';
use Carp;
use DBI;
use IO::File;
use Bio::Genex::Connect;
# import the fkey constants and undefined
use Bio::Genex qw(:ASSERT undefined error);
use Bio::Genex::Fkey qw(:FKEY);
use Class::ObjectTemplate::DB 0.27;
[...1137 lines suppressed...]
There exist other options such as C<Class::Struct> and
C<Class::MethodMaker> by Damian Conway which implement different forms
of automatic class creation.
=head1 BUGS
Please send bug reports to ge...@nc...
=head1 AUTHOR
Jason E. Stewart (je...@nc...)
=head1 SEE ALSO
perl(1).
=cut
1;
|
|
From: <jas...@us...> - 2002-10-15 14:50:32
|
Update of /cvsroot/genex/genex-server/Genex/QuantitationTypeDimension
In directory usw-pr-cvs1:/tmp/cvs-serv4181/Genex/QuantitationTypeDimension
Added Files:
Makefile.PL QuantitationTypeDimension.pm
Log Message:
new
--- NEW FILE: Makefile.PL ---
sub MY::top_targets {
package MY; # so that "SUPER" works right
my $inherited = shift->SUPER::top_targets(@_);
$inherited =~ s/(man|html)ifypods//g;
$inherited;
}
WriteMakefile(
'NAME' => 'Bio::Genex::QuantitationTypeDimension',
'SKIP' => [qw( test makeaperl manifypods htmlifypods xs_o static)],
'VERSION_FROM' => '../Genex.pm', # finds $VERSION
);
--- NEW FILE: QuantitationTypeDimension.pm ---
##############################
#
# Bio::Genex::QuantitationTypeDimension
#
##############################
package Bio::Genex::QuantitationTypeDimension;
use strict;
use POSIX 'strftime';
use Carp;
use DBI;
use IO::File;
use Bio::Genex::Connect;
# import the fkey constants and undefined
use Bio::Genex qw(:ASSERT undefined error);
use Bio::Genex::Fkey qw(:FKEY);
use Class::ObjectTemplate::DB 0.27;
[...1135 lines suppressed...]
There exist other options such as C<Class::Struct> and
C<Class::MethodMaker> by Damian Conway which implement different forms
of automatic class creation.
=head1 BUGS
Please send bug reports to ge...@nc...
=head1 AUTHOR
Jason E. Stewart (je...@nc...)
=head1 SEE ALSO
perl(1).
=cut
1;
|
|
From: <jas...@us...> - 2002-10-15 14:49:18
|
Update of /cvsroot/genex/genex-server/Genex/QuantitationTypeDimension In directory usw-pr-cvs1:/tmp/cvs-serv3589/Genex/QuantitationTypeDimension Log Message: Directory /cvsroot/genex/genex-server/Genex/QuantitationTypeDimension added to the repository |
|
From: <jas...@us...> - 2002-10-15 14:49:18
|
Update of /cvsroot/genex/genex-server/Genex/MeasuredBioAssay In directory usw-pr-cvs1:/tmp/cvs-serv3589/Genex/MeasuredBioAssay Log Message: Directory /cvsroot/genex/genex-server/Genex/MeasuredBioAssay added to the repository |
|
From: <jas...@us...> - 2002-10-15 14:49:18
|
Update of /cvsroot/genex/genex-server/Genex/FeatureExtractionSoftware In directory usw-pr-cvs1:/tmp/cvs-serv3589/Genex/FeatureExtractionSoftware Log Message: Directory /cvsroot/genex/genex-server/Genex/FeatureExtractionSoftware added to the repository |
|
From: <jas...@us...> - 2002-10-15 14:49:01
|
Update of /cvsroot/genex/genex-server/G2G/mason In directory usw-pr-cvs1:/tmp/cvs-serv3448/G2G/mason Modified Files: .cvsignore Log Message: usual Index: .cvsignore =================================================================== RCS file: /cvsroot/genex/genex-server/G2G/mason/.cvsignore,v retrieving revision 1.2 retrieving revision 1.3 diff -C2 -d -r1.2 -r1.3 *** .cvsignore 13 Oct 2002 05:54:30 -0000 1.2 --- .cvsignore 15 Oct 2002 14:48:58 -0000 1.3 *************** *** 2,4 **** --- 2,6 ---- autohandler data-sources.html + generate_user.html + query.html workspace.html |
|
From: <jas...@us...> - 2002-10-15 14:48:27
|
Update of /cvsroot/genex/genex-server/G2G/mason
In directory usw-pr-cvs1:/tmp/cvs-serv3225/G2G/mason
Modified Files:
index.html
Log Message:
added new links
Index: index.html
===================================================================
RCS file: /cvsroot/genex/genex-server/G2G/mason/index.html,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** index.html 13 Oct 2002 05:16:59 -0000 1.1
--- index.html 15 Oct 2002 14:48:24 -0000 1.2
***************
*** 10,13 ****
--- 10,14 ----
<li><a href="query.html">query.html</a></li>
<li><a href="workspace.html">workspace.html</a></li>
+ <li><a href="generate_user.html">generate_user.html</a></li>
</ul>
<%attr>
|
|
From: <jas...@us...> - 2002-10-15 14:48:07
|
Update of /cvsroot/genex/genex-server/DB/xml
In directory usw-pr-cvs1:/tmp/cvs-serv3074/DB/xml
Added Files:
FeatureExtractionSoftware.xml MeasuredBioAssay.xml
Log Message:
new
--- NEW FILE: FeatureExtractionSoftware.xml ---
<?xml version="1.0" standalone="no"?>
<!DOCTYPE table SYSTEM "../../DTD/table.dtd">
<table name="FeatureExtractionSoftware"
type="&data_table;"
inherits_from="Software"
comment=" The FeatureExtractionSoftware table holds information
specific to feature extraction software packages">
<column name="fesw_pk"
full_name="Accession Number"
type="serial"
comment=""/>
<column name="feature_identifier_string"
full_name="Feature Identifier String"
type="varchar(128)"
not_null="true"
comment="This string documents what columns in the data are used
to constructor the feature identifier"/>
<column name="qd_fk"
full_name="Quantitation Type Dimension"
not_null="true"
type="int4"
comment="The quantitation dimension that this software package
outputs its data as"/>
<foreign_key column_id="qd_fk"
foreign_table ="QuantitationTypeDimension"
foreign_table_pkey ="qd_pk"
fkey_type ="&fkey_oto;"/>
<primary_key column_id="fesw_pk"/>
</table>
--- NEW FILE: MeasuredBioAssay.xml ---
<?xml version="1.0" standalone="no"?>
<!DOCTYPE table SYSTEM "../../DTD/table.dtd">
<table name="MeasuredBioAssay"
type="&data_table;"
inherits_from="Identifiable"
comment="The MeasuredBioAssay table holds the meta-data
associated with a data matrix stored in a MeasuredBioAssayData
table">
<column name="mba_pk"
full_name="Accession Number"
type="serial"
comment=""/>
<column name="description"
full_name="Description"
type="text"
comment=" a more verbose description of the purpose of this
MeasuredBioAssay"/>
<column name="es_fk"
full_name="Primary Experiment Set"
type="int4"
not_null="true"
comment=" the primary experiment in which the MeasuredBioAssay
was taken (the ExperimentSet in which it was submitted)"/>
<foreign_key column_id="es_fk"
foreign_table ="ExperimentSet"
foreign_table_pkey ="es_pk"
fkey_type ="&fkey_mto;"/>
<column name="fesw_fk"
full_name="Feature Extraction Software"
type="int4"
not_null="true"
comment="The feature extraction software used to extract the
numerical data from the image"/>
<foreign_key column_id="fesw_fk"
foreign_table ="FeatureExtractionSoftware"
foreign_table_pkey ="fesw_pk"
fkey_type ="&fkey_oto;"/>
<primary_key column_id="mba_pk"/>
</table>
|
|
From: <jas...@us...> - 2002-10-15 14:47:42
|
Update of /cvsroot/genex/genex-server/DB/xml
In directory usw-pr-cvs1:/tmp/cvs-serv2692/DB/xml
Added Files:
QuantitationTypeDimension.xml
Log Message:
renamed QuantitationDimension => QuantitationTypeDimension
--- NEW FILE: QuantitationTypeDimension.xml ---
<?xml version="1.0" standalone="no"?>
<!DOCTYPE table SYSTEM "../../DTD/table.dtd">
<table name="QuantitationTypeDimension"
type="&data_table;"
inherits_from="Identifiable"
comment=" The QuantitationTypeDimension table stores
the ordered lists of QuantitationTypes that define the spot tables">
<column name="qd_pk"
full_name="Accession Number"
type="serial"
comment=""/>
<column name="data_table_name"
full_name="Data Table Name"
not_null="true"
type="varchar(128)"
comment="Every QuantitationTypeDimension stores its data in its own
unique data table"/>
<primary_key column_id="qd_pk"/>
</table>
|
|
From: <jas...@us...> - 2002-10-15 14:47:11
|
Update of /cvsroot/genex/genex-server/DB/xml
In directory usw-pr-cvs1:/tmp/cvs-serv2473/DB/xml
Modified Files:
QuantitationLink.xml
Log Message:
renamged QuantitationDimension => QuantitationTypeDimension
Index: QuantitationLink.xml
===================================================================
RCS file: /cvsroot/genex/genex-server/DB/xml/QuantitationLink.xml,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** QuantitationLink.xml 8 Apr 2002 04:45:39 -0000 1.1
--- QuantitationLink.xml 15 Oct 2002 14:47:08 -0000 1.2
***************
*** 4,8 ****
type="&linking_table;"
comment=" The QuantitationLink table stores the ordered list of
! QuantitationType's in each QuantitationDimension">
<column name="qt_fk"
full_name="Quantitation Type"
--- 4,8 ----
type="&linking_table;"
comment=" The QuantitationLink table stores the ordered list of
! QuantitationType's in each QuantitationTypeDimension">
<column name="qt_fk"
full_name="Quantitation Type"
***************
*** 20,24 ****
comment=""/>
<foreign_key column_id="qd_fk"
! foreign_table ="QuantitationDimension"
foreign_table_pkey ="qd_pk"
fkey_type ="&fkey_linking;"/>
--- 20,24 ----
comment=""/>
<foreign_key column_id="qd_fk"
! foreign_table ="QuantitationTypeDimension"
foreign_table_pkey ="qd_pk"
fkey_type ="&fkey_linking;"/>
***************
*** 28,32 ****
type="int4"
comment="Specifies the order that this QuantitationType appears in
! the QuantitationDimension"/>
<linking_keys link1="qt_fk"
link2="qd_fk"/>
--- 28,32 ----
type="int4"
comment="Specifies the order that this QuantitationType appears in
! the QuantitationTypeDimension"/>
<linking_keys link1="qt_fk"
link2="qd_fk"/>
|
|
From: <jas...@us...> - 2002-10-15 14:46:51
|
Update of /cvsroot/genex/genex-server/DB/xml
In directory usw-pr-cvs1:/tmp/cvs-serv2308/DB/xml
Modified Files:
QuantitationType.xml
Log Message:
* DB/xml/QuantitationType.xml (Repository):
added column_number column
renamged QuantitationDimension => QuantitationTypeDimension
Index: QuantitationType.xml
===================================================================
RCS file: /cvsroot/genex/genex-server/DB/xml/QuantitationType.xml,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** QuantitationType.xml 13 Apr 2002 23:10:28 -0000 1.3
--- QuantitationType.xml 15 Oct 2002 14:46:47 -0000 1.4
***************
*** 5,9 ****
inherits_from="Identifiable"
comment=" The QuantitationType table gives information about each
! Quantitation that is used in a QuantitationDimension">
<column name="qt_pk"
full_name="Accession Number"
--- 5,9 ----
inherits_from="Identifiable"
comment=" The QuantitationType table gives information about each
! Quantitation that is used in a QuantitationTypeDimension">
<column name="qt_pk"
full_name="Accession Number"
***************
*** 23,26 ****
--- 23,31 ----
type="varchar(128)"
comment="The data type associated with this QuantitationType"/>
+ <column name="column_number"
+ full_name="Column Number"
+ not_null="true"
+ type="int4"
+ comment="The input file column number from which this QT comes"/>
<column name="scale"
full_name="Scale"
|
|
From: <jas...@us...> - 2002-10-15 14:45:32
|
Update of /cvsroot/genex/genex-server
In directory usw-pr-cvs1:/tmp/cvs-serv1775
Modified Files:
db.pl
Log Message:
* db.pl (Repository):
fixed the setting of the genex email addr in DB
Index: db.pl
===================================================================
RCS file: /cvsroot/genex/genex-server/db.pl,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** db.pl 13 Oct 2002 07:26:17 -0000 1.3
--- db.pl 15 Oct 2002 14:45:28 -0000 1.4
***************
*** 9,12 ****
--- 9,13 ----
ask_pass
genex_system
+ check_sys
get_cache
);
***************
*** 233,263 ****
#
! eval qq[
! $VARS{GENEX_EXTRALIBS}
! require Bio::Genex;
! require Bio::Genex::Contact;
! require Bio::Genex::UserSec;
!
! # log in as super user
! my \$dbh = Bio::Genex::Connect->new(USER=>$VARS{GENEX_SU_USER},
! PASSWORD=>$SU_PASS);
! # first update the password
! my (\$genex) = Bio::Genex::UserSec->get_all_objects(\$dbh,column=>'login',
! value=>'genex');
! print STDERR "Couldn't find 'genex' account in DB"
! unless defined \$genex;
! # now update the contact email
! \$genex = \$genex->con_obj();
! print STDERR "Couldn't find '$VARS{GENEX_SU_USER}' contact in DB"
! unless defined \$genex;
! \$genex->contact_person_email('$VARS{CONTACT_EMAIL}');
! \$genex->update_db(\$dbh);
! print STDERR "\n\temail updated for '$VARS{GENEX_SU_USER}' account in DB\n\n";
! ];
! check_sys($@,$@,__LINE__,"Problems with changing genex account info")
! if $@;
exit(0);
--- 234,258 ----
#
! eval 'require Bio::Genex::Connect;
! require Bio::Genex::Contact;
! require Bio::Genex::UserSec;';
! # log in as super user
! my $dbh = Bio::Genex::Connect->new(USER=>$VARS{GENEX_SU_USER},
! PASSWORD=>$SU_PASS);
! # first update the password
! my ($genex) = Bio::Genex::UserSec->get_all_objects($dbh,column=>'username',
! value=>'genex');
! print STDERR "Couldn't find 'genex' account in DB"
! unless defined $genex;
! # now update the contact email
! $genex = $genex->con_obj();
! print STDERR "Couldn't find '$VARS{GENEX_SU_USER}' contact in DB"
! unless defined $genex;
! $genex->contact_person_email('$VARS{CONTACT_EMAIL}');
! $genex->update_db($dbh);
! print STDERR "\n\temail updated for '$VARS{GENEX_SU_USER}' account in DB\n\n";
exit(0);
|
|
From: <jas...@us...> - 2002-10-15 14:44:20
|
Update of /cvsroot/genex/genex-server/Genex/scripts
In directory usw-pr-cvs1:/tmp/cvs-serv1267/Genex/scripts
Modified Files:
.cvsignore array-design-insert.pl.in
array-measurement-insert.pl.in create-db-accounts.pl.in
create_genex_class.pl.in gendb.pl.in make_classes.pl
qtdim-insert.pl.in
Log Message:
updated for data loader
Index: .cvsignore
===================================================================
RCS file: /cvsroot/genex/genex-server/Genex/scripts/.cvsignore,v
retrieving revision 1.22
retrieving revision 1.23
diff -C2 -d -r1.22 -r1.23
*** .cvsignore 13 Oct 2002 08:37:09 -0000 1.22
--- .cvsignore 15 Oct 2002 14:44:16 -0000 1.23
***************
*** 18,21 ****
--- 18,22 ----
group-insert.pl
layout.pl
+ mbad-insert.pl
priveleges.pl
protocol-insert.pl
Index: array-design-insert.pl.in
===================================================================
RCS file: /cvsroot/genex/genex-server/Genex/scripts/array-design-insert.pl.in,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** array-design-insert.pl.in 11 Oct 2002 02:16:40 -0000 1.1
--- array-design-insert.pl.in 15 Oct 2002 14:44:16 -0000 1.2
***************
*** 85,88 ****
--- 85,92 ----
);
my @error_args = (caller=>$0);
+ $dbh->error(@error_args,
+ message=>"Couldn't connect to DB: $OPTIONS{dbname}, as user: $OPTIONS{username}, bad user,DB,password combo",
+ )
+ unless defined $dbh;
my ($CONTACT_GENEX) = Bio::Genex::Contact->get_all_objects($dbh,
Index: array-measurement-insert.pl.in
===================================================================
RCS file: /cvsroot/genex/genex-server/Genex/scripts/array-measurement-insert.pl.in,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** array-measurement-insert.pl.in 18 Sep 2002 21:11:44 -0000 1.3
--- array-measurement-insert.pl.in 15 Oct 2002 14:44:16 -0000 1.4
***************
*** 74,77 ****
--- 74,81 ----
);
my @error_args = (caller=>$0);
+ $dbh->error(@error_args,
+ message=>"Couldn't connect to DB: $OPTIONS{dbname}, as user: $OPTIONS{username}, bad user,DB,password combo",
+ )
+ unless defined $dbh;
my @exp_list = $DOC->getElementsByTagName('experiment_set');
Index: create-db-accounts.pl.in
===================================================================
RCS file: /cvsroot/genex/genex-server/Genex/scripts/create-db-accounts.pl.in,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** create-db-accounts.pl.in 11 Oct 2002 02:18:23 -0000 1.6
--- create-db-accounts.pl.in 15 Oct 2002 14:44:16 -0000 1.7
***************
*** 69,72 ****
--- 69,77 ----
TRANSACTION=>1
);
+ my @error_args = (caller=>$0);
+ $dbh->error(@error_args,
+ message=>"Couldn't connect to DB: $OPTIONS{dbname}, as user: $OPTIONS{username}, bad user,DB,password combo",
+ )
+ unless defined $dbh;
# first we create the DB user accounts
***************
*** 90,94 ****
my @inserted;
my @tables_affected;
- my @error_args = (caller=>$0);
# insert the GroupSec entries, and they will insert the users and contacts
--- 95,98 ----
Index: create_genex_class.pl.in
===================================================================
RCS file: /cvsroot/genex/genex-server/Genex/scripts/create_genex_class.pl.in,v
retrieving revision 1.15
retrieving revision 1.16
diff -C2 -d -r1.15 -r1.16
*** create_genex_class.pl.in 11 Oct 2002 02:20:59 -0000 1.15
--- create_genex_class.pl.in 15 Oct 2002 14:44:16 -0000 1.16
***************
*** 97,101 ****
$parser->setValidationScheme($XML::Xerces::Val_Always);
! find_fkeys();
########################################
--- 97,114 ----
$parser->setValidationScheme($XML::Xerces::Val_Always);
! print STDERR "Using target: $target";
! if (scalar @support) {
! print STDERR ", with supporting tables: \n";
! foreach (@support) {
! print STDERR " $_\n";
! }
! } else {
! print STDERR ", no supporting tables\n";
! }
!
! foreach $module_name ($target,@support) {
! $FILES{$module_name} = get_document_from_module($module_name);
! }
! find_fkeys(%FILES);
########################################
***************
*** 162,165 ****
--- 175,182 ----
}
+ # add grandparent fkeys to fkey list
+ # foreach my $parent_doc (@grandparents) {
+ # find_fkeys($target=>$parent_doc);
+ # }
# @link_fkeys holds the two linking fkey objects
***************
*** 1321,1328 ****
if (defined $PKEY) {
if ($SERIAL_PKEY) {
# section with variable expansion *enabled*
$HANDLE_PKEY = <<"EOT";
# pre-fetch the next value of the sequence
! my \$seq = "$ {module_name_lc}_$ {PKEY}_seq";
\$sql = "SELECT nextval('\$seq'::text)";
my \$pkey = \$dbh->selectall_arrayref(\$sql)
--- 1338,1349 ----
if (defined $PKEY) {
if ($SERIAL_PKEY) {
+ # Postgres sequence names get truncated to 32 characters
+ my $suffix = "_$ {PKEY}_seq";
+ my $seq_name = substr($module_name_lc, 0, 31 - length($suffix));
+ $seq_name .= $suffix;
# section with variable expansion *enabled*
$HANDLE_PKEY = <<"EOT";
# pre-fetch the next value of the sequence
! my \$seq = '$seq_name';
\$sql = "SELECT nextval('\$seq'::text)";
my \$pkey = \$dbh->selectall_arrayref(\$sql)
***************
*** 2753,2784 ****
die "couldn't open $file for input"
unless -f $file;
! eval {
! $parser->parse($file);
! };
! if ($@) {
! if (ref $@) {
! die $@->getMessage();
! } else {
! die $@;
! }
! }
return $parser->getDocument();
}
sub find_fkeys {
! print STDERR "Using target: $target";
! if (scalar @support) {
! print STDERR ", with supporting tables: \n";
! foreach (@support) {
! print STDERR " $_\n";
! }
! } else {
! print STDERR ", no supporting tables\n";
! }
!
my $file;
- foreach $module_name ($target, @support) {
- $FILES{$module_name} = get_document_from_module($module_name);
- }
########################################
--- 2774,2786 ----
die "couldn't open $file for input"
unless -f $file;
! eval {$parser->parse($file)};
! XML::Xerces::error ($@)
! if $@;
return $parser->getDocument();
}
sub find_fkeys {
! my (%docs) = @_;
my $file;
########################################
***************
*** 2786,2792 ****
# Next, go through the table files and find all foreign keys
#
! foreach my $file_name (keys %FILES) {
# get the document element
! my $doc = $FILES{$file_name};
foreach my $fkey_node ($doc->getElementsByTagName('foreign_key')) {
my %attributes = $fkey_node->getAttributes();
--- 2788,2794 ----
# Next, go through the table files and find all foreign keys
#
! foreach my $file_name (keys %docs) {
# get the document element
! my $doc = $docs{$file_name};
foreach my $fkey_node ($doc->getElementsByTagName('foreign_key')) {
my %attributes = $fkey_node->getAttributes();
Index: gendb.pl.in
===================================================================
RCS file: /cvsroot/genex/genex-server/Genex/scripts/gendb.pl.in,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -d -r1.4 -r1.5
*** gendb.pl.in 11 Oct 2002 02:18:23 -0000 1.4
--- gendb.pl.in 15 Oct 2002 14:44:17 -0000 1.5
***************
*** 25,28 ****
--- 25,29 ----
'no_cv',
'no_spotter',
+ 'no_qtdim',
'no_ecoli_sf',
'no_scanner',
***************
*** 46,49 ****
--- 47,51 ----
--no_cv : do not regenerate the controlled vocabularies
--no_spotter : do not regenerate the spotter entries
+ --no_qtdim : do not regenerate the QT Dimension entry
--no_scanner : do not regenerate the scanner entries
--no_software : do not regenerate the software entries
***************
*** 77,84 ****
$cmd = "$OPTIONS{dir}/Genex/scripts/create_genex_db.pl";
! # fix an annoyance with bash's globbing and locale
! my @files = glob("$OPTIONS{dir}/DB/xml/[A-E]*.xml");
! push @files, glob("$OPTIONS{dir}/DB/xml/F*.xml");
! push @files, glob("$OPTIONS{dir}/DB/xml/[G-Z]*.xml");
my @params = ('--functions'=>"$OPTIONS{dir}/DB/xml/functions-sql.xml",
@files);
--- 79,83 ----
$cmd = "$OPTIONS{dir}/Genex/scripts/create_genex_db.pl";
! my @files = glob("$OPTIONS{dir}/DB/xml/[A-Z]*.xml");
my @params = ('--functions'=>"$OPTIONS{dir}/DB/xml/functions-sql.xml",
@files);
***************
*** 187,189 ****
--- 186,205 ----
print STDERR "Finished\n";
}
+
+ unless (exists $OPTIONS{no_qtdim}) {
+ $cmd = "$SCRIPTS_DIR/qtdim-insert.pl";
+ my @params = ("$OPTIONS{dir}/DB/curated_data/quantarray.xml",
+ '--name=QuantArray',
+ '--version=3.0',
+ '--feat="1.2.3.4"'
+ );
+ print STDERR "Adding example QuantitationTypeDimension ...\n";
+ printf STDERR "\t$cmd %s\n", join(' ', @args, @params);
+
+ system($cmd, @args, @params);
+ die $! if $?;
+
+ print STDERR "Finished\n";
+ }
+
Index: make_classes.pl
===================================================================
RCS file: /cvsroot/genex/genex-server/Genex/scripts/make_classes.pl,v
retrieving revision 1.26
retrieving revision 1.27
diff -C2 -d -r1.26 -r1.27
*** make_classes.pl 11 Oct 2002 02:21:22 -0000 1.26
--- make_classes.pl 15 Oct 2002 14:44:17 -0000 1.27
***************
*** 57,66 ****
{target=>'ExperimentSet',
support=>['PhysicalBioAssay',
'HotSpots',
'TreatmentLevel',
'ExperimentFactors']},
{target=>'PhysicalBioAssay',
! support=>['AM_Spots',
! 'AM_FactorValues',
'SampleLink',
'Treatment_AMs']},
--- 57,66 ----
{target=>'ExperimentSet',
support=>['PhysicalBioAssay',
+ 'MeasuredBioAssay',
'HotSpots',
'TreatmentLevel',
'ExperimentFactors']},
{target=>'PhysicalBioAssay',
! support=>['AM_FactorValues',
'SampleLink',
'Treatment_AMs']},
***************
*** 89,93 ****
support=>['QuantitationLink']
},
! {target=>'QuantitationDimension',
support=>['QuantitationLink']
},
--- 89,93 ----
support=>['QuantitationLink']
},
! {target=>'QuantitationTypeDimension',
support=>['QuantitationLink']
},
***************
*** 96,102 ****
# simple classes with no supporting tables
{target=>'Array'},
{target=>'Channel'},
{target=>'Audit'},
! {target=>'FeatureExtraction'},
{target=>'Identifiable'},
{target=>'Feature'},
--- 96,103 ----
# simple classes with no supporting tables
{target=>'Array'},
+ {target=>'MeasuredBioAssay'},
{target=>'Channel'},
{target=>'Audit'},
! {target=>'FeatureExtractionSoftware'},
{target=>'Identifiable'},
{target=>'Feature'},
Index: qtdim-insert.pl.in
===================================================================
RCS file: /cvsroot/genex/genex-server/Genex/scripts/qtdim-insert.pl.in,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** qtdim-insert.pl.in 18 Sep 2002 20:59:20 -0000 1.1
--- qtdim-insert.pl.in 15 Oct 2002 14:44:17 -0000 1.2
***************
*** 10,15 ****
use strict;
! use lib '/home/jasons/mged/omg/MAGE-Perl/blib/lib';
! use blib;
use Carp;
use Bio::MAGE::XMLUtils;
--- 10,14 ----
use strict;
! # use blib;
use Carp;
use Bio::MAGE::XMLUtils;
***************
*** 17,21 ****
use Bio::Genex qw(error);
use Bio::Genex::Connect;
! use Bio::Genex::QuantitationDimension;
use Bio::Genex::QuantitationType;
use Bio::Genex::Channel;
--- 16,21 ----
use Bio::Genex qw(error);
use Bio::Genex::Connect;
! use Bio::Genex::FeatureExtractionSoftware;
! use Bio::Genex::QuantitationTypeDimension;
use Bio::Genex::QuantitationType;
use Bio::Genex::Channel;
***************
*** 32,38 ****
--username=name : the DB username to login as
--password=word : the DB password to login with
! --dbname=name : the name of the DB to use
optional parameters:
--verbose=n Print out lots of diagnostic info if 1 and more if 2
--debug does a rollback instead of a commit
--- 32,43 ----
--username=name : the DB username to login as
--password=word : the DB password to login with
! --name=name : the name of the FeatureExtraction SW program
! --version=num : the version of the FeatureExtraction SW program
! --feature_identifier_string=string
! : the string that defines how which columns to use
! to create a feature identifier from the input
optional parameters:
+ --dbname=name : the name of the DB to use
--verbose=n Print out lots of diagnostic info if 1 and more if 2
--debug does a rollback instead of a commit
***************
*** 42,49 ****
--- 47,58 ----
my %OPTIONS;
+ $OPTIONS{dbname} = $Bio::Genex::Connect::DBNAME;
my $rc = GetOptions(\%OPTIONS,
'help',
'dbname=s',
+ 'feature_identifier_string=s',
'username=s',
+ 'name=s',
+ 'version=s',
'debug',
'password=s',
***************
*** 54,59 ****
die "$USAGE" if $OPTIONS{help};
- die "Must specify --dbname\n$USAGE"
- unless defined $OPTIONS{dbname};
die "Must specify --username\n$USAGE"
unless exists $OPTIONS{username};
--- 63,66 ----
***************
*** 61,64 ****
--- 68,79 ----
unless exists $OPTIONS{password};
+ # required for FeatureExtractionSoftware
+ die "Must specify --name\n$USAGE"
+ unless exists $OPTIONS{name};
+ die "Must specify --version\n$USAGE"
+ unless exists $OPTIONS{version};
+ die "Must specify --feature_identifier_string\n$USAGE"
+ unless exists $OPTIONS{feature_identifier_string};
+
my $reader = Bio::MAGE::XMLReader->new();
***************
*** 122,125 ****
--- 137,146 ----
tie %qts, 'Tie::IxHash';
+ # define the feature identifier
+ $qts{feature_fk} = 'char24';
+
+ # define the MeasuredBioAssay fkey
+ $qts{mba_fk} = 'int';
+
# ensure we have the necessary pieces
check_attributes($dbh,$mage_dim,qw(name identifier));
***************
*** 134,138 ****
# create the name for the new data table
! $table = 'MeasuredBioAssayData_' . $mage_dim->getName();
my @args = (ro_groupname=>$ro_groupname,
rw_groupname=>$rw_groupname,
--- 155,162 ----
# create the name for the new data table
! my $name = $mage_dim->getName();
! $name =~ tr/-./__/;
! $mage_dim->setName($name);
! $table = 'Data_' . $mage_dim->getName();
my @args = (ro_groupname=>$ro_groupname,
rw_groupname=>$rw_groupname,
***************
*** 141,145 ****
data_table_name=>$table,
);
! my $qtdim_db = Bio::Genex::QuantitationDimension->new(@args);
# extract the QuantitationType's from the dimension
--- 165,169 ----
data_table_name=>$table,
);
! my $qtdim_db = Bio::Genex::QuantitationTypeDimension->new(@args);
# extract the QuantitationType's from the dimension
***************
*** 151,167 ****
# ensure that we have a single feature identifier QT
! my @ids = grep {$_->getName() =~ /FeatureIdentifier/} @mage_qts;
! $dbh->error(@error_args,
! no_errstr=>1,
! message=>"Found no FeatureIdentifier's")
! unless scalar @ids;
!
! $dbh->error(@error_args,
! no_errstr=>1,
! message=>"Must have a single FeatureIdentifier")
! if scalar @ids > 1;
!
! # reset the name to be what Genex wants
! $ids[0]->setName('feature_fk');
my $i;
--- 175,191 ----
# ensure that we have a single feature identifier QT
! # my @ids = grep {$_->getName() =~ /FeatureIdentifier/} @mage_qts;
! # $dbh->error(@error_args,
! # no_errstr=>1,
! # message=>"Found no FeatureIdentifier's")
! # unless scalar @ids;
! #
! # $dbh->error(@error_args,
! # no_errstr=>1,
! # message=>"Must have a single FeatureIdentifier")
! # if scalar @ids > 1;
! #
! # # reset the name to be what Genex wants
! # $ids[0]->setName('feature_fk');
my $i;
***************
*** 183,186 ****
--- 207,223 ----
# ensure we have the necessary pieces
+ my $array_ref = $mage_qt->getPropertySets();
+ $dbh->error(@error_args,
+ message=>"Must defined 'Genex:column' NVT for each QT",
+ )
+ unless defined $array_ref;
+
+ my @nvts = @{$array_ref};
+ foreach my $mage_nvt (@nvts) {
+ $qt_db->column_number($mage_nvt->getValue())
+ if $mage_nvt->getName() == 'Genex:column';
+ }
+
+ # ensure we have the necessary pieces
my $mage_scale = $mage_qt->getScale();
check_attributes($dbh,$mage_scale,qw(value));
***************
*** 220,224 ****
}
$qtdim_db->quantitationlink_obj(\@qt_dbs);
! $qtdim_db->insert_db($dbh);
--- 257,287 ----
}
$qtdim_db->quantitationlink_obj(\@qt_dbs);
! my ($genex_con_db) = Bio::Genex::Contact->get_all_objects($dbh,
! column=>'contact_person',
! value=>'genex',
! );
! $dbh->error(@error_args,
! message=>"Couldn't get genex contact from DB",
! )
! unless defined $genex_con_db;
!
! my @args = (version=>$OPTIONS{version},
! name=>$OPTIONS{name},
! producer_con_obj=>$genex_con_db,
! type=>'feature_extraction',
! ro_groupname=>$ro_groupname,
! rw_groupname=>$rw_groupname,
! qd_obj=>$qtdim_db,
! feature_identifier_string=>$OPTIONS{feature_identifier_string},
! );
!
! my $feat_extr_db = Bio::Genex::FeatureExtractionSoftware->new(@args);
!
! # insert everything
! my $fe_sw_pk = $feat_extr_db->insert_db($dbh);
! $dbh->error(@error_args,
! message=>"Couldn't insert FeatureExtractionSoftware into DB"
! )
! unless $fe_sw_pk;
|
|
From: <jas...@us...> - 2002-10-15 14:43:41
|
Update of /cvsroot/genex/genex-server/Genex/scripts
In directory usw-pr-cvs1:/tmp/cvs-serv981/Genex/scripts
Added Files:
mbad-insert.pl.in
Log Message:
new
--- NEW FILE: mbad-insert.pl.in ---
%%START_PERL%%
#
# mbad-insert.pl.in
# script for inserting MeasuredBioAssayData into genex DB
#
# author: Jason E. Stewart (ja...@op...)
# Copyright 2002 Jason E. Stewart
#
my $VERSION = '$Id: mbad-insert.pl.in,v 1.1 2002/10/15 14:43:39 jason_e_stewart Exp $ ';
use strict;
use blib;
use Carp;
use Getopt::Long;
use Bio::Genex qw(error);
use Bio::Genex::Connect;
use Bio::Genex::FeatureExtractionSoftware;
use Bio::Genex::ExperimentSet;
use Bio::Genex::ArrayDesign;
use Bio::Genex::MeasuredBioAssay;
###############################################################################
# Read and validate command line args
###############################################################################
#### define usage banner
my $USAGE = <<EOU;
USAGE: $0 [OPTIONS] file1 ...
Options:
--username=name : the DB username to login as
--password=word : the DB password to login with
--es_pk=pk : the primary key of the ExperimentSet
--ad_pk=pk : the primary key of the ArrayDesign
--fe_sw_pk=pk : the primary key of the FeatureExtraction SW
--end_regexp=string : regular expression to match end of data
--data_start_regexp=string : regexp matching start of data section
--reading_data_regexp=string : regexp matching data line before first
data line
optional parameters:
--dbname=name : the name of the DB to use
--debug does a rollback instead of a commit
--help print this message
EOU
my %OPTIONS;
$OPTIONS{dbname} = $Bio::Genex::Connect::DBNAME;
$OPTIONS{rw_groupname} = 'superuser';
$OPTIONS{ro_groupname} = 'public';
my $rc = GetOptions(\%OPTIONS,
'help',
'dbname=s',
'ro_groupname=s',
'rw_groupname=s',
'es_pk=s',
'fe_sw_pk=s',
'username=s',
'ad_pk=s',
'debug',
'password=s',
'end_regexp=s',
'data_start_regexp=s',
'reading_data_regexp=s',
);
die "$USAGE" unless $rc;
die "$USAGE" if $OPTIONS{help};
die "Must specify --username\n$USAGE"
unless exists $OPTIONS{username};
die "Must specify --password\n$USAGE"
unless exists $OPTIONS{password};
die "Must specify --fe_sw_pk\n$USAGE"
unless exists $OPTIONS{fe_sw_pk};
die "Must specify --ad_pk\n$USAGE"
unless exists $OPTIONS{ad_pk};
die "Must specify --es_pk\n$USAGE"
unless exists $OPTIONS{es_pk};
die "Must specify --end_regexp\n$USAGE"
unless exists $OPTIONS{end_regexp};
die "Must specify --data_start_regexp\n$USAGE"
unless exists $OPTIONS{data_start_regexp};
die "Must specify --reading_data_regexp\n$USAGE"
unless exists $OPTIONS{reading_data_regexp};
# open up a writeable connection
my $dbh = Bio::Genex::Connect->new(DBNAME=>$OPTIONS{dbname},
USER => $OPTIONS{username},
PASSWORD => $OPTIONS{password},
TRANSACTION => 1,
);
my @error_args = (caller=>$0);
my @args = ($dbh,
$OPTIONS{fe_sw_pk},
);
my ($fe_sw_db) = Bio::Genex::FeatureExtractionSoftware->get_objects(@args);
$dbh->error(@error_args,
message=>"Couldn't get FeatureExtractionSoftware: $OPTIONS{fe_sw_pk} from DB",
)
unless defined $fe_sw_db;
print STDERR "Using FeatureExtractionSoftware: ", $fe_sw_db->name(), "\n";
@args = ($dbh,
$OPTIONS{es_pk},
);
my ($es_db) = Bio::Genex::ExperimentSet->get_objects(@args);
$dbh->error(@error_args,
message=>"Couldn't get ExperimentSet: $OPTIONS{es_pk} from DB",
)
unless defined $es_db;
print STDERR "Using ExperimentSet: ", $es_db->name(), "\n";
my $feature_id_string = $fe_sw_db->feature_identifier_string();
$feature_id_string =~ s/(\d+)/\$data[$1]/g;
print STDERR "Using feature_id_string: $feature_id_string\n" if $OPTIONS{debug};
my $qt_dim_db = $fe_sw_db->qd_obj();
print STDERR "Using QuantitationTypeDimension: ", $qt_dim_db->identifier, "\n" if $OPTIONS{debug};
my $data_table = $qt_dim_db->data_table_name();
print STDERR "Using data table: $data_table\n" if $OPTIONS{debug};
my @qts = @{$qt_dim_db->quantitationlink_obj};
$dbh->error(@error_args,
message=>"no quantitation types for QuantitationTypeDimension: "
. $qt_dim_db->identifier,
)
unless scalar @qts;
print STDERR "Found ", scalar @qts, " QuantiationTypes\n" if $OPTIONS{debug};
# sort the qts
@qts = map {$_->[1]->qt_obj}
sort {$a->[0] <=> $b->[0]}
map {[$_->order,$_]} @qts;
my @col_nums = map {$_->column_number} @qts;
my @col_names = map {$_->name} @qts;
my $data_string = join(',', @col_nums);
$data_string =~ s/(\d+)/\$data[$1]/g;
print STDERR "Using data string: $data_string\n" if $OPTIONS{debug};
my @extra_cols = qw(feature_fk mba_fk);
my $name_string = '"' . join('","', @extra_cols,@col_names) . '"';
print STDERR "Using name string: $name_string\n" if $OPTIONS{debug};
my $placeholder_string = join ',', map {'?'} @extra_cols, @col_names;
my $insert_sql = "INSERT INTO $data_table ($name_string) VALUES($placeholder_string)";
print "Using insert sql = <$insert_sql>\n";
my $insert_sth = $dbh->prepare($insert_sql);
$dbh->error(@error_args,
sql=>$insert_sql,
message=>"Couldn't prepare insert SQL",
)
if $dbh->err;
@args = ($dbh,
$OPTIONS{ad_pk},
);
my ($ad_db) = Bio::Genex::ArrayDesign->get_objects(@args);
$dbh->error(@error_args,
message=>"Couldn't get ArrayDesign: $OPTIONS{ad_pk} from DB",
)
unless defined $ad_db;
print STDERR "Using ArrayDesign: ", $ad_db->name(), "\n";
# pre-fetch feature_identifiers and pkeys
my $sql = $dbh->create_select_sql(COLUMNS=>['feature_identifier','feature_pk'],
FROM=>['Feature'],
WHERE=>"ad_fk=$OPTIONS{ad_pk}"
);
my $feature_ref = $dbh->selectall_arrayref($sql);
$dbh->error(@error_args,
message=>"Couldn't prefetch features",
sql=>$sql
)
if $dbh->err;
my ($ro_group) = Bio::Genex::GroupSec->get_all_objects($dbh,
column=>'name',
value=>$OPTIONS{ro_groupname},
);
$dbh->error(@error_args,
no_errstr=>1,
message=>"Couldn't locate $OPTIONS{ro_groupname} group")
unless defined $ro_group;
my ($rw_group) = Bio::Genex::GroupSec->get_all_objects($dbh,
column=>'name',
value=>$OPTIONS{rw_groupname}
);
$dbh->error(@error_args,
no_errstr=>1,
message=>"Couldn't locate $OPTIONS{rw_groupname} group")
unless defined $rw_group;
my %features;
foreach my $array_ref (@{$feature_ref}) {
$features{$array_ref->[0]} = $array_ref->[1];
}
print STDERR "Found ", scalar keys %features, " features\n" if $OPTIONS{debug};
my $data_start_regexp = qr/$OPTIONS{data_start_regexp}/o;
my $reading_data_regexp = qr/$OPTIONS{reading_data_regexp}/o;
my $end_regexp = qr/$OPTIONS{end_regexp}/o;
my $in_data;
my $reading_data;
my $count;
#### Verify that the input file exists
my $file = $ARGV[0] or die "No input files\n$USAGE";
foreach $file (@ARGV) {
open(IN,$file)
or $dbh->error(@error_args,
no_errstr=>1,
message=>"Couldn't open $file for reading"
);
# set the name of the MBA to be the filename (minus the path)
my $name = $file;
$name =~ s|.*/||;
my @args = (name=>$name,
ro_groupname_obj=>$ro_group,
rw_groupname_obj=>$rw_group,
fesw_obj=>$fe_sw_db,
es_obj=>$es_db,
);
my $mba_db = Bio::Genex::MeasuredBioAssay->new(@args);
my $mba_pk = $mba_db->insert_db($dbh);
$dbh->error(@error_args,
message=>"Couldn't insert MeasuredBioAssay: $name")
unless defined $mba_pk;
while (<IN>) {
# see if we've found the Data section already
next unless $in_data or /$data_start_regexp/;
if (/$data_start_regexp/) {
$in_data = 1;
next;
}
# don't proceed unless we've past the Data section header line
next unless $reading_data or /$reading_data_regexp/;
# check if this is the header line of the Data section
if (/$reading_data_regexp/) {
$reading_data = 1;
next;
}
# when we reach the end of the Data section, we're done
last if /$end_regexp/;
$count++;
print STDERR "Handled $count\n" if $count % 1000 == 0;
my @data = split "\t";
my $id = eval qq["$feature_id_string"];
print STDERR "Found id: <$id>\n" if $OPTIONS{debug};
print STDERR "Found feature: <$features{$id}>\n" if $OPTIONS{debug};
my @vals = eval qq[($data_string)];
print STDERR "Found vals: <@vals>\n" if $OPTIONS{debug};
$insert_sth->execute($features{$id}, $mba_pk, @vals);
$dbh->error(@error_args,
message=>"Couldn't execute insert SQL",
sth=>$insert_sth,
)
if $dbh->err;
}
}
$insert_sth->finish();
print STDERR "Found $count data lines\n" if $OPTIONS{debug};
print STDERR "Finished\n";
if ($OPTIONS{debug}) {
$dbh->rollback();
} else {
$dbh->commit();
}
$dbh->disconnect();
exit(0);
|
|
From: <jas...@us...> - 2002-10-15 14:43:01
|
Update of /cvsroot/genex/genex-server/Genex/t
In directory usw-pr-cvs1:/tmp/cvs-serv680/Genex/t
Added Files:
FeatureExtractionSoftware.t MeasuredBioAssay.t
QuantitationTypeDimension.t
Log Message:
new modules
--- NEW FILE: FeatureExtractionSoftware.t ---
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl FeatureExtractionSoftware.t'
######################### We start with some black magic to print on failure.
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
BEGIN { $| = 1; print "1..21\n"; }
END {print "not ok 1\n" unless $loaded;}
use Carp;
use lib 't';
# use blib;
use TestDB qw(result);
use vars qw($i $loaded);
use Bio::Genex::FeatureExtractionSoftware;
use Bio::Genex qw(is_object);
use Bio::Genex::Fkey qw(:FKEY);
$loaded = 1;
$i = 1;
result($i);
######################### End of black magic.
# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
my $obj = Bio::Genex::FeatureExtractionSoftware->new();
# testing the qd_fk attribute method
$obj->qd_fk(555);
result ($obj->qd_fk() == 555);
# testing the qd_obj attribute method
$obj->qd_obj(555);
result ($obj->qd_obj() == 555);
# testing the fetched attribute method
$obj->fetched(555);
result ($obj->fetched() == 555);
# testing the fetch_all attribute method
$obj->fetch_all(555);
result ($obj->fetch_all() == 555);
# testing the fetched_attr attribute method
$obj->fetched_attr(555);
result ($obj->fetched_attr() == 555);
# testing the id attribute method
$obj->id(555);
result ($obj->id() == 555);
# testing the dbh attribute method
$obj->dbh(555);
result ($obj->dbh() == 555);
# testing the pkey_name method
result($obj->pkey_name() eq 'sw_pk');
# testing the tablename method
result($obj->tablename() eq q[FeatureExtractionSoftware]);
# testing the table_type method
result($obj->table_type() eq q[DATA]);
# test $LIMIT
result(!defined $Bio::Genex::FeatureExtractionSoftware::LIMIT);
# test $USE_CACHE
result(defined $Bio::Genex::FeatureExtractionSoftware::USE_CACHE);
# testing the column2name method
result(ref($obj->column2name) eq 'HASH' and
scalar keys %{$obj->column2name} >=
scalar keys %{$Bio::Genex::FeatureExtractionSoftware::COLUMN2NAME});
# testing the name2column method
result(ref($obj->name2column) eq 'HASH' and
scalar keys %{$obj->name2column} >=
scalar keys %{$Bio::Genex::FeatureExtractionSoftware::NAME2COLUMN});
# testing the fkeys method
result(ref($obj->fkeys) eq 'HASH' and
scalar keys %{$obj->fkeys} >=
scalar keys %{$Bio::Genex::FeatureExtractionSoftware::FKEYS});
# testing the fkey_obj2raw method
result(ref($obj->fkey_obj2raw) eq 'HASH' and
scalar keys %{$obj->fkey_obj2raw} >=
scalar keys %{$Bio::Genex::FeatureExtractionSoftware::FKEY_OBJ2RAW});
# testing each fkey
foreach my $fkey (values %{$Bio::Genex::FeatureExtractionSoftware::FKEYS}) {
result($fkey->isa('Bio::Genex::Fkey')
&& $fkey->fkey_name()
&& $fkey->pkey_name()
&& $fkey->table_name()
&& grep {$fkey->fkey_type eq $_}
(FKEY_OTM,
FKEY_OTM_LT,
FKEY_OTM_LINK,
FKEY_LINK,
FKEY_OTO,
FKEY_LT,
FKEY_MTO,
FKEY_OTM_OO,
FKEY_OTM_LT_OO,
FKEY_OTM_LINK_OO,
FKEY_LINK_OO,
FKEY_OTO_OO,
FKEY_LT_OO,
FKEY_MTO_OO,
));
}
# testing superclass Bio::Genex::Software
result($obj->isa(q[Bio::Genex::Software]));
# testing the column_names method
result(ref($obj->column_names) eq 'ARRAY' and
scalar @{$obj->column_names} >=
scalar @{$Bio::Genex::FeatureExtractionSoftware::COLUMN_NAMES});
# testing the unique_columns method
result(ref($obj->unique_columns) eq 'ARRAY' and
scalar @{$obj->unique_columns} >=
scalar @{$Bio::Genex::FeatureExtractionSoftware::UNIQUE_COLUMNS});
--- NEW FILE: MeasuredBioAssay.t ---
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl MeasuredBioAssay.t'
######################### We start with some black magic to print on failure.
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
BEGIN { $| = 1; print "1..26\n"; }
END {print "not ok 1\n" unless $loaded;}
use Carp;
use lib 't';
# use blib;
use TestDB qw(result);
use vars qw($i $loaded);
use Bio::Genex::MeasuredBioAssay;
use Bio::Genex qw(is_object);
use Bio::Genex::Fkey qw(:FKEY);
$loaded = 1;
$i = 1;
result($i);
######################### End of black magic.
# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
my $obj = Bio::Genex::MeasuredBioAssay->new();
# testing the mba_pk attribute method
$obj->mba_pk(555);
result ($obj->mba_pk() == 555);
# testing the description attribute method
$obj->description(555);
result ($obj->description() == 555);
# testing the es_fk attribute method
$obj->es_fk(555);
result ($obj->es_fk() == 555);
# testing the fesw_fk attribute method
$obj->fesw_fk(555);
result ($obj->fesw_fk() == 555);
# testing the fesw_obj attribute method
$obj->fesw_obj(555);
result ($obj->fesw_obj() == 555);
# testing the es_obj attribute method
$obj->es_obj(555);
result ($obj->es_obj() == 555);
# testing the fetched attribute method
$obj->fetched(555);
result ($obj->fetched() == 555);
# testing the fetch_all attribute method
$obj->fetch_all(555);
result ($obj->fetch_all() == 555);
# testing the fetched_attr attribute method
$obj->fetched_attr(555);
result ($obj->fetched_attr() == 555);
# testing the id attribute method
$obj->id(555);
result ($obj->id() == 555);
# testing the dbh attribute method
$obj->dbh(555);
result ($obj->dbh() == 555);
# testing the pkey_name method
result($obj->pkey_name() eq 'mba_pk');
# testing the tablename method
result($obj->tablename() eq q[MeasuredBioAssay]);
# testing the table_type method
result($obj->table_type() eq q[DATA]);
# test $LIMIT
result(!defined $Bio::Genex::MeasuredBioAssay::LIMIT);
# test $USE_CACHE
result(defined $Bio::Genex::MeasuredBioAssay::USE_CACHE);
# testing the column2name method
result(ref($obj->column2name) eq 'HASH' and
scalar keys %{$obj->column2name} >=
scalar keys %{$Bio::Genex::MeasuredBioAssay::COLUMN2NAME});
# testing the name2column method
result(ref($obj->name2column) eq 'HASH' and
scalar keys %{$obj->name2column} >=
scalar keys %{$Bio::Genex::MeasuredBioAssay::NAME2COLUMN});
# testing the fkeys method
result(ref($obj->fkeys) eq 'HASH' and
scalar keys %{$obj->fkeys} >=
scalar keys %{$Bio::Genex::MeasuredBioAssay::FKEYS});
# testing the fkey_obj2raw method
result(ref($obj->fkey_obj2raw) eq 'HASH' and
scalar keys %{$obj->fkey_obj2raw} >=
scalar keys %{$Bio::Genex::MeasuredBioAssay::FKEY_OBJ2RAW});
# testing each fkey
foreach my $fkey (values %{$Bio::Genex::MeasuredBioAssay::FKEYS}) {
result($fkey->isa('Bio::Genex::Fkey')
&& $fkey->fkey_name()
&& $fkey->pkey_name()
&& $fkey->table_name()
&& grep {$fkey->fkey_type eq $_}
(FKEY_OTM,
FKEY_OTM_LT,
FKEY_OTM_LINK,
FKEY_LINK,
FKEY_OTO,
FKEY_LT,
FKEY_MTO,
FKEY_OTM_OO,
FKEY_OTM_LT_OO,
FKEY_OTM_LINK_OO,
FKEY_LINK_OO,
FKEY_OTO_OO,
FKEY_LT_OO,
FKEY_MTO_OO,
));
}
# testing superclass Bio::Genex::Identifiable
result($obj->isa(q[Bio::Genex::Identifiable]));
# testing the column_names method
result(ref($obj->column_names) eq 'ARRAY' and
scalar @{$obj->column_names} >=
scalar @{$Bio::Genex::MeasuredBioAssay::COLUMN_NAMES});
# testing the unique_columns method
result(ref($obj->unique_columns) eq 'ARRAY' and
scalar @{$obj->unique_columns} >=
scalar @{$Bio::Genex::MeasuredBioAssay::UNIQUE_COLUMNS});
--- NEW FILE: QuantitationTypeDimension.t ---
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl QuantitationTypeDimension.t'
######################### We start with some black magic to print on failure.
# Change 1..1 below to 1..last_test_to_print .
# (It may become useful if the test is moved to ./t subdirectory.)
BEGIN { $| = 1; print "1..24\n"; }
END {print "not ok 1\n" unless $loaded;}
use Carp;
use lib 't';
# use blib;
use TestDB qw(result);
use vars qw($i $loaded);
use Bio::Genex::QuantitationTypeDimension;
use Bio::Genex qw(is_object);
use Bio::Genex::Fkey qw(:FKEY);
$loaded = 1;
$i = 1;
result($i);
######################### End of black magic.
# Insert your test code below (better if it prints "ok 13"
# (correspondingly "not ok 13") depending on the success of chunk 13
# of the test code):
my $obj = Bio::Genex::QuantitationTypeDimension->new();
# testing the qd_pk attribute method
$obj->qd_pk(555);
result ($obj->qd_pk() == 555);
# testing the data_table_name attribute method
$obj->data_table_name(555);
result ($obj->data_table_name() == 555);
# testing the quantitationlink_obj attribute method
$obj->quantitationlink_obj(555);
result ($obj->quantitationlink_obj() == 555);
# testing the quantitationlink_fk attribute method
$obj->quantitationlink_fk(555);
result ($obj->quantitationlink_fk() == 555);
# testing the fetched attribute method
$obj->fetched(555);
result ($obj->fetched() == 555);
# testing the fetch_all attribute method
$obj->fetch_all(555);
result ($obj->fetch_all() == 555);
# testing the fetched_attr attribute method
$obj->fetched_attr(555);
result ($obj->fetched_attr() == 555);
# testing the id attribute method
$obj->id(555);
result ($obj->id() == 555);
# testing the dbh attribute method
$obj->dbh(555);
result ($obj->dbh() == 555);
# testing the pkey_name method
result($obj->pkey_name() eq 'qd_pk');
# testing the tablename method
result($obj->tablename() eq q[QuantitationTypeDimension]);
# testing the table_type method
result($obj->table_type() eq q[DATA]);
# test $LIMIT
result(!defined $Bio::Genex::QuantitationTypeDimension::LIMIT);
# test $USE_CACHE
result(defined $Bio::Genex::QuantitationTypeDimension::USE_CACHE);
# testing the column2name method
result(ref($obj->column2name) eq 'HASH' and
scalar keys %{$obj->column2name} >=
scalar keys %{$Bio::Genex::QuantitationTypeDimension::COLUMN2NAME});
# testing the name2column method
result(ref($obj->name2column) eq 'HASH' and
scalar keys %{$obj->name2column} >=
scalar keys %{$Bio::Genex::QuantitationTypeDimension::NAME2COLUMN});
# testing the fkeys method
result(ref($obj->fkeys) eq 'HASH' and
scalar keys %{$obj->fkeys} >=
scalar keys %{$Bio::Genex::QuantitationTypeDimension::FKEYS});
# testing the fkey_obj2raw method
result(ref($obj->fkey_obj2raw) eq 'HASH' and
scalar keys %{$obj->fkey_obj2raw} >=
scalar keys %{$Bio::Genex::QuantitationTypeDimension::FKEY_OBJ2RAW});
# testing each fkey
foreach my $fkey (values %{$Bio::Genex::QuantitationTypeDimension::FKEYS}) {
result($fkey->isa('Bio::Genex::Fkey')
&& $fkey->fkey_name()
&& $fkey->pkey_name()
&& $fkey->table_name()
&& grep {$fkey->fkey_type eq $_}
(FKEY_OTM,
FKEY_OTM_LT,
FKEY_OTM_LINK,
FKEY_LINK,
FKEY_OTO,
FKEY_LT,
FKEY_MTO,
FKEY_OTM_OO,
FKEY_OTM_LT_OO,
FKEY_OTM_LINK_OO,
FKEY_LINK_OO,
FKEY_OTO_OO,
FKEY_LT_OO,
FKEY_MTO_OO,
));
}
# testing superclass Bio::Genex::Identifiable
result($obj->isa(q[Bio::Genex::Identifiable]));
# testing the column_names method
result(ref($obj->column_names) eq 'ARRAY' and
scalar @{$obj->column_names} >=
scalar @{$Bio::Genex::QuantitationTypeDimension::COLUMN_NAMES});
# testing the unique_columns method
result(ref($obj->unique_columns) eq 'ARRAY' and
scalar @{$obj->unique_columns} >=
scalar @{$Bio::Genex::QuantitationTypeDimension::UNIQUE_COLUMNS});
|
|
From: <jas...@us...> - 2002-10-15 14:42:19
|
Update of /cvsroot/genex/genex-server/Genex/t
In directory usw-pr-cvs1:/tmp/cvs-serv387/Genex/t
Modified Files:
QuantitationType.t
Log Message:
new
Index: QuantitationType.t
===================================================================
RCS file: /cvsroot/genex/genex-server/Genex/t/QuantitationType.t,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** QuantitationType.t 18 Sep 2002 20:45:49 -0000 1.3
--- QuantitationType.t 15 Oct 2002 14:42:15 -0000 1.4
***************
*** 7,11 ****
# (It may become useful if the test is moved to ./t subdirectory.)
! BEGIN { $| = 1; print "1..37\n"; }
END {print "not ok 1\n" unless $loaded;}
use Carp;
--- 7,11 ----
# (It may become useful if the test is moved to ./t subdirectory.)
! BEGIN { $| = 1; print "1..38\n"; }
END {print "not ok 1\n" unless $loaded;}
use Carp;
***************
*** 47,50 ****
--- 47,54 ----
$obj->data_type(555);
result ($obj->data_type() == 555);
+
+ # testing the column_number attribute method
+ $obj->column_number(555);
+ result ($obj->column_number() == 555);
# testing the scale attribute method
|
Update of /cvsroot/genex/genex-server/webtools
In directory usw-pr-cvs1:/tmp/cvs-serv8063
Modified Files:
Tag: Rel-1_0_1-branch
delete_study1.html delete_study1.pl cant_delete_study.html
Added Files:
Tag: Rel-1_0_1-branch
delete_study2.pl
Log Message:
Finish delete confirmation for deleting a study.
Don't allow study delete if any of the experimental conditions are locked (by
a sample using that exp. cond. in a locked order).
--- NEW FILE: delete_study2.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 $us_fk = get_us_fk($dbh);
my $sty_pk = $q->param("sty_pk");
if (is_writeable($dbh, "study", "sty_pk", $sty_pk, $us_fk) == 1)
{
delete_study($dbh, $sty_pk);
}
$dbh->commit;
$dbh->disconnect;
my $url = index_url(); # see sessionlib.pl
$url =~ s/(.*)\/.*/$1\/choose_study.pl/;
print "Location: $url\n\n";
exit();
}
Index: delete_study1.html
===================================================================
RCS file: /cvsroot/genex/genex-server/webtools/Attic/delete_study1.html,v
retrieving revision 1.1.2.1
retrieving revision 1.1.2.2
diff -C2 -d -r1.1.2.1 -r1.1.2.2
*** delete_study1.html 14 Oct 2002 21:27:58 -0000 1.1.2.1
--- delete_study1.html 15 Oct 2002 13:43:40 -0000 1.1.2.2
***************
*** 12,17 ****
<tr>
<td valign="top">
! <input type=hidden name="sty_pk" value="{sty_pk}">
! <input type=submit name=submit value="Edit {name}">
<br>
Are you sure you want to delete study "{study_name}"?
--- 12,19 ----
<tr>
<td valign="top">
! <form action="edit_study1.pl" method="post">
! <input type="hidden" name="sty_pk" value="{sty_pk}">
! <input type="submit" name="submit" value="Edit "{study_name}"">
! </form>
<br>
Are you sure you want to delete study "{study_name}"?
***************
*** 24,28 ****
</td>
<td valign=top width="30%">
! <form action="delete_study1.pl" method="post">
<input type="hidden" name="sty_pk" value="{sty_pk}">
<input type="submit" name="submit" value="Delete "{study_name}" now">
--- 26,30 ----
</td>
<td valign=top width="30%">
! <form action="delete_study2.pl" method="post">
<input type="hidden" name="sty_pk" value="{sty_pk}">
<input type="submit" name="submit" value="Delete "{study_name}" now">
Index: delete_study1.pl
===================================================================
RCS file: /cvsroot/genex/genex-server/webtools/Attic/delete_study1.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
*** delete_study1.pl 14 Oct 2002 21:28:00 -0000 1.1.2.1
--- delete_study1.pl 15 Oct 2002 13:43:40 -0000 1.1.2.2
***************
*** 51,55 ****
($allhtml) = readtemplate("delete_study1.html"); # see sessionlib.pl
}
! $allhtml =~ s/{(.*?)}/$s_hr->{$1}$e_hr->{$1}$ch{$1}/g;
--- 51,59 ----
($allhtml) = readtemplate("delete_study1.html"); # see sessionlib.pl
}
! #
! # Don't use $ch{$1} since at least sty_pk is duplicated here,
! # and results in output like 696696 instead of 696.
! #
! $allhtml =~ s/{(.*?)}/$s_hr->{$1}$e_hr->{$1}/g;
Index: cant_delete_study.html
===================================================================
RCS file: /cvsroot/genex/genex-server/webtools/Attic/cant_delete_study.html,v
retrieving revision 1.1.2.1
retrieving revision 1.1.2.2
diff -C2 -d -r1.1.2.1 -r1.1.2.2
*** cant_delete_study.html 14 Oct 2002 21:28:04 -0000 1.1.2.1
--- cant_delete_study.html 15 Oct 2002 13:43:40 -0000 1.1.2.2
***************
*** 11,17 ****
<tr>
<td valign="top">
! "{study_name}" has one or more locked experimental conditions.<br>
! Experimental conditions are locked when there is a sample using that condition.
! <br>
Study name: {study_name}<br>
Date started: {start_date}<br>
--- 11,18 ----
<tr>
<td valign="top">
! <font color="#FF0000">"{study_name}" has one or more locked experimental conditions.
! Experimental conditions are locked when there is a locked order with a sample
! using that experimental condition.</font>
! <br><br>
Study name: {study_name}<br>
Date started: {start_date}<br>
|
Update of /cvsroot/genex/genex-server/webtools
In directory usw-pr-cvs1:/tmp/cvs-serv8163
Modified Files:
Tag: Rel-1_0_1-branch
sessionlib.pl edit_study1.pl edit_study2.pl
Added Files:
Tag: Rel-1_0_1-branch
delete_study1.html delete_study1.pl cant_delete_study.html
Log Message:
Adding delete confirm and disallowing delete of
study if one or more exp_conds are already used
by some sample in a locked order.
Partial functionality checkin.
--- NEW FILE: delete_study1.html ---
<html><head><title>Choose a Study</title></head>
<body bgcolor="#FFFFFF">
<table border=0 cellpadding=0 cellspacing=0>
<tr><td align=top><img src="../graphics/genex_logo.jpg" align="left">GeneX Study Selection<br><br>
<a href="./">Return to Genex Member Home</a><br><br clear=all><br>
</td>
</tr>
</table>
<a href="./">Cancel</a><br><br>
<table width="600" border=1 cellspacing=0 cellpadding=3>
<tr>
<td valign="top">
<input type=hidden name="sty_pk" value="{sty_pk}">
<input type=submit name=submit value="Edit {name}">
<br>
Are you sure you want to delete study "{study_name}"?
<br><br>
Study name: {study_name}<br>
Date started: {start_date}<br>
Comments: {comments}<br>
Number of conditions: {number_of_conditions}
<br><br>
</td>
<td valign=top width="30%">
<form action="delete_study1.pl" method="post">
<input type="hidden" name="sty_pk" value="{sty_pk}">
<input type="submit" name="submit" value="Delete "{study_name}" now">
</form>
</td>
</tr>
</table>
<br>
<br>
</body>
</html>
--- NEW FILE: delete_study1.pl ---
#!/usr/bin/perl
use strict;
use CGI;
use CGI::Carp qw(fatalsToBrowser);
require "sessionlib.pl";
main:
{
my $debug;
my $q = new CGI;
my $dbh = new_connection(); # sessionlib.pl
my $us_fk = get_us_fk($dbh);
my %ch = $q->Vars();
#
# Show the user a list of studies that are >>writable<< by the user.
#
(my $fclause, my $wclause) = write_where_clause("study", "sty_pk", $us_fk);
my $sql = "select * from study, $fclause where $wclause and sty_pk=$ch{sty_pk} order by sty_pk desc";
my $sth = $dbh->prepare($sql);
$sth->execute();
my $s_hr;
$s_hr = $sth->fetchrow_hashref();
$s_hr->{study_date} = sql2date($s_hr->{study_date});
($fclause, $wclause) = read_where_clause("exp_condition", "ec_pk", $us_fk );
my $sql_e = "select * from exp_condition, $fclause where sty_fk=$ch{sty_pk} and $wclause order by ec_pk";
my $sth_e = $dbh->prepare($sql_e);
$sth_e->execute() || die "$sql_e\n$DBI::errstr\n";
my $e_hr;
my $locked_flag = 0; # are any exp_conditions locked?
while( $e_hr = $sth_e->fetchrow_hashref())
{
if (1 != is_writeable($dbh, "exp_condition", "ec_pk", $e_hr->{ec_pk}, $us_fk))
{
$locked_flag = 1;
}
}
my $sql_num = "select count(*) from exp_condition where sty_fk=$s_hr->{sty_pk}";
($s_hr->{number_of_conditions}) = $dbh->selectrow_array($sql_num);
my $allhtml;
if ($locked_flag == 1)
{
($allhtml) = readtemplate("cant_delete_study.html");
}
else
{
($allhtml) = readtemplate("delete_study1.html"); # see sessionlib.pl
}
$allhtml =~ s/{(.*?)}/$s_hr->{$1}$e_hr->{$1}$ch{$1}/g;
print "Content-type: text/html\n\n";
print "$allhtml\n";
$dbh->disconnect;
exit(0);
}
--- NEW FILE: cant_delete_study.html ---
<html><head><title>Cannot delete this study</title></head>
<body bgcolor="#FFFFFF">
<table border=0 cellpadding=0 cellspacing=0>
<tr><td align=top><img src="../graphics/genex_logo.jpg" align="left">GeneX cannot delete study.<br><br>
<a href="./">Return to Genex Member Home</a><br><br clear=all><br>
</td>
</tr>
</table>
<table width="600" border=1 cellspacing=0 cellpadding=3>
<tr>
<td valign="top">
"{study_name}" has one or more locked experimental conditions.<br>
Experimental conditions are locked when there is a sample using that condition.
<br>
Study name: {study_name}<br>
Date started: {start_date}<br>
Comments: {comments}<br>
Number of conditions: {number_of_conditions}
<br><br>
</td>
<td valign=top width="30%">
<form action="choose_study.pl" method="post">
<input type="submit" name="submit" value="Return to Choose Study">
</form>
</td>
</tr>
</table>
</body>
</html>
Index: sessionlib.pl
===================================================================
RCS file: /cvsroot/genex/genex-server/webtools/Attic/sessionlib.pl,v
retrieving revision 1.1.2.38
retrieving revision 1.1.2.39
diff -C2 -d -r1.1.2.38 -r1.1.2.39
*** sessionlib.pl 14 Oct 2002 20:13:14 -0000 1.1.2.38
--- sessionlib.pl 14 Oct 2002 21:27:51 -0000 1.1.2.39
***************
*** 1189,1200 ****
#
- $dbh->trace(1, "/var/genres/twl8n/dbi.log");
my $where_clause;
my $from_clause;
($from_clause, $where_clause) = write_where_clause($table, $pkey, $us_fk);
my $sql = "select count($pkey) from $table, $from_clause where $pkey=$pk_value and $where_clause";
- {
- (my $rc) = $dbh->selectrow_array($sql) || die "sa: $sql\n$DBI::errstr\n";
- }
my $sth = $dbh->prepare($sql) || die "is_writeable prepare: $sql\n$DBI::errstr\n" ;
if ($DBI::errstr)
--- 1189,1196 ----
***************
*** 1203,1211 ****
}
($sth->execute()) || die "is_writeable execute: $sql\n$DBI::errstr\n" ;
! foreach my $key (keys(%{$sth}))
! {
! write_log("$key $sth->{$key}");
! }
! (my $row_count) = $sth->fetchrow_array() || die "is_writeable fetch: $sql\n$DBI::errstr\n";
if ($DBI::errstr)
{
--- 1199,1203 ----
}
($sth->execute()) || die "is_writeable execute: $sql\n$DBI::errstr\n" ;
! ((my $row_count) = $sth->fetchrow_array()) || die "is_writeable fetch: $sql\n$DBI::errstr\n";
if ($DBI::errstr)
{
Index: edit_study1.pl
===================================================================
RCS file: /cvsroot/genex/genex-server/webtools/Attic/edit_study1.pl,v
retrieving revision 1.1.2.12
retrieving revision 1.1.2.13
diff -C2 -d -r1.1.2.12 -r1.1.2.13
*** edit_study1.pl 14 Oct 2002 20:13:20 -0000 1.1.2.12
--- edit_study1.pl 14 Oct 2002 21:27:55 -0000 1.1.2.13
***************
*** 66,70 ****
($fclause, $wclause) = read_where_clause("exp_condition", "ec_pk", $us_fk );
$sql = "select * from exp_condition, $fclause where sty_fk=$ch{sty_pk} and $wclause order by ec_pk";
! $sth = $dbh->prepare($sql);
$sth->execute() || die "$sql\n$DBI::errstr\n";
--- 66,70 ----
($fclause, $wclause) = read_where_clause("exp_condition", "ec_pk", $us_fk );
$sql = "select * from exp_condition, $fclause where sty_fk=$ch{sty_pk} and $wclause order by ec_pk";
! $sth = $dbh->prepare($sql) || die "$sql\n$DBI::errstr\n";
$sth->execute() || die "$sql\n$DBI::errstr\n";
Index: edit_study2.pl
===================================================================
RCS file: /cvsroot/genex/genex-server/webtools/Attic/edit_study2.pl,v
retrieving revision 1.1.2.16
retrieving revision 1.1.2.17
diff -C2 -d -r1.1.2.16 -r1.1.2.17
*** edit_study2.pl 14 Oct 2002 20:13:19 -0000 1.1.2.16
--- edit_study2.pl 14 Oct 2002 21:27:55 -0000 1.1.2.17
***************
*** 23,27 ****
(my $fclause, my $wclause) = write_where_clause("study", "sty_pk", $us_fk );
my $sql = "select * from study, $fclause where sty_pk=$sty_pk and $wclause";
! my $sth = $dbh->prepare($sql);
$sth->execute() || die "$sql\n$DBI::errstr\n";
my $rows = $sth->rows();
--- 23,27 ----
(my $fclause, my $wclause) = write_where_clause("study", "sty_pk", $us_fk );
my $sql = "select * from study, $fclause where sty_pk=$sty_pk and $wclause";
! my $sth = $dbh->prepare($sql) || die "$sql\n$DBI::errstr\n";
$sth->execute() || die "$sql\n$DBI::errstr\n";
my $rows = $sth->rows();
|
|
From: <tw...@us...> - 2002-10-14 20:31:31
|
Update of /cvsroot/genex/genex-server/webtools
In directory usw-pr-cvs1:/tmp/cvs-serv17889
Removed Files:
Tag: Rel-1_0_1-branch
delete_study.pl
Log Message:
removed to implement delete study verify
--- delete_study.pl DELETED ---
|
Update of /cvsroot/genex/genex-server/webtools
In directory usw-pr-cvs1:/tmp/cvs-serv16455
Removed Files:
Tag: Rel-1_0_1-branch
choose_expset.html choose_expset.pl delete_expset1.pl
delete_expset2.pl delete_expset.html insert_expset.html
Log Message:
experimentset is an old concept. Months ago this code was
replaced by new study, exp_condition, order, and sample code.
--- choose_expset.html DELETED ---
--- choose_expset.pl DELETED ---
--- delete_expset1.pl DELETED ---
--- delete_expset2.pl DELETED ---
--- delete_expset.html DELETED ---
--- insert_expset.html DELETED ---
|
|
From: <tw...@us...> - 2002-10-14 20:20:42
|
Update of /cvsroot/genex/genex-server/webtools
In directory usw-pr-cvs1:/tmp/cvs-serv13103
Modified Files:
Tag: Rel-1_0_1-branch
edit_sample1.pl
Log Message:
fixed alpha sorting of exp. cond. names within the protocol/name
drop down list.
Index: edit_sample1.pl
===================================================================
RCS file: /cvsroot/genex/genex-server/webtools/Attic/edit_sample1.pl,v
retrieving revision 1.1.2.17
retrieving revision 1.1.2.18
diff -C2 -d -r1.1.2.17 -r1.1.2.18
*** edit_sample1.pl 8 Oct 2002 20:14:36 -0000 1.1.2.17
--- edit_sample1.pl 14 Oct 2002 20:20:34 -0000 1.1.2.18
***************
*** 121,125 ****
my $sql = "select ec_pk,exp_condition.name,exp_condition.sty_fk,study_name
from study,exp_condition,$from_clause
! where ($where_clause and exp_condition.sty_fk=study.sty_pk) order by study_name";
my $sth = $dbh->prepare($sql);
$sth->execute() || die "$sql\n$DBI::errstr\n";
--- 121,125 ----
my $sql = "select ec_pk,exp_condition.name,exp_condition.sty_fk,study_name
from study,exp_condition,$from_clause
! where ($where_clause and exp_condition.sty_fk=study.sty_pk) order by study_name,exp_condition.name";
my $sth = $dbh->prepare($sql);
$sth->execute() || die "$sql\n$DBI::errstr\n";
|
Update of /cvsroot/genex/genex-server/webtools
In directory usw-pr-cvs1:/tmp/cvs-serv9467
Modified Files:
Tag: Rel-1_0_1-branch
sessionlib.pl choose_order_curator.html
choose_order_curator.pl edit_study2.pl edit_study1.pl
Log Message:
- put study name unique test and exp. cond. unique name test into two subs:
verify_study() and verify_exp() respectively in sessionlib.pl
- fixed choose_order_curator.pl and choose_order_curator.html to check and
display warnings for orders where there are duplicate name problems.
Index: sessionlib.pl
===================================================================
RCS file: /cvsroot/genex/genex-server/webtools/Attic/sessionlib.pl,v
retrieving revision 1.1.2.37
retrieving revision 1.1.2.38
diff -C2 -d -r1.1.2.37 -r1.1.2.38
*** sessionlib.pl 14 Oct 2002 18:27:05 -0000 1.1.2.37
--- sessionlib.pl 14 Oct 2002 20:13:14 -0000 1.1.2.38
***************
*** 32,35 ****
--- 32,37 ----
$messages[13] = "Short name can only contain letters and digits.<br>\n";
$messages[14] = "Experimental condition names and short names must be unique with a study.<br>\n";
+ $messages[15] = "One or more of the samples comes from a study with a duplicate name.<br>\n";
+ $messages[16] = "One or more of the samples comes from a study with duplicate experimental condition names or duplicate short names.<br>\n";
return $messages[$_[0]];
***************
*** 44,59 ****
my $dbh = $_[0];
my $us_fk = $_[1];
! my %ch = %{$_[2]};
(my $fclause, my $wclause) = read_where_clause("study", "sty_pk", $us_fk );
! my $sql_sn = "select study_name from study,$fclause where $wclause and study_name=? and sty_pk<>?";
! my $sth_sn = $dbh->prepare($sql_sn);
! $sth_sn->execute($ch{study_name}, $ch{sty_pk});
if ($sth_sn->rows() > 0)
{
! return "5m";
}
return "";
}
#
# It seems odd that some of these don't require /s;
--- 46,91 ----
my $dbh = $_[0];
my $us_fk = $_[1];
! my $sty_pk = $_[2];
! my $which_message = $_[3];
! my $study_name = $_[4];
+ # write_log("vs: $us_fk, $study_name, $sty_pk");
(my $fclause, my $wclause) = read_where_clause("study", "sty_pk", $us_fk );
! my $sql_sn = "select study_name from study,$fclause where $wclause and study_name ilike ? and sty_pk<>?";
! my $sth_sn = $dbh->prepare($sql_sn) || die "$sql_sn\n$DBI::errstr\n";
! $sth_sn->execute($study_name, $sty_pk) || die "$sql_sn\n$DBI::errstr\n";
if ($sth_sn->rows() > 0)
{
! return $which_message ."m";
! }
! return "";
! }
!
! sub verify_exp
! {
! my $dbh = $_[0];
! my $us_fk = $_[1];
! my $sty_pk = $_[2];
! my $which_message = $_[3];
! my $test_name = $_[4];
! my $test_abbrev = $_[5];
! #
! # Make sure this name is unique
! #
! my $sql_name = "select name from exp_condition where sty_fk=? and (name ilike ? or abbrev_name ilike ?)";
! my $sth_name = $dbh->prepare($sql_name) || die "$sql_name\nDBI::errstr\n";
! $sth_name->execute($sty_pk, $test_name, $test_abbrev) || die "$sql_name\nDBI::errstr\n";
! my $rows = $sth_name->rows();
! $sth_name->finish();
!
! if ($rows > 1)
! {
! return $which_message. "m";
}
return "";
}
+
+
+
#
# It seems odd that some of these don't require /s;
Index: choose_order_curator.html
===================================================================
RCS file: /cvsroot/genex/genex-server/webtools/Attic/choose_order_curator.html,v
retrieving revision 1.1.2.11
retrieving revision 1.1.2.12
diff -C2 -d -r1.1.2.11 -r1.1.2.12
*** choose_order_curator.html 14 Oct 2002 18:27:05 -0000 1.1.2.11
--- choose_order_curator.html 14 Oct 2002 20:13:16 -0000 1.1.2.12
***************
*** 9,32 ****
<loop>
! <table width=750 border=1 cellpadding=2 cellspacing=0>
<tr>
<td valign="top">
<form name="form" method="post" action="edit_order_curator2.pl">
! <table width="100%" border=0 cellpadding=2 cellspacing=0>
<tr>
<td width="30%">
! <div align="right">
! <input type=hidden name="oi_pk" value={oi_pk}>
! <font color="#FF0000">{message}</font>
! Owner: </div>
! </td>
! <td width="30%"> {contact_fname} {contact_lname} ( {login} )
</td>
<td width="40%"> </td>
! <td width="40%">
! <div align="right">
! <input type=submit name="submit" value="Update">
! </div>
! </td>
</tr>
<tr>
--- 9,25 ----
<loop>
! <table width="750" border="1" cellpadding="2" cellspacing="0">
<tr>
<td valign="top">
<form name="form" method="post" action="edit_order_curator2.pl">
! <table width="100%" border="0" cellpadding="2" cellspacing="0">
<tr>
<td width="30%">
! <input type=hidden name="oi_pk" value={oi_pk}>
! <div align="right">Owner:</div>
</td>
+ <td width="30%"> {contact_fname} {contact_lname} ( {login} )</td>
<td width="40%"> </td>
! <td width="40%"><input type=submit name="submit" value="Update"></td>
</tr>
<tr>
***************
*** 90,93 ****
--- 83,87 ----
</table>
</form>
+ <font color="#FF0000">{message}</font>
<br>
<table width="100%" border=0 cellpadding=2 cellspacing=0>
Index: choose_order_curator.pl
===================================================================
RCS file: /cvsroot/genex/genex-server/webtools/Attic/choose_order_curator.pl,v
retrieving revision 1.1.2.13
retrieving revision 1.1.2.14
diff -C2 -d -r1.1.2.13 -r1.1.2.14
*** choose_order_curator.pl 11 Oct 2002 15:16:11 -0000 1.1.2.13
--- choose_order_curator.pl 14 Oct 2002 20:13:16 -0000 1.1.2.14
***************
*** 50,56 ****
my $sql = "select * from order_info order by order_number desc";
my $billing_sql = "select * from billing where oi_fk=?";
! my $sample_sql = "select timestamp, exp_condition.name as ec_name, study.study_name from sample,exp_condition,study where study.sty_pk=exp_condition.sty_fk and exp_condition.ec_pk=sample.ec_fk and smp_pk=?";
my $sc_sql = "select count(smp_pk) from sample where oi_fk=?";
! my $owner_sql = "select usersec.login,contact.contact_fname,contact.contact_lname from order_info,groupref,usersec,contact where order_info.oi_pk=? and groupref.ref_fk=oi_pk and contact.con_pk=groupref.us_fk and groupref.us_fk=usersec.us_pk";
my $am_sql = "select hybridization_name,smp_pk,am_pk,al_fk from arraymeasurement,sample,order_info where oi_pk=? and order_info.oi_pk=sample.oi_fk and arraymeasurement.smp_fk=sample.smp_pk order by smp_pk,am_pk";
my $al_sql = "select arraylayout.name as al_name from arraylayout where al_pk=?";
--- 50,56 ----
my $sql = "select * from order_info order by order_number desc";
my $billing_sql = "select * from billing where oi_fk=?";
! my $sample_sql = "select timestamp, exp_condition.name as ec_name, abbrev_name, study.study_name, study.sty_pk from sample,exp_condition,study where study.sty_pk=exp_condition.sty_fk and exp_condition.ec_pk=sample.ec_fk and smp_pk=?";
my $sc_sql = "select count(smp_pk) from sample where oi_fk=?";
! my $owner_sql = "select usersec.login,contact.contact_fname,contact.contact_lname,usersec.us_pk from order_info,groupref,usersec,contact where order_info.oi_pk=? and groupref.ref_fk=oi_pk and contact.con_pk=groupref.us_fk and groupref.us_fk=usersec.us_pk";
my $am_sql = "select hybridization_name,smp_pk,am_pk,al_fk from arraymeasurement,sample,order_info where oi_pk=? and order_info.oi_pk=sample.oi_fk and arraymeasurement.smp_fk=sample.smp_pk order by smp_pk,am_pk";
my $al_sql = "select arraylayout.name as al_name from arraylayout where al_pk=?";
***************
*** 80,84 ****
$owner_sth->execute($o_hr->{oi_pk}) || die "$owner_sql\n$DBI::errstr\n";
! ($o_hr->{login}, $o_hr->{contact_fname}, $o_hr->{contact_lname}) = $owner_sth->fetchrow_array();
my $loop_instance = $loop_template;
--- 80,84 ----
$owner_sth->execute($o_hr->{oi_pk}) || die "$owner_sql\n$DBI::errstr\n";
! ($o_hr->{login}, $o_hr->{contact_fname}, $o_hr->{contact_lname}, $o_hr->{us_pk}) = $owner_sth->fetchrow_array();
my $loop_instance = $loop_template;
***************
*** 90,94 ****
$am_sth->execute($o_hr->{oi_pk}) || die "$am_sql\n$DBI::errstr\n";
! my $s_hr;
while($s_hr = $am_sth->fetchrow_hashref())
{
--- 90,94 ----
$am_sth->execute($o_hr->{oi_pk}) || die "$am_sql\n$DBI::errstr\n";
! my $s_hr; # Messy. Used for results from several queries.
while($s_hr = $am_sth->fetchrow_hashref())
{
***************
*** 100,106 ****
}
$sample_sth->execute($s_hr->{smp_pk}) || die "$sample_sql\n$DBI::errstr\n";
! ($s_hr->{timestamp}, $s_hr->{ec_name}, $s_hr->{study_name}) = $sample_sth->fetchrow_array();
$s_hr->{timestamp} = sql2date($s_hr->{timestamp}); # sql2date() is in sessionlib.pl
!
my $loop_instance2 = $loop_template2;
#
--- 100,120 ----
}
$sample_sth->execute($s_hr->{smp_pk}) || die "$sample_sql\n$DBI::errstr\n";
! ($s_hr->{timestamp}, $s_hr->{ec_name}, $s_hr->{abbrev_name}, $s_hr->{study_name}, $s_hr->{sty_pk}) = $sample_sth->fetchrow_array();
!
! {
! my $temp = verify_study($dbh, $o_hr->{us_pk}, $s_hr->{sty_pk}, 15, $s_hr->{study_name});
! if ($o_hr->{message} !~ m/^$temp|m$temp/)
! {
! $o_hr->{message} .= $temp;
! }
! $temp = verify_exp($dbh, $o_hr->{us_pk}, $s_hr->{sty_pk}, 16, $s_hr->{ec_name}, $s_hr->{abbrev_name});
! if ($o_hr->{message} !~ m/^$temp|m$temp/)
! {
! $o_hr->{message} .= $temp;
! }
! }
!
$s_hr->{timestamp} = sql2date($s_hr->{timestamp}); # sql2date() is in sessionlib.pl
!
my $loop_instance2 = $loop_template2;
#
***************
*** 115,119 ****
$reclist2 .= $loop_instance2;
}
!
$loop_instance =~ s/{(.*?)}/$o_hr->{$1}$b_hr->{$1}/g;
$loop_instance =~ s/\<loop_here2\>/$reclist2/s; # no g, only one inner loop
--- 129,138 ----
$reclist2 .= $loop_instance2;
}
! #
! # Turn message param in the form 0m1m2m back into a message text.
! # Use the wonderful and dangerous /e switch to eval the right side
! # of the regex. See sub messages() in sessionlib.pl
! #
! $o_hr->{message} =~ s/(\d+)m/messages($1)/eg;
$loop_instance =~ s/{(.*?)}/$o_hr->{$1}$b_hr->{$1}/g;
$loop_instance =~ s/\<loop_here2\>/$reclist2/s; # no g, only one inner loop
Index: edit_study2.pl
===================================================================
RCS file: /cvsroot/genex/genex-server/webtools/Attic/edit_study2.pl,v
retrieving revision 1.1.2.15
retrieving revision 1.1.2.16
diff -C2 -d -r1.1.2.15 -r1.1.2.16
*** edit_study2.pl 14 Oct 2002 18:27:05 -0000 1.1.2.15
--- edit_study2.pl 14 Oct 2002 20:13:19 -0000 1.1.2.16
***************
*** 65,69 ****
my %ch = $q->Vars();
! $message .= verify_study($dbh, $us_fk, \%ch);
#
--- 65,69 ----
my %ch = $q->Vars();
! $message .= verify_study($dbh, $us_fk, $ch{sty_pk}, 5, $ch{study_name});
#
***************
*** 72,76 ****
if (is_writeable($dbh, "study", "sty_pk", $ch{sty_pk}, $us_fk) == 1)
{
! write_log("date: $ch{start_date}");
$ch{start_date} = date2sql($ch{start_date});
--- 72,76 ----
if (is_writeable($dbh, "study", "sty_pk", $ch{sty_pk}, $us_fk) == 1)
{
! # write_log("date: $ch{start_date}");
$ch{start_date} = date2sql($ch{start_date});
***************
*** 93,97 ****
my %shash;
! write_log("ec_pk: $all_ch{ec_pk_0}");
my @del; # list of field name suffixes for deleted exp. conditions
--- 93,97 ----
my %shash;
! # write_log("ec_pk: $all_ch{ec_pk_0}");
my @del; # list of field name suffixes for deleted exp. conditions
***************
*** 208,227 ****
$message .= "12m";
}
!
{
! #
! # Make sure this name is unique
! #
! my $sql_name = "select name from exp_condition where sty_fk=? and (name ilike ? or abbrev_name ilike ?)";
! my $sth_name = $dbh->prepare($sql_name) || die "$sql_name\nDBI::errstr\n";
! $sth_name->execute($all_ch{sty_pk}, $ch{name}, $ch{abbrev_name});
! my $rows = $sth_name->rows();
! write_log("rows: $rows x$ch{sty_pk}x x$ch{name}x x$ch{abbrev_name}x");
! if (($rows > 1) &&
! $message !~ m/^14m|m14m/)
! {
! $message .= "14m";
! }
! $sth_name->finish();
}
--- 208,217 ----
$message .= "12m";
}
!
! my $temp = verify_exp($dbh, $us_fk, $all_ch{sty_pk}, 14, $ch{name}, $ch{abbrev_name});
! if ($temp &&
! $message !~ m/^$temp|m$temp/)
{
! $message .= "$temp";
}
Index: edit_study1.pl
===================================================================
RCS file: /cvsroot/genex/genex-server/webtools/Attic/edit_study1.pl,v
retrieving revision 1.1.2.11
retrieving revision 1.1.2.12
diff -C2 -d -r1.1.2.11 -r1.1.2.12
*** edit_study1.pl 8 Oct 2002 20:14:36 -0000 1.1.2.11
--- edit_study1.pl 14 Oct 2002 20:13:20 -0000 1.1.2.12
***************
*** 48,52 ****
# Turn message param in the form 0m1m2m back into a message text.
# Use the wonderful and dangerous /e switch to eval the right side
! # of the regex.
#
$ch{message} =~ s/(\d+)m/messages($1)/eg;
--- 48,52 ----
# Turn message param in the form 0m1m2m back into a message text.
# Use the wonderful and dangerous /e switch to eval the right side
! # of the regex. See sub messages() in sessionlib.pl
#
$ch{message} =~ s/(\d+)m/messages($1)/eg;
|
