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...> - 2003-04-23 22:21:38
|
Update of /cvsroot/genex/genex-server/Genex/Parameterizable In directory sc8-pr-cvs1:/tmp/cvs-serv5075/Parameterizable Modified Files: Parameterizable.pm Log Message: new inheritance patterns Index: Parameterizable.pm =================================================================== RCS file: /cvsroot/genex/genex-server/Genex/Parameterizable/Parameterizable.pm,v retrieving revision 1.1 retrieving revision 1.2 diff -C2 -d -r1.1 -r1.2 |
|
From: <jas...@us...> - 2003-04-23 22:21:35
|
Update of /cvsroot/genex/genex-server/Genex/ParameterValue In directory sc8-pr-cvs1:/tmp/cvs-serv5075/ParameterValue Modified Files: ParameterValue.pm Log Message: new inheritance patterns Index: ParameterValue.pm =================================================================== RCS file: /cvsroot/genex/genex-server/Genex/ParameterValue/ParameterValue.pm,v retrieving revision 1.3 retrieving revision 1.4 diff -C2 -d -r1.3 -r1.4 |
|
From: <jas...@us...> - 2003-04-23 22:21:34
|
Update of /cvsroot/genex/genex-server/Genex/Identifiable
In directory sc8-pr-cvs1:/tmp/cvs-serv5075/Identifiable
Modified Files:
Identifiable.pm
Log Message:
new inheritance patterns
Index: Identifiable.pm
===================================================================
RCS file: /cvsroot/genex/genex-server/Genex/Identifiable/Identifiable.pm,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -d -r1.11 -r1.12
*** Identifiable.pm 16 Apr 2003 23:23:50 -0000 1.11
--- Identifiable.pm 23 Apr 2003 22:20:58 -0000 1.12
***************
*** 18,24 ****
use Class::ObjectTemplate::DB 0.27;
! use Bio::Genex::GroupSec;
! use Bio::Genex::Audit;
!
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $FKEYS $COLUMN2NAME $NAME2COLUMN $COLUMN_NAMES %_CACHE $USE_CACHE $LIMIT $FKEY_OBJ2RAW $TABLE2PKEY $UNIQUE_COLUMNS $SUPER_CLASSES $TABLE_TYPE $PKEY_NAME $TABLE_NAME $DEBUG $TABLE_NAME_VIEW $COUNT);
--- 18,22 ----
use Class::ObjectTemplate::DB 0.27;
! use Bio::Genex::Securable;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $FKEYS $COLUMN2NAME $NAME2COLUMN $COLUMN_NAMES %_CACHE $USE_CACHE $LIMIT $FKEY_OBJ2RAW $TABLE2PKEY $UNIQUE_COLUMNS $SUPER_CLASSES $TABLE_TYPE $PKEY_NAME $TABLE_NAME $DEBUG $TABLE_NAME_VIEW $COUNT);
***************
*** 26,30 ****
require Exporter;
! @ISA = qw(Bio::Genex Exporter Class::ObjectTemplate::DB);
--- 24,28 ----
require Exporter;
! @ISA = qw(Bio::Genex Exporter Bio::Genex::Securable);
***************
*** 43,50 ****
$COLUMN_NAMES = [
'name',
! 'identifier',
! 'ro_groupname',
! 'rw_groupname',
! 'audit_fk'
]
;
--- 41,45 ----
$COLUMN_NAMES = [
'name',
! 'identifier'
]
;
***************
*** 55,106 ****
]
;
! $FKEYS = {
! 'audit_obj' => bless( {
! 'fkey_name' => 'audit_obj',
! 'can_self_reference' => 'false',
! 'pkey_name' => 'audit_pk',
! 'fkey_type' => 'ONE_TO_ONE_OO',
! 'table_name' => 'Audit'
! }, 'Bio::Genex::Fkey' ),
! 'rw_groupname_obj' => bless( {
! 'fkey_name' => 'rw_groupname_obj',
! 'can_self_reference' => 'false',
! 'pkey_name' => 'name',
! 'fkey_type' => 'ONE_TO_ONE_OO',
! 'table_name' => 'GroupSec'
! }, 'Bio::Genex::Fkey' ),
! 'ro_groupname_obj' => bless( {
! 'fkey_name' => 'ro_groupname_obj',
! 'can_self_reference' => 'false',
! 'pkey_name' => 'name',
! 'fkey_type' => 'ONE_TO_ONE_OO',
! 'table_name' => 'GroupSec'
! }, 'Bio::Genex::Fkey' )
! }
;
$COLUMN2NAME = {
- 'audit_fk' => 'Audit',
'identifier' => 'Identifier',
! 'ro_groupname' => 'Read-Only Group Name',
! 'name' => 'Name',
! 'rw_groupname' => 'Read/Write Group Name'
}
;
$NAME2COLUMN = {
- 'Read-Only Group Name' => 'ro_groupname',
- 'Read/Write Group Name' => 'rw_groupname',
'Identifier' => 'identifier',
- 'Audit' => 'audit_fk',
'Name' => 'name'
}
;
! $FKEY_OBJ2RAW = {
! 'audit_obj' => 'audit_fk',
! 'rw_groupname_obj' => 'rw_groupname',
! 'ro_groupname_obj' => 'ro_groupname'
! }
;
! $SUPER_CLASSES = []
;
$TABLE_NAME = q[Identifiable];
--- 50,71 ----
]
;
! $FKEYS = {}
;
$COLUMN2NAME = {
'identifier' => 'Identifier',
! 'name' => 'Name'
}
;
$NAME2COLUMN = {
'Identifier' => 'identifier',
'Name' => 'name'
}
;
! $FKEY_OBJ2RAW = {}
;
! $SUPER_CLASSES = [
! 'Bio::Genex::Securable'
! ]
;
$TABLE_NAME = q[Identifiable];
***************
*** 141,153 ****
$Identifiable->identifier($value);
- my $ro_groupname_val = $Identifiable->ro_groupname();
- $Identifiable->ro_groupname($value);
-
- my $rw_groupname_val = $Identifiable->rw_groupname();
- $Identifiable->rw_groupname($value);
-
- my $audit_fk_val = $Identifiable->audit_fk();
- $Identifiable->audit_fk($value);
-
=head1 DESCRIPTION
--- 106,109 ----
***************
*** 299,303 ****
# this calls the Class::ObjectTemplate::attributes() method
# to initialize all the class attributes
! attributes (no_lookup=>['fetched', 'fetch_all', 'fetched_attr', 'id', 'dbh'], lookup=>['name', 'identifier', 'ro_groupname', 'rw_groupname', 'audit_fk', 'ro_groupname_obj', 'rw_groupname_obj', 'audit_obj']);
--- 255,260 ----
# this calls the Class::ObjectTemplate::attributes() method
# to initialize all the class attributes
! # we get the no_lookup attributes from our superclass
! attributes (lookup=>['name', 'identifier']);
***************
*** 896,996 ****
- =head1 FOREIGN KEY ACCESSOR METHODS
-
- There are two major categories of foreign key accessor methods:
- I<Object Oriented> foreign key methods, and I<raw> foreign key
- methods.
-
- Each foreign key column in the table is represented by B<two> methods,
- one OO method and one raw method. The raw method enables fethcing the
- exact numeric or string values stored in the DB. The OO method creates
- objects of the class the fkey column refers to. The idea is that if
- only the numeric fkey value is desired, the raw fkey method can be
- used. If it is necessary to get attributes from the table referred to
- by the fkey column, then the OO method should be invoked, and the
- necessary methods on that object can be queried.
-
- The names of the raw fkey methods is the same as the fkey columns in
- the DB table they represent (all fkey columns end in the suffix
- '_fk'). The OO methods have the same names as the column they
- represent, with the difference that they have the suffix '_obj'
- instead of '_fk'.
-
- So for example, in class Bio::Genex::ArrayMeasurement the
- 'C<primary_es_fk>' column is represented by two methods, the raw
- method C<primary_es_fk()>, and the OO method C<primary_es_obj>.
-
- The following foreign key accessors are defined for class
- Bio::Genex::Identifiable:
-
- =over 4
-
-
- =back
-
-
-
- Every foreign key in a DB table belongs to a certain class of foreign
- keys. Each type of foreign key confers a different behavior on the
- class that contains it. The classifications used in Genex.pm are:
-
- =over 4
-
- =item *
-
- MANY_TO_ONE
-
- If a class contains a foreign key of this type it will not be visible
- to the API of that class, but instead it confers a special method to
- the class that it references.
-
- For example, the Chromosome table has a MANY_TO_ONE foreign key,
- spc_fk, that refers to the species table. Class L<Bio::Genex::Chromosome>, has
- it\'s normal C<spc_fk()> attribute method, but no special foreign key
- accessor method. However, class L<Bio::Genex::Species> is given a special
- foreign key accessor method, C<chromosome_fk()> of type
- ONE_TO_MANY. When invoked, this method returns a list of objects of
- class L<Bio::Genex::Species>.
-
- =item *
-
- ONE_TO_MANY
-
- The inverse of type MANY_TO_ONE. It is not an attribute inherent to a
- given foreign key in any DB table, but instead is created by the
- existence of a MANY_TO_ONE foreign key in another table. See the above
- discussion about MANY_TO_ONE foreign keys.
-
- =item *
-
- LOOKUP_TABLE
-
- This type of key is similar to type ONE_TO_MANY. However, However the
- API will I<never> retrieve an object of this type. Instead it
- retrieves a matrix of values, that represent the list of objects. It
- is used in only two places in the API: L<Bio::Genex::ArrayMeasurement> and
- L<Bio::Genex::ArrayLayout> classes with the C<am_spots()> and C<al_spots()>
- accessor functions.
-
- =item *
-
- LINKING_TABLE
-
- Foreign keys of this type appear in tables without primary keys. The
- foreign keys are each of type LINKING_TABLE, and when invoked return
- an object of the class referred to by the foreign key.
-
- =item *
-
- FKEY
-
- A generic foreign key with no special properties. When invoked it returns
- an object of the class referred to by the foreign key.
-
- =back
-
-
-
-
=head1 ATTRIBUTE METHODS
--- 853,856 ----
***************
*** 1032,1056 ****
Methods for the identifier attribute.
-
-
- =item $value = ro_groupname();
-
- =item ro_groupname($value);
-
- Methods for the ro_groupname attribute.
-
-
- =item $value = rw_groupname();
-
- =item rw_groupname($value);
-
- Methods for the rw_groupname attribute.
-
-
- =item $value = audit_fk();
-
- =item audit_fk($value);
-
- Methods for the audit_fk attribute.
--- 892,895 ----
|
|
From: <jas...@us...> - 2003-04-23 22:21:34
|
Update of /cvsroot/genex/genex-server/Genex/GroupSec In directory sc8-pr-cvs1:/tmp/cvs-serv5075/GroupSec Modified Files: GroupSec.pm Log Message: new inheritance patterns Index: GroupSec.pm =================================================================== RCS file: /cvsroot/genex/genex-server/Genex/GroupSec/GroupSec.pm,v retrieving revision 1.39 retrieving revision 1.40 diff -C2 -d -r1.39 -r1.40 |
|
From: <jas...@us...> - 2003-04-23 22:21:29
|
Update of /cvsroot/genex/genex-server/Genex/ExternalDatabase In directory sc8-pr-cvs1:/tmp/cvs-serv5075/ExternalDatabase Modified Files: ExternalDatabase.pm Log Message: new inheritance patterns Index: ExternalDatabase.pm =================================================================== RCS file: /cvsroot/genex/genex-server/Genex/ExternalDatabase/ExternalDatabase.pm,v retrieving revision 1.33 retrieving revision 1.34 diff -C2 -d -r1.33 -r1.34 |
|
From: <jas...@us...> - 2003-04-23 22:21:25
|
Update of /cvsroot/genex/genex-server/Genex/ExperimentSet In directory sc8-pr-cvs1:/tmp/cvs-serv5075/ExperimentSet Modified Files: ExperimentSet.pm Log Message: new inheritance patterns Index: ExperimentSet.pm =================================================================== RCS file: /cvsroot/genex/genex-server/Genex/ExperimentSet/ExperimentSet.pm,v retrieving revision 1.39 retrieving revision 1.40 diff -C2 -d -r1.39 -r1.40 |
|
From: <jas...@us...> - 2003-04-23 22:21:24
|
Update of /cvsroot/genex/genex-server/Genex/ControlledVocab In directory sc8-pr-cvs1:/tmp/cvs-serv5075/ControlledVocab Modified Files: ControlledVocab.pm Log Message: new inheritance patterns Index: ControlledVocab.pm =================================================================== RCS file: /cvsroot/genex/genex-server/Genex/ControlledVocab/ControlledVocab.pm,v retrieving revision 1.32 retrieving revision 1.33 diff -C2 -d -r1.32 -r1.33 |
|
From: <jas...@us...> - 2003-04-23 22:21:23
|
Update of /cvsroot/genex/genex-server/Genex/Contact In directory sc8-pr-cvs1:/tmp/cvs-serv5075/Contact Modified Files: Contact.pm Log Message: new inheritance patterns Index: Contact.pm =================================================================== RCS file: /cvsroot/genex/genex-server/Genex/Contact/Contact.pm,v retrieving revision 1.39 retrieving revision 1.40 diff -C2 -d -r1.39 -r1.40 |
|
From: <jas...@us...> - 2003-04-23 22:07:15
|
Update of /cvsroot/genex/genex-server/Genex/Securable
In directory sc8-pr-cvs1:/tmp/cvs-serv3931/Securable
Added Files:
Makefile.PL Securable.pm
Log Message:
new modules
--- 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::Securable',
'SKIP' => [qw( test makeaperl manifypods htmlifypods xs_o static)],
'VERSION_FROM' => '../Genex.pm', # finds $VERSION
);
--- NEW FILE: Securable.pm ---
##############################
#
# Bio::Genex::Securable
#
##############################
package Bio::Genex::Securable;
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;
[...1034 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...> - 2003-04-23 22:07:11
|
Update of /cvsroot/genex/genex-server/Genex/ProtocolStepApplication
In directory sc8-pr-cvs1:/tmp/cvs-serv3931/ProtocolStepApplication
Added Files:
Makefile.PL ProtocolStepApplication.pm
Log Message:
new modules
--- 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::ProtocolStepApplication',
'SKIP' => [qw( test makeaperl manifypods htmlifypods xs_o static)],
'VERSION_FROM' => '../Genex.pm', # finds $VERSION
);
--- NEW FILE: ProtocolStepApplication.pm ---
##############################
#
# Bio::Genex::ProtocolStepApplication
#
##############################
package Bio::Genex::ProtocolStepApplication;
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;
[...1298 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...> - 2003-04-23 22:03:42
|
Update of /cvsroot/genex/genex-server/Genex/Securable In directory sc8-pr-cvs1:/tmp/cvs-serv3111/Securable Log Message: Directory /cvsroot/genex/genex-server/Genex/Securable added to the repository |
|
From: <jas...@us...> - 2003-04-23 22:03:42
|
Update of /cvsroot/genex/genex-server/Genex/ProtocolStepApplication In directory sc8-pr-cvs1:/tmp/cvs-serv3111/ProtocolStepApplication Log Message: Directory /cvsroot/genex/genex-server/Genex/ProtocolStepApplication added to the repository |
|
From: <jas...@us...> - 2003-04-23 22:01:52
|
Update of /cvsroot/genex/genex-server/Genex/t
In directory sc8-pr-cvs1:/tmp/cvs-serv2184/t
Modified Files:
Identifiable.t ParameterValue.t Parameterizable.t
ProtocolStep.t
Log Message:
new tests
Index: Identifiable.t
===================================================================
RCS file: /cvsroot/genex/genex-server/Genex/t/Identifiable.t,v
retrieving revision 1.3
retrieving revision 1.4
diff -C2 -d -r1.3 -r1.4
*** Identifiable.t 18 Sep 2002 20:45:49 -0000 1.3
--- Identifiable.t 23 Apr 2003 22:01:48 -0000 1.4
***************
*** 7,11 ****
# (It may become useful if the test is moved to ./t subdirectory.)
! BEGIN { $| = 1; print "1..28\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..20\n"; }
END {print "not ok 1\n" unless $loaded;}
use Carp;
***************
*** 40,67 ****
result ($obj->identifier() == 555);
- # testing the ro_groupname attribute method
- $obj->ro_groupname(555);
- result ($obj->ro_groupname() == 555);
-
- # testing the rw_groupname attribute method
- $obj->rw_groupname(555);
- result ($obj->rw_groupname() == 555);
-
- # testing the audit_fk attribute method
- $obj->audit_fk(555);
- result ($obj->audit_fk() == 555);
-
- # testing the ro_groupname_obj attribute method
- $obj->ro_groupname_obj(555);
- result ($obj->ro_groupname_obj() == 555);
-
- # testing the rw_groupname_obj attribute method
- $obj->rw_groupname_obj(555);
- result ($obj->rw_groupname_obj() == 555);
-
- # testing the audit_obj attribute method
- $obj->audit_obj(555);
- result ($obj->audit_obj() == 555);
-
# testing the fetched attribute method
$obj->fetched(555);
--- 40,43 ----
***************
*** 143,146 ****
--- 119,125 ----
));
}
+
+ # testing superclass Bio::Genex::Securable
+ result($obj->isa(q[Bio::Genex::Securable]));
# testing the column_names method
Index: ParameterValue.t
===================================================================
RCS file: /cvsroot/genex/genex-server/Genex/t/ParameterValue.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** ParameterValue.t 17 Apr 2003 17:58:55 -0000 1.2
--- ParameterValue.t 23 Apr 2003 22:01:48 -0000 1.3
***************
*** 64,70 ****
result ($obj->proto_step_obj() == 555);
! # testing the proto_step_obj attribute method
! $obj->proto_step_obj(555);
! result ($obj->proto_step_obj() == 555);
# testing the ro_groupname_obj attribute method
--- 64,70 ----
result ($obj->proto_step_obj() == 555);
! # testing the parameter_obj attribute method
! $obj->parameter_obj(555);
! result ($obj->parameter_obj() == 555);
# testing the ro_groupname_obj attribute method
Index: Parameterizable.t
===================================================================
RCS file: /cvsroot/genex/genex-server/Genex/t/Parameterizable.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** Parameterizable.t 16 Apr 2003 23:27:14 -0000 1.1
--- Parameterizable.t 23 Apr 2003 22:01:48 -0000 1.2
***************
*** 7,11 ****
# (It may become useful if the test is moved to ./t subdirectory.)
! BEGIN { $| = 1; print "1..23\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..24\n"; }
END {print "not ok 1\n" unless $loaded;}
use Carp;
***************
*** 130,133 ****
--- 130,136 ----
# testing superclass Bio::Genex::Identifiable
result($obj->isa(q[Bio::Genex::Identifiable]));
+
+ # testing superclass Bio::Genex::Securable
+ result($obj->isa(q[Bio::Genex::Securable]));
# testing the column_names method
Index: ProtocolStep.t
===================================================================
RCS file: /cvsroot/genex/genex-server/Genex/t/ProtocolStep.t,v
retrieving revision 1.2
retrieving revision 1.3
diff -C2 -d -r1.2 -r1.3
*** ProtocolStep.t 17 Apr 2003 17:58:56 -0000 1.2
--- ProtocolStep.t 23 Apr 2003 22:01:48 -0000 1.3
***************
*** 7,11 ****
# (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;
--- 7,11 ----
# (It may become useful if the test is moved to ./t subdirectory.)
! BEGIN { $| = 1; print "1..27\n"; }
END {print "not ok 1\n" unless $loaded;}
use Carp;
***************
*** 138,141 ****
--- 138,144 ----
# testing superclass Bio::Genex::Identifiable
result($obj->isa(q[Bio::Genex::Identifiable]));
+
+ # testing superclass Bio::Genex::Securable
+ result($obj->isa(q[Bio::Genex::Securable]));
# testing the column_names method
|
|
From: <jas...@us...> - 2003-04-23 21:59:02
|
Update of /cvsroot/genex/genex-server/Genex/t
In directory sc8-pr-cvs1:/tmp/cvs-serv843/t
Added Files:
ProtocolStepApplication.t Securable.t
Log Message:
new
--- NEW FILE: ProtocolStepApplication.t ---
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl ProtocolStepApplication.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..29\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::ProtocolStepApplication;
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::ProtocolStepApplication->new();
# testing the proto_step_app_pk attribute method
$obj->proto_step_app_pk(555);
result ($obj->proto_step_app_pk() == 555);
# testing the activity_date attribute method
$obj->activity_date(555);
result ($obj->activity_date() == 555);
# testing the performer_con_fk attribute method
$obj->performer_con_fk(555);
result ($obj->performer_con_fk() == 555);
# testing the protocol_step_fk attribute method
$obj->protocol_step_fk(555);
result ($obj->protocol_step_fk() == 555);
# testing the proto_app_fk attribute method
$obj->proto_app_fk(555);
result ($obj->proto_app_fk() == 555);
# testing the performer_con_obj attribute method
$obj->performer_con_obj(555);
result ($obj->performer_con_obj() == 555);
# testing the protocol_step_obj attribute method
$obj->protocol_step_obj(555);
result ($obj->protocol_step_obj() == 555);
# testing the proto_app_obj attribute method
$obj->proto_app_obj(555);
result ($obj->proto_app_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 'proto_step_app_pk');
# testing the tablename method
result($obj->tablename() eq q[ProtocolStepApplication]);
# testing the table_type method
result($obj->table_type() eq q[DATA]);
# test $LIMIT
result(!defined $Bio::Genex::ProtocolStepApplication::LIMIT);
# test $USE_CACHE
result(defined $Bio::Genex::ProtocolStepApplication::USE_CACHE);
# testing the column2name method
result(ref($obj->column2name) eq 'HASH' and
scalar keys %{$obj->column2name} >=
scalar keys %{$Bio::Genex::ProtocolStepApplication::COLUMN2NAME});
# testing the name2column method
result(ref($obj->name2column) eq 'HASH' and
scalar keys %{$obj->name2column} >=
scalar keys %{$Bio::Genex::ProtocolStepApplication::NAME2COLUMN});
# testing the fkeys method
result(ref($obj->fkeys) eq 'HASH' and
scalar keys %{$obj->fkeys} >=
scalar keys %{$Bio::Genex::ProtocolStepApplication::FKEYS});
# testing the fkey_obj2raw method
result(ref($obj->fkey_obj2raw) eq 'HASH' and
scalar keys %{$obj->fkey_obj2raw} >=
scalar keys %{$Bio::Genex::ProtocolStepApplication::FKEY_OBJ2RAW});
# testing each fkey
foreach my $fkey (values %{$Bio::Genex::ProtocolStepApplication::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::Securable
result($obj->isa(q[Bio::Genex::Securable]));
# testing the column_names method
result(ref($obj->column_names) eq 'ARRAY' and
scalar @{$obj->column_names} >=
scalar @{$Bio::Genex::ProtocolStepApplication::COLUMN_NAMES});
# testing the unique_columns method
result(ref($obj->unique_columns) eq 'ARRAY' and
scalar @{$obj->unique_columns} >=
scalar @{$Bio::Genex::ProtocolStepApplication::UNIQUE_COLUMNS});
--- NEW FILE: Securable.t ---
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl Securable.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::Securable;
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::Securable->new();
# testing the ro_groupname attribute method
$obj->ro_groupname(555);
result ($obj->ro_groupname() == 555);
# testing the rw_groupname attribute method
$obj->rw_groupname(555);
result ($obj->rw_groupname() == 555);
# testing the audit_fk attribute method
$obj->audit_fk(555);
result ($obj->audit_fk() == 555);
# testing the ro_groupname_obj attribute method
$obj->ro_groupname_obj(555);
result ($obj->ro_groupname_obj() == 555);
# testing the rw_groupname_obj attribute method
$obj->rw_groupname_obj(555);
result ($obj->rw_groupname_obj() == 555);
# testing the audit_obj attribute method
$obj->audit_obj(555);
result ($obj->audit_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(!defined $obj->pkey_name());
# testing the tablename method
result($obj->tablename() eq q[Securable]);
# testing the table_type method
result($obj->table_type() eq q[DATA]);
# test $LIMIT
result(!defined $Bio::Genex::Securable::LIMIT);
# test $USE_CACHE
result(defined $Bio::Genex::Securable::USE_CACHE);
# testing the column2name method
result(ref($obj->column2name) eq 'HASH' and
scalar keys %{$obj->column2name} >=
scalar keys %{$Bio::Genex::Securable::COLUMN2NAME});
# testing the name2column method
result(ref($obj->name2column) eq 'HASH' and
scalar keys %{$obj->name2column} >=
scalar keys %{$Bio::Genex::Securable::NAME2COLUMN});
# testing the fkeys method
result(ref($obj->fkeys) eq 'HASH' and
scalar keys %{$obj->fkeys} >=
scalar keys %{$Bio::Genex::Securable::FKEYS});
# testing the fkey_obj2raw method
result(ref($obj->fkey_obj2raw) eq 'HASH' and
scalar keys %{$obj->fkey_obj2raw} >=
scalar keys %{$Bio::Genex::Securable::FKEY_OBJ2RAW});
# testing each fkey
foreach my $fkey (values %{$Bio::Genex::Securable::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 the column_names method
result(ref($obj->column_names) eq 'ARRAY' and
scalar @{$obj->column_names} >=
scalar @{$Bio::Genex::Securable::COLUMN_NAMES});
# testing the unique_columns method
result(ref($obj->unique_columns) eq 'ARRAY' and
scalar @{$obj->unique_columns} >=
scalar @{$Bio::Genex::Securable::UNIQUE_COLUMNS});
|
|
From: <jas...@us...> - 2003-04-23 21:49:51
|
Update of /cvsroot/genex/genex-server/Genex
In directory sc8-pr-cvs1:/tmp/cvs-serv28964
Modified Files:
Genex.pm.in
Log Message:
* Genex.pm.in (Repository):
new version (2.7.20030422)
Index: Genex.pm.in
===================================================================
RCS file: /cvsroot/genex/genex-server/Genex/Genex.pm.in,v
retrieving revision 1.55
retrieving revision 1.56
diff -C2 -d -r1.55 -r1.56
*** Genex.pm.in 22 Apr 2003 00:48:57 -0000 1.55
--- Genex.pm.in 23 Apr 2003 21:49:44 -0000 1.56
***************
*** 58,62 ****
Exporter::export_ok_tags('ASSERT');
! $VERSION = '2.7.20030421';
# Preloaded methods go here.
--- 58,62 ----
Exporter::export_ok_tags('ASSERT');
! $VERSION = '2.7.20030422';
# Preloaded methods go here.
|
|
From: <jas...@us...> - 2003-04-23 21:36:49
|
Update of /cvsroot/genex/genex-server In directory sc8-pr-cvs1:/tmp/cvs-serv23759 Modified Files: MANIFEST.in Log Message: new files Index: MANIFEST.in =================================================================== RCS file: /cvsroot/genex/genex-server/MANIFEST.in,v retrieving revision 1.12 retrieving revision 1.13 diff -C2 -d -r1.12 -r1.13 *** MANIFEST.in 22 Apr 2003 01:09:10 -0000 1.12 --- MANIFEST.in 23 Apr 2003 21:36:43 -0000 1.13 *************** *** 59,62 **** --- 59,63 ---- 'Mason/workspace/protocol-insert.html' => '%%GENEX_WORKSPACE_DIR%%', 'Mason/workspace/protocol-step-insert.html' => '%%GENEX_WORKSPACE_DIR%%', + 'Mason/workspace/protocol-application-insert.html' => '%%GENEX_WORKSPACE_DIR%%', 'Mason/workspace/procedure-insert.html' => '%%GENEX_WORKSPACE_DIR%%', 'Mason/workspace/parameter-value-insert.html' => '%%GENEX_WORKSPACE_DIR%%', *************** *** 66,69 **** --- 67,72 ---- 'Mason/workspace/comps/ro_rw_group.mason' => '%%GENEX_WORKSPACE_DIR%%/comps', + 'Mason/workspace/comps/fkey-menu.mason' => '%%GENEX_WORKSPACE_DIR%%/comps', + 'Mason/workspace/comps/value-input.mason' => '%%GENEX_WORKSPACE_DIR%%/comps', 'Mason/workspace/comps/tableize.mason' => '%%GENEX_WORKSPACE_DIR%%/comps', 'Mason/workspace/comps/objs2table.mason' => '%%GENEX_WORKSPACE_DIR%%/comps', *************** *** 75,78 **** --- 78,82 ---- 'Mason/workspace/comps/g2g-request.mason' => '%%GENEX_WORKSPACE_DIR%%/comps', 'Mason/workspace/comps/hiddenlist.mason' => '%%GENEX_WORKSPACE_DIR%%/comps', + 'Mason/workspace/comps/hiddenhash.mason' => '%%GENEX_WORKSPACE_DIR%%/comps', 'Mason/workspace/comps/query-checkboxes.mason' => '%%GENEX_WORKSPACE_DIR%%/comps', 'Mason/workspace/comps/radio-group.mason' => '%%GENEX_WORKSPACE_DIR%%/comps', *************** *** 100,103 **** --- 104,109 ---- 'Genex/scripts/priveleges.pl' => '%%GENEX_BIN_DIR%%', 'Genex/scripts/protocol-insert.pl' => '%%GENEX_BIN_DIR%%', + 'Genex/scripts/protocol-application-insert.pl' => '%%GENEX_BIN_DIR%%', + 'Genex/scripts/protocol-step-application-insert.pl' => '%%GENEX_BIN_DIR%%', 'Genex/scripts/sample-insert.pl' => '%%GENEX_BIN_DIR%%', 'Genex/scripts/parameter-insert.pl' => '%%GENEX_BIN_DIR%%', |
|
From: <jas...@us...> - 2003-04-23 21:28:58
|
Update of /cvsroot/genex/genex-server/Mason/workspace
In directory sc8-pr-cvs1:/tmp/cvs-serv20297
Modified Files:
parameter-value-insert.html
Log Message:
* Mason/workspace/parameter-value-insert.html (Repository):
replaced repetitive code with new components
Index: parameter-value-insert.html
===================================================================
RCS file: /cvsroot/genex/genex-server/Mason/workspace/parameter-value-insert.html,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** parameter-value-insert.html 22 Apr 2003 01:16:11 -0000 1.1
--- parameter-value-insert.html 23 Apr 2003 21:28:54 -0000 1.2
***************
*** 9,88 ****
% } else {
- <& comps/ro_rw_group.mason, type=>"ParameterValue" &>
-
- <hr noshade size=5>
! <h2>Value</h2>
! <p>Indicates the value of this parameter in the protocol
! step. If no value is specified, the default value from the
! parameter (if any) will be used.</p>
! <table bgcolor="#D8E4F7" border="1" cols="1">
! <thead bgcolor="#FFD78F">
! <tr>
! <th>Value</th>
! </tr>
! </thead>
! <tbody>
! <tr>
! <td>
! <input type="text" name="value" size="65" maxlength="128">
! </td>
! </tr>
! </tbody>
! </table>
<hr noshade size=5>
! <h2>Protocol Step</h2>
!
! <p>Choose the <b>Protocol Step</b> to which this parameter
! value belongs.</p>
!
! <p>The entry must exist in the DB first, click
! <a href="protocol-step-insert.html">here</a> if you need to
! enter the protocol step info, then return to this page and hit
! your browsers <b>Reload</b> button.</p>
!
! <table bgcolor="#D8E4F7" border="1" cols="1">
! <thead bgcolor="#FFD78F">
! <tr>
! <th>Protocol Step</th>
! </tr>
! </thead>
! <tbody>
! <tr>
! <td>
! <& comps/query-drop-down.mason, name=>"proto_step_fk",
! array_ref=>\@protocol_steps &>
! </td>
! </tr>
! </tbody>
! </table>
<hr noshade size=5>
! <h2>Parameter</h2>
! <p>Choose the <b>Parameter</b> to which this step belongs.</p>
! <p>The entry must exist in the DB first, click
! <a href="Parameter-insert.html">here</a> if you need to
! enter the Parameter info, then return to this page and
! hit your browsers <b>Reload</b> button.</p>
! <table bgcolor="#D8E4F7" border="1" cols="1">
! <thead bgcolor="#FFD78F">
! <tr>
! <th>Parameter</th>
! </tr>
! </thead>
! <tbody>
! <tr>
! <td>
! <& comps/query-drop-down.mason, name=>"parameter_fk",
! array_ref=>\@parameters &>
! </td>
! </tr>
! </tbody>
! </table>
<hr noshade size=5>
--- 9,39 ----
% } else {
! <& comps/ro_rw_group.mason, type=>"ParameterValue" &>
<hr noshade size=5>
! <& comps/value-input.mason,
! value_name=>'Value',
! cgi_param_name=>'value',
! entry_name=>$cur_class &>
<hr noshade size=5>
! <& comps/fkey-menu.mason,
! class=>'Protocol Step',
! script=>'protocol-step-insert.html',
! cgi_param_name=>'proto_step_fk',
! array_ref=>\@protocol_steps,
! entry_name=>$cur_class &>
! <hr noshade size=5>
! <& comps/fkey-menu.mason,
! class=>'Parameter',
! script=>"parameter-insert.html",
! cgi_param_name=>'parameter_fk',
! array_ref=>\@parameters,
! entry_name=>$cur_class &>
<hr noshade size=5>
***************
*** 123,126 ****
--- 74,78 ----
my $path = $m->current_comp->attr('path');
my $action = $m->current_comp->attr('action');
+ my $cur_class = 'ParameterValue';
# Apache::DB->init;
|
|
From: <jas...@us...> - 2003-04-23 21:26:10
|
Update of /cvsroot/genex/genex-server/Genex/scripts In directory sc8-pr-cvs1:/tmp/cvs-serv18987 Modified Files: .cvsignore Log Message: usual Index: .cvsignore =================================================================== RCS file: /cvsroot/genex/genex-server/Genex/scripts/.cvsignore,v retrieving revision 1.27 retrieving revision 1.28 diff -C2 -d -r1.27 -r1.28 *** .cvsignore 21 Apr 2003 00:24:45 -0000 1.27 --- .cvsignore 23 Apr 2003 21:26:05 -0000 1.28 *************** *** 21,27 **** --- 21,30 ---- mbad-insert.pl parameter-insert.pl + parameter-value-insert.pl priveleges.pl procedure-insert.pl + protocol-application-insert.pl protocol-insert.pl + protocol-step-application-insert.pl protocol-step-insert.pl qtdim-insert.pl |
|
From: <jas...@us...> - 2003-04-23 21:24:30
|
Update of /cvsroot/genex/genex-server/Mason/workspace/comps
In directory sc8-pr-cvs1:/tmp/cvs-serv17953/comps
Added Files:
fkey-menu.mason hiddenhash.mason htmlize-fkey.mason
value-input.mason
Log Message:
new components
--- NEW FILE: fkey-menu.mason ---
<h2><% $class %></h2>
<p>Choose the <b><% $class %></b>
that will be given to the <% $entry_name %> entry you create.</p>
<p>The entry must exist in the DB first, click
<a href="<% $script %>">here</a> if you need to
enter the protocol step info, then return to this page and hit
your browsers <b>Reload</b> button.</p>
<table bgcolor="#D8E4F7" border="1" cols="1">
<thead bgcolor="#FFD78F">
<tr>
<th><% $class %></th>
</tr>
</thead>
<tbody>
<tr>
<td>
<& query-drop-down.mason, name=>$cgi_param_name, array_ref=>$array_ref &>
</td>
</tr>
</tbody>
</table>
<%args>
$entry_name
$cgi_param_name
$class
$script
$array_ref
</%args>
<%once>
</%once>
<%init>
</%init>
--- NEW FILE: hiddenhash.mason ---
% foreach my $key (keys %{$hashref}) {
% if (ref($hashref->{$key}) eq 'ARRAY') {
% foreach my $value (@{$hashref->{$key}}) {
<input type="hidden" name="<% $key %>" value="<% $value %>">
% }
% } else {
<input type="hidden" name="<% $key %>" value="<% $hashref->{$key} %>">
% }
% }
<%args>
$hashref
</%args>
<%init>
</%init>
--- NEW FILE: htmlize-fkey.mason ---
<% $result %>
<%args>
$html
$SCRIPT => "$Bio::Genex::Config->{GENEX_WORKSPACE_URL}/fetch-table.html"
$hash_ref
$debug => 0
$PARAMS => "&DEBUG=$debug&dbname=$Bio::Genex::Config->{DB_NAME}"
</%args>
<%once>
use Bio::Genex::Config;
my @fkeys = qw(us_fk
owner_us_fk
gs_fk
smp_fk
amg_fk
spc_fk
al_fk
primary_es_fk
es_fk
am_fk
image_anal_sw_fk
spotter_sw_fk
scan_sw_fk
ratio_am_fk
con_fk
provider_con_fk
prt_fk
ef_fk
tl_fk
scn_fk
sptr_fk
ams_fk
als_fk
db_name
al_fk
smp_fk
image_anal_sw_fk
scan_sw_fk
scn_fk);
my %fkeys = map {$_ => 1} @fkeys;
</%once>
<%init>;
my $result = $html;
my %args = %{$hash_ref};
# now process each of the keys individually
foreach (keys %args) {
# get around the ugly HTML table default
my $space = ' ';
$args{$_} = $space unless defined $args{$_} && $args{$_} !~ m/^\s*$/;
if (/^login$/ || /^password$/) {
# we do not show login names or passwords
$args{$_} = ' ';
next;
}
my $pkey = $args{$_};
next unless defined $pkey;
next if $pkey eq $space;
if (/email$/) {
# assume for now it's a correct email address
$args{$_} = $cgi->a({-href=>"mailto:$pkey"},$pkey);
next;
}
if (/url/) {
# assume for now it's a correct URL
$args{$_} = $cgi->a({-href=>"$pkey"},$pkey);
next;
}
# ensure we handle this foreign key
next unless $fkeys{$_};
# the following all create hyperlinks to other tables
# now postprocess the key
my ($text,$table);
my $error = 0;
if (/con_fk$/) {
$table = 'Contact';
my $class = 'Bio::Genex::' . $table;
eval "require $class";
die "$@" if $@;
my $contact = Bio::Genex::Contact->new(dbh=>$dbh,id=>$pkey);
unless (defined $contact) {
$error = 1;
goto ERROR;
}
$text = $contact->contact_person();
# Use the organization if no contact person is specified
$text = $contact->organization() unless defined $text;
} elsif (/^(owner_us_fk|us_fk)$/) {
$table = 'UserSec';
my $class = 'Bio::Genex::' . $table;
eval "require $class";
die "$@" if $@;
# we don't show login's so we use the 'contact_person' field of
# the associated Bio::Genex::Contact object
my $user = Bio::Genex::UserSec->new(dbh=>$dbh,id=>$pkey);
unless (defined $user) {
$error = 1;
goto ERROR;
}
if (defined $user->con_obj && $user->con_obj->isa('Bio::Genex::Contact')) {
$text = $user->con_obj->contact_person();
} else {
$text = 'Not Available';
}
} elsif (/spc_fk/) {
$table = 'Species';
my $class = 'Bio::Genex::' . $table;
eval "require $class";
die "$@" if $@;
my $species = Bio::Genex::Species->new(dbh=>$dbh,id=>$pkey);
unless (defined $species) {
$error = 1;
goto ERROR;
}
$text = $species->primary_scientific_name();
} elsif (/al_fk/) {
$table = 'ArrayLayout';
my $class = 'Bio::Genex::' . $table;
eval "require $class";
die "$@" if $@;
my $layout = Bio::Genex::ArrayLayout->new(dbh=>$dbh,id=>$pkey);
unless (defined $layout) {
$error = 1;
goto ERROR;
}
$text = $layout->name();
} elsif (/^scn_fk$/) {
$table = 'Scanner';
my $class = 'Bio::Genex::' . $table;
eval "require $class";
die "$@" if $@;
my $scnr_db = $class->new(dbh=>$dbh,id=>$pkey);
unless (defined $scnr_db) {
$error = 1;
goto ERROR;
}
$text = $scnr_db->model_description();
} elsif (/^ef_fk$/) {
$table = 'ExperimentFactors';
my $class = 'Bio::Genex::' . $table;
eval "require $class";
die "$@" if $@;
my $ef_db = $class->new(dbh=>$dbh,id=>$pkey);
unless (defined $ef_db) {
$error = 1;
goto ERROR;
}
$text = $ef_db->es_obj->name() . ':' .$ef_db->factor_name();
} elsif (/^als_fk$/) {
$table = 'Feature';
my $class = 'Bio::Genex::' . $table;
eval "require $class";
die "$@" if $@;
my $als_db = $class->new(dbh=>$dbh,id=>$pkey);
unless (defined $als_db) {
$error = 1;
goto ERROR;
}
$text = $als_db->al_obj->name() . ':' .$als_db->spot_identifier();
} elsif (/^ams_fk$/) {
$table = 'AM_Spots';
my $class = 'Bio::Genex::' . $table;
eval "require $class";
die "$@" if $@;
my $ams_db = $class->new(dbh=>$dbh,id=>$pkey);
unless (defined $ams_db) {
$error = 1;
goto ERROR;
}
my $spot_name;
if (defined $ams_db->usf_obj) {
$spot_name = $ams_db->usf_obj->usf_name();
} else {
$spot_name = $ams_db->ams_pk();
}
$text = $ams_db->am_obj->name() . ':' . $spot_name;
} elsif (/^sptr_fk$/) {
$table = 'Spotter';
my $class = 'Bio::Genex::' . $table;
eval "require $class";
die "$@" if $@;
my $sptr_db = $class->new(dbh=>$dbh,id=>$pkey);
unless (defined $sptr_db) {
$error = 1;
goto ERROR;
}
$text = $sptr_db->model_description();
} elsif (/^(image_anal_sw_fk|spotter_sw_fk|scan_sw_fk)$/) {
$table = 'Software';
my $class = 'Bio::Genex::' . $table;
eval "require $class";
die "$@" if $@;
my $sw_db = $class->new(dbh=>$dbh,id=>$pkey);
unless (defined $sw_db) {
$error = 1;
goto ERROR;
}
$text = $sw_db->name();
} elsif (/^tl_fk$/) {
$table = 'TreatmentLevel';
my $class = 'Bio::Genex::' . $table;
eval "require $class";
die "$@" if $@;
my $tl_db = $class->new(dbh=>$dbh,id=>$pkey);
unless (defined $tl_db) {
$error = 1;
goto ERROR;
}
$text = $tl_db->name();
} elsif (/^(primary_es_fk|es_fk)$/) {
$table = 'ExperimentSet';
my $class = 'Bio::Genex::' . $table;
eval "require $class";
die "$@" if $@;
my $es_db = $class->new(dbh=>$dbh,id=>$pkey);
unless (defined $es_db) {
$error = 1;
goto ERROR;
}
$text = $es_db->name();
} elsif (/^db_name$/) {
$table = 'ExternalDatabase';
my $class = 'Bio::Genex::' . $table;
eval "require $class";
die "$@" if $@;
my $db = $class->new(dbh=>$dbh,id=>$pkey);
unless (defined $db) {
$error = 1;
goto ERROR;
}
$text = $db->name();
} elsif (/^(ratio_am_fk|am_fk)$/) {
$table = 'ArrayMeasurement';
my $class = 'Bio::Genex::' . $table;
eval "require $class";
die "$@" if $@;
my $am_db = $class->new(dbh=>$dbh,id=>$pkey);
unless (defined $am_db) {
$error = 1;
goto ERROR;
}
$text = $am_db->name();
} elsif (/^smp_fk$/) {
$table = 'Sample';
my $class = 'Bio::Genex::' . $table;
eval "require $class";
die "$@" if $@;
my $smp_db = $class->new(dbh=>$dbh,id=>$pkey);
unless (defined $smp_db) {
$error = 1;
goto ERROR;
}
# what do we do about Sample???
$text = $smp_db->strain();
} elsif (/^prt_fk$/) {
$table = 'Protocol';
my $class = 'Bio::Genex::' . $table;
eval "require $class";
die "$@" if $@;
my $prt_db = $class->new(dbh=>$dbh,id=>$pkey);
unless (defined $prt_db) {
$error = 1;
goto ERROR;
}
$text = $prt_db->title();
} elsif (/gs_fk/) {
$table = 'GroupSec';
my $class = 'Bio::Genex::' . $table;
eval "require $class";
die "$@" if $@;
my $group = Bio::Genex::GroupSec->new(dbh=>$dbh,id=>$pkey);
unless (defined $group) {
$error = 1;
goto ERROR;
}
$text = $group->group_name();
} elsif (/cit_fk/) {
$table = 'Citation';
my $class = 'Bio::Genex::' . $table;
eval "require $class";
die "$@" if $@;
my $citation = Bio::Genex::Citation->new(dbh=>$dbh,id=>$pkey);
unless (defined $citation) {
$error = 1;
goto ERROR;
}
$text = $citation->title();
}
#
# This is the format line. If you want to change the output,
# change it here
#
$PARAMS .= "&AccessionNumber=$pkey";
$args{$_} = $cgi->a({-href=>"$CGIURL/$SCRIPT?table=${table}$PARAMS"},
$text . "($pkey)");
}
</%init>
--- NEW FILE: value-input.mason ---
<h2><% $value_name %></h2>
<p>Choose the <b><% $value_name %></b> that will be given to the
<% $entry_name %> entry you create.</p>
<table bgcolor="#D8E4F7" border="1" cols="1">
<thead bgcolor="#FFD78F">
<tr>
<th><% $value_name %></th>
</tr>
</thead>
<tbody>
<tr>
<td>
<input type="text" name="<% $cgi_param_name %>"
value="<% $default_value %>"
size="<% $size %>" maxlength="<% $maxlength %>">
</td>
</tr>
</tbody>
</table>
<%args>
$entry_name
$cgi_param_name
$value_name
$default_value => ''
$size => 65
$maxlength => 128
</%args>
<%once>
</%once>
<%init>
</%init>
|
|
From: <jas...@us...> - 2003-04-23 21:24:27
|
Update of /cvsroot/genex/genex-server/Genex/scripts
In directory sc8-pr-cvs1:/tmp/cvs-serv18152
Modified Files:
make_classes.pl
Log Message:
added new classes
Index: make_classes.pl
===================================================================
RCS file: /cvsroot/genex/genex-server/Genex/scripts/make_classes.pl,v
retrieving revision 1.30
retrieving revision 1.31
diff -C2 -d -r1.30 -r1.31
*** make_classes.pl 17 Apr 2003 17:55:34 -0000 1.30
--- make_classes.pl 23 Apr 2003 21:24:23 -0000 1.31
***************
*** 91,94 ****
--- 91,99 ----
+ # the abstract classes
+ {target=>'Parameterizable'},
+ {target=>'Identifiable'},
+ {target=>'Securable'},
+
# simple classes with no supporting tables
{target=>'Array'},
***************
*** 98,103 ****
{target=>'Protocol'},
{target=>'ProtocolApplication'},
{target=>'Procedure'},
- {target=>'Parameterizable'},
{target=>'Hardware'},
{target=>'MeasuredBioAssay'},
--- 103,108 ----
{target=>'Protocol'},
{target=>'ProtocolApplication'},
+ {target=>'ProtocolStepApplication'},
{target=>'Procedure'},
{target=>'Hardware'},
{target=>'MeasuredBioAssay'},
***************
*** 105,109 ****
{target=>'Audit'},
{target=>'FeatureExtractionSoftware'},
- {target=>'Identifiable'},
{target=>'Feature'},
{target=>'ContactType'},
--- 110,113 ----
***************
*** 130,134 ****
# view classes
# {target=>'Provider'},
!
# controlled vocabular classes
{target=>'ControlledVocab',
--- 134,138 ----
# view classes
# {target=>'Provider'},
!
# controlled vocabular classes
{target=>'ControlledVocab',
|
|
From: <jas...@us...> - 2003-04-23 21:22:44
|
Update of /cvsroot/genex/genex-server/Mason/workspace/comps
In directory sc8-pr-cvs1:/tmp/cvs-serv17511/comps
Modified Files:
ro_rw_group.mason
Log Message:
* Mason/workspace/comps/ro_rw_group.mason (Repository):
added the ability to set default groups for each menu
Index: ro_rw_group.mason
===================================================================
RCS file: /cvsroot/genex/genex-server/Mason/workspace/comps/ro_rw_group.mason,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** ro_rw_group.mason 21 Apr 2003 00:25:47 -0000 1.1
--- ro_rw_group.mason 23 Apr 2003 21:22:40 -0000 1.2
***************
*** 15,23 ****
<td>
<& query-drop-down.mason, name=>"read_group",
! array_ref=>\@groups &>
</td>
<td>
<& query-drop-down.mason, name=>"write_group",
! array_ref=>\@groups &>
</td>
</tr>
--- 15,23 ----
<td>
<& query-drop-down.mason, name=>"read_group",
! array_ref=>\@read_groups &>
</td>
<td>
<& query-drop-down.mason, name=>"write_group",
! array_ref=>\@write_groups &>
</td>
</tr>
***************
*** 27,41 ****
<%args>
$type
</%args>
<%once>
use Bio::Genex::GroupSec;
</%once>
! <%init>
! my @groups;
! my @gs_dbs = Bio::Genex::GroupSec->get_all_objects($dbh);
! foreach my $gs_db (@gs_dbs) {
! push(@groups,[$gs_db->name,$gs_db->name]);
! }
</%init>
--- 27,54 ----
<%args>
$type
+ $ro_default => ''
+ $rw_default => ''
</%args>
<%once>
use Bio::Genex::GroupSec;
</%once>
! <%init>;
! my @read_groups;
! my @write_groups;
! my @gs_dbs = Bio::Genex::GroupSec->get_all_objects($dbh);
! foreach my $gs_db (@gs_dbs) {
! push(@read_groups,[$gs_db->name,$gs_db->name]);
! }
! @write_groups = @read_groups;
!
! # now put the default values first on the lists if we've been
! # given default values
! if ($ro_default) {
! @read_groups = sort {$a->[0] eq $ro_default ? -1 : 1 } @read_groups;
! }
! if ($rw_default) {
! @write_groups = sort {$a->[0] eq $rw_default ? -1 : 1 } @write_groups;
! }
</%init>
|
|
From: <jas...@us...> - 2003-04-23 21:22:28
|
Update of /cvsroot/genex/genex-server/Genex/scripts
In directory sc8-pr-cvs1:/tmp/cvs-serv17339
Added Files:
protocol-application-insert.pl.in
protocol-step-application-insert.pl.in
Log Message:
new insertion apps
--- NEW FILE: protocol-application-insert.pl.in ---
%%START_PERL%%
#
# protocol-application-insert.pl.in
# first version Tue Oct 24 14:13:45 MST 2000
# script for inserting parameter value entries into genex DB
#
# author: Jason E. Stewart (ja...@op...)
# Copyright 2003 Jason E. Stewart
#
my $VERSION = '$Id: protocol-application-insert.pl.in,v 1.1 2003/04/23 21:22:23 jason_e_stewart Exp $ ';
use strict;
use Carp;
use Getopt::Long;
use File::Basename;
%%GENEX_EXTRALIBS%%
# use blib;
use Bio::Genex qw(error);
use Bio::Genex::XMLUtils;
use Bio::Genex::Protocol;
use Bio::Genex::ProtocolApplication;
use Bio::Genex::Contact;
use Bio::Genex::Config;
use Bio::Genex::GenexAdmin;
$Bio::Genex::GenexAdmin::DEBUG = 1;
$Bio::Genex::ProtocolApplication::DEBUG = 1;
my $infile;
my %OPTIONS;
$OPTIONS{dbname} = $Bio::Genex::Connect::DBNAME;
$OPTIONS{ro_groupname} = 'public';
$OPTIONS{rw_groupname} = 'superuser';
my $rc = GetOptions(\%OPTIONS,
'dbname=s',
'activity_date=s',
'protocol_fk=i',
'performer_con_fk=i',
'ro_groupname=s',
'rw_groupname=s',
'username=s',
'password=s',
'help',
'debug',
);
my $USAGE = <<"EOU";
usage: $0 [required flags] [options]
required flags:
--protocol_fk=num : the protocol step foreign key
--username=name : the DB username to login as
--password=word : the DB password to login with
--activity_date=date : the date this protocol was performed
--performer_con_fk=num : who performed the protocol
optional parameters:
--dbname=name : the name of the DB to create
--ro_groupname=name : the name of the read-only group to use
--rw_groupname=name : the name of the read-write group to use
--debug : rollback instead of commit
--help : print this message
EOU
die "Bad option\n$USAGE" unless $rc;
die $USAGE if exists $OPTIONS{help};
die "Must specify --username\n$USAGE"
unless exists $OPTIONS{username};
die "Must specify --password\n$USAGE"
unless exists $OPTIONS{password};
# 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);
die "Must specify --protocol_fk\n$USAGE"
unless exists $OPTIONS{protocol_fk};
die "Must specify --activity_date\n$USAGE"
unless exists $OPTIONS{activity_date};
die "Must specify --performer_con_fk\n$USAGE"
unless exists $OPTIONS{performer_con_fk};
my ($ro_group_db) = 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_db;
my ($rw_group_db) = 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_db;
my $pa_db = Bio::Genex::ProtocolApplication->new(ro_groupname_obj=>$ro_group_db,
rw_groupname_obj=>$rw_group_db,
activity_date=>$OPTIONS{activity_date},
);
# handle the required fkeys
my ($proto_db) = Bio::Genex::Protocol->get_all_objects($dbh,
column=>'protocol_pk',
value=>$OPTIONS{protocol_fk},
);
$dbh->error(@error_args,
no_errstr=>1,
message=>"Couldn't locate Protocol entry for value: $OPTIONS{protocol_fk}")
unless defined $proto_db;
$pa_db->protocol_obj($proto_db);
my ($con_db) = Bio::Genex::Contact->get_all_objects($dbh,
column=>'con_pk',
value=>$OPTIONS{performer_con_fk},
);
$dbh->error(@error_args,
no_errstr=>1,
message=>"Couldn't locate Contact entry for value: $OPTIONS{performer_con_fk}")
unless defined $con_db;
$pa_db->performer_con_obj($con_db);
print STDERR "Adding ProtocolApplication info\n";
my $pk = $pa_db->insert_db($dbh);
$dbh->error(@error_args,
message=>"Couldn't insert ProtocolApplication",
) if $dbh->err;
print STDOUT "$pk\n";
print STDERR "Finished\n";
if (exists $OPTIONS{debug}) {
$dbh->rollback();
} else {
$dbh->commit();
}
$dbh->disconnect();
exit(0);
--- NEW FILE: protocol-step-application-insert.pl.in ---
%%START_PERL%%
#
# protocol-application-insert.pl.in
# first version Tue Oct 24 14:13:45 MST 2000
# script for inserting parameter value entries into genex DB
#
# author: Jason E. Stewart (ja...@op...)
# Copyright 2003 Jason E. Stewart
#
my $VERSION = '$Id: protocol-step-application-insert.pl.in,v 1.1 2003/04/23 21:22:24 jason_e_stewart Exp $ ';
use strict;
use Carp;
use Getopt::Long;
use File::Basename;
%%GENEX_EXTRALIBS%%
# use blib;
use Bio::Genex qw(error);
use Bio::Genex::XMLUtils;
use Bio::Genex::Protocol;
use Bio::Genex::ProtocolApplication;
use Bio::Genex::ProtocolStepApplication;
use Bio::Genex::Contact;
use Bio::Genex::Config;
use Bio::Genex::GenexAdmin;
$Bio::Genex::GenexAdmin::DEBUG = 1;
$Bio::Genex::ProtocolStepApplication::DEBUG = 1;
my $infile;
my %OPTIONS;
$OPTIONS{dbname} = $Bio::Genex::Connect::DBNAME;
$OPTIONS{ro_groupname} = 'public';
$OPTIONS{rw_groupname} = 'superuser';
my $rc = GetOptions(\%OPTIONS,
'dbname=s',
'activity_date=s',
'proto_step_fk=i',
'proto_app_fk=i',
'performer_con_fk=i',
'ro_groupname=s',
'rw_groupname=s',
'username=s',
'password=s',
'help',
'debug',
);
my $USAGE = <<"EOU";
usage: $0 [required flags] [options]
required flags:
--proto_step_fk=num : the protocol step foreign key
--username=name : the DB username to login as
--password=word : the DB password to login with
--activity_date=date : the date this protocol was performed
--performer_con_fk=num : who performed the protocol
optional parameters:
--dbname=name : the name of the DB to create
--ro_groupname=name : the name of the read-only group to use
--rw_groupname=name : the name of the read-write group to use
--debug : rollback instead of commit
--help : print this message
EOU
die "Bad option\n$USAGE" unless $rc;
die $USAGE if exists $OPTIONS{help};
die "Must specify --username\n$USAGE"
unless exists $OPTIONS{username};
die "Must specify --password\n$USAGE"
unless exists $OPTIONS{password};
# 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);
die "Must specify --proto_step_fk\n$USAGE"
unless exists $OPTIONS{proto_step_fk};
die "Must specify --proto_app_fk\n$USAGE"
unless exists $OPTIONS{proto_app_fk};
die "Must specify --activity_date\n$USAGE"
unless exists $OPTIONS{activity_date};
die "Must specify --performer_con_fk\n$USAGE"
unless exists $OPTIONS{performer_con_fk};
my ($ro_group_db) = 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_db;
my ($rw_group_db) = 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_db;
my $psa_db = Bio::Genex::ProtocolStepApplication->new(ro_groupname_obj=>$ro_group_db,
rw_groupname_obj=>$rw_group_db,
activity_date=>$OPTIONS{activity_date},
);
# handle the required fkeys
my ($proto_step_db) = Bio::Genex::ProtocolStep->get_all_objects($dbh,
column=>'proto_step_pk',
value=>$OPTIONS{proto_step_fk},
);
$dbh->error(@error_args,
no_errstr=>1,
message=>"Couldn't locate ProtocolStep entry for value: $OPTIONS{proto_step_fk}")
unless defined $proto_step_db;
$psa_db->protocol_step_obj($proto_step_db);
my ($proto_app_db) = Bio::Genex::ProtocolApplication->get_all_objects($dbh,
column=>'proto_app_pk',
value=>$OPTIONS{proto_app_fk},
);
$dbh->error(@error_args,
no_errstr=>1,
message=>"Couldn't locate ProtocolApplication entry for value: $OPTIONS{proto_step_fk}")
unless defined $proto_app_db;
$psa_db->proto_app_obj($proto_app_db);
my ($con_db) = Bio::Genex::Contact->get_all_objects($dbh,
column=>'con_pk',
value=>$OPTIONS{performer_con_fk},
);
$dbh->error(@error_args,
no_errstr=>1,
message=>"Couldn't locate Contact entry for value: $OPTIONS{performer_con_fk}")
unless defined $con_db;
$psa_db->performer_con_obj($con_db);
print STDERR "Adding ProtocolStepApplication info\n";
my $pk = $psa_db->insert_db($dbh);
$dbh->error(@error_args,
message=>"Couldn't insert ProtocolStepApplication",
) if $dbh->err;
print STDOUT "$pk\n";
print STDERR "Finished\n";
if (exists $OPTIONS{debug}) {
$dbh->rollback();
} else {
$dbh->commit();
}
$dbh->disconnect();
exit(0);
|
|
From: <jas...@us...> - 2003-04-23 21:21:53
|
Update of /cvsroot/genex/genex-server/Mason/workspace
In directory sc8-pr-cvs1:/tmp/cvs-serv17127
Modified Files:
protocol-application-insert.html
Log Message:
* Mason/workspace/protocol-application-insert.html (Repository):
Added a better introduction message
Index: protocol-application-insert.html
===================================================================
RCS file: /cvsroot/genex/genex-server/Mason/workspace/protocol-application-insert.html,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** protocol-application-insert.html 23 Apr 2003 21:19:17 -0000 1.1
--- protocol-application-insert.html 23 Apr 2003 21:21:49 -0000 1.2
***************
*** 104,107 ****
--- 104,111 ----
<h2>Choose a Protocol</h2>
+ <p>This tool will allow you to enter Protocol Application for a
+ Protocol in Genex, as well as ProtocolStepApplication's for the
+ protocol (in case the performer Contact and activity dates for
+ the steps are different than that of the overall protocol).</p>
<p>In order to enter the Protocol Application, your must first choose
the protocol entry which is being applied</p>
|
|
From: <jas...@us...> - 2003-04-23 21:19:21
|
Update of /cvsroot/genex/genex-server/Mason/workspace
In directory sc8-pr-cvs1:/tmp/cvs-serv16007
Added Files:
protocol-application-insert.html
Log Message:
GUI for both ProtocolApplication and ProtocolStepApplication
--- NEW FILE: protocol-application-insert.html ---
<h1 align="center"><% $name %></h1>
<form action="<% $action %>"
method="post" enctype="multipart/form-data">
<div align="center">
% if ($error) {
<% $data %>
% } elsif ($submit_proto_app_steps) {
<h2><% $data %></h2>
% } elsif ($proto_app_pk) {
<h2><% $data %></h2>
<h2>Creating Application Events for Steps of Protocol <% $protocol_name %></h2>
<p>If the activity dates or the contacts who performed
the steps are different then that of the overall
protocol you can modify them here</p>
% foreach my $proto_step_db (sort {$a->order <=> $b->order} @protocol_step_dbs) {
% my $order = $proto_step_db->order;
<hr noshade size=5>
<table border="1" width="80%" bgcolor="#FFD78F">
<thead align="center" bgcolor="#D8E4F7">
<th>
<h2>Choose the info for step number <% $order %></h2>
</th>
</thead>
<tr align="center">
<td>
<& comps/ro_rw_group.mason,
ro_default=>$read_group,
rw_default=>$write_group,
type=>"ProtocolStepApplication" &>
</td>
</tr>
<tr align="center">
<td>
<& comps/fkey-menu.mason,
class=>'Contact',
script=>'contact-insert.html',
cgi_param_name=>"step_performer_con_fk",
array_ref=>\@contacts,
entry_name=>$cur_class &>
</td>
</tr>
<tr align="center">
<td>
<& comps/value-input.mason,
value_name=>'Activity Date',
default_value=>$activity_date,
cgi_param_name=>"step_activity_date",
entry_name=>$cur_class &>
</td>
</tr>
</table>
% }
<hr noshade size=5>
<input type="submit" name="submit_proto_app_steps"
value="Create Protocol Step Applications" size="33">
<& comps/hiddenhash.mason, hashref=>\%hidden &>
<hr noshade size=5>
% } elsif ($protocol_fk) {
<h2>Creating Application Event for Protocol <% $protocol_name %></h2>
<& comps/ro_rw_group.mason, type=>"ProtocolApplication" &>
<hr noshade size=5>
<& comps/fkey-menu.mason,
class=>'Contact',
script=>'contact-insert.html',
cgi_param_name=>'performer_con_fk',
array_ref=>\@contacts,
entry_name=>$cur_class &>
<hr noshade size=5>
<& comps/value-input.mason,
value_name=>'Activity Date',
cgi_param_name=>'activity_date',
entry_name=>$cur_class &>
<hr noshade size=5>
<input type="submit" name="submit_proto_app"
value="Create Protocol Application" size="33">
<& comps/hiddenhash.mason, hashref=>\%hidden &>
<hr noshade size=5>
% } else {
<h2>Choose a Protocol</h2>
<p>In order to enter the Protocol Application, your must first choose
the protocol entry which is being applied</p>
<p>Then you will have the opportunity to create seperate events
for each of the Protocol Steps</p>
<hr noshade size=5>
<& comps/fkey-menu.mason,
class=>'Protocol',
script=>'protocol-insert.html',
cgi_param_name=>'protocol_fk',
array_ref=>\@protocols,
entry_name=>$cur_class &>
<hr noshade size=5>
<input type="submit" name="submit_protocol"
value="Choose Protocol" size="33">
<& comps/hiddenhash.mason, hashref=>\%hidden &>
<hr noshade size=5>
% }
</div>
</form>
<%args>
$debug => 0
$submit_protocol => ''
$submit_proto_app => ''
$submit_proto_app_steps => ''
$read_group => ''
$write_group => ''
$performer_con_fk => ''
$activity_date => ''
$step_performer_con_fk => ''
$step_activity_date => ''
$step_pks => ''
$proto_app_pk => ''
$protocol_fk => ''
$parameter_fk => ''
</%args>
<%attr>
action=>"$Bio::Genex::Config->{GENEX_WORKSPACE_URL}/protocol-application-insert.html"
name=>'GeneX DB Protocol Application Creation Page'
path=>"$Bio::Genex::Config->{GENEX_WORKSPACE_URL}/protocol-application-insert.html"
</%attr>
<%once>
use Date::Manip;
use Bio::Genex;
use Bio::Genex::Config;
use Bio::Genex::ProtocolStep;
use Bio::Genex::ProtocolApplication;
use Bio::Genex::Protocol;
# use Apache::DB ();
</%once>
<%init>;
my $name = $m->current_comp->attr('name');
my $path = $m->current_comp->attr('path');
my $action = $m->current_comp->attr('action');
my $cur_class = 'ProtocolApplication';
my $other_class = 'ProtocolStepApplication';
# Apache::DB->init;
# Apache::DB->handler;
my $no_type = 'NONE';
my @protocol_step_dbs;
my @protocols;
my @contacts;
my $protocol_name;
my %hidden;
my $error;
my $data = '';
my @con_dbs = Bio::Genex::Contact->get_all_objects($dbh);
foreach my $con_db (@con_dbs) {
push(@contacts,[$con_db->con_pk,'[' . $con_db->contact_person .
":" . $con_db->organization . ']']);
}
if ($performer_con_fk) {
# sort the contacts so that the performer chosen for the overall
# protocol application show up as the default value for the
# steps
@contacts = sort {$a->[0] == $performer_con_fk ? -1 : 1 } @contacts;
}
if ($submit_protocol) {
my $protocol_db = Bio::Genex::Protocol->new(dbh=>$dbh, id=>$protocol_fk);
$protocol_name = $protocol_db->name;
%hidden = (debug=>$debug,
protocol_fk=>$protocol_fk,
protocol_name=>$protocol_name);
} elsif ($submit_proto_app_steps) {
# we have a list of primary keys for the steps that comes
# through the hidden values
my @step_pks;
my $cmd = "$Bio::Genex::Config->{GENEX_BIN_DIR}/protocol-step-application-insert.pl";
my @common_args = ("--user='$session->{username}'",
"--password='$session->{password}'",
"--dbname='$session->{dbname}'",
"--proto_app_fk='$proto_app_pk'",
);
for (my $i=0;$i<scalar @{$step_pks};$i++) {
# we ensure that the date is how we want it to be
my $step_activity_date = UnixDate(ParseDate($step_activity_date->[$i]),
'%Y-%m-%d %H:%M:%S');
unless ($step_activity_date) {
$error = 1;
$data = <<EOE;
<p>Required Parameter <b>Activity Date</b> for Protocol Step
$step_pks->[$i] not specified or contained an invalid date specification.</p>
EOE
goto ERROR;
}
my @args;
push(@args,"--proto_step_fk='$step_pks->[$i]'");
push(@args,"--ro_groupname='$read_group->[$i]'");
push(@args,"--rw_groupname='$write_group->[$i]'");
push(@args,"--performer_con_fk='$step_performer_con_fk->[$i]'");
push(@args,"--activity_date='$step_activity_date'");
my $command = join(' ', $cmd, @common_args,@args);
push(@step_pks,`$command`);
if ($?) {
$error = 1;
$data = <<EOE;
<p>Executing $command</p>
<p>Error output = <$!></p>
EOE
goto ERROR;
}
}
$data = "Protocol Application Steps Successfully Created, with primary keys: ";
$data .= join(' ', @step_pks);
} elsif ($submit_proto_app) {
if ($activity_date) {
# we ensure that the date is how we want it to be
$activity_date = UnixDate(ParseDate($activity_date),
'%Y-%m-%d %H:%M:%S');
}
unless ($activity_date) {
$error = 1;
$data = <<EOE;
<p>Required Parameter <b>Activity Date</b> not specified or contained
an invalid date specification.</p>
EOE
goto ERROR;
}
my $cmd = "$Bio::Genex::Config->{GENEX_BIN_DIR}/protocol-application-insert.pl";
my @args = ("--user='$session->{username}'",
"--password='$session->{password}'",
"--dbname='$session->{dbname}'",
"--ro_group='$read_group'",
"--rw_group='$write_group'",
"--protocol_fk='$protocol_fk'",
"--performer_con_fk='$performer_con_fk'",
"--activity_date='$activity_date'",
);
my $command = join(' ', $cmd, @args);
$proto_app_pk = `$command`;
if ($?) {
$error = 1;
$data = <<EOE;
<p>Executing $command</p>
<p>Error output = <$!></p>
EOE
goto ERROR;
} else {
$data = "Protocol Application Successfully Created, with primary key: $proto_app_pk";
@protocol_step_dbs = Bio::Genex::ProtocolStep->get_all_objects($dbh,
column=>'protocol_fk',
value=>$protocol_fk,
);
%hidden = (debug=>$debug,
protocol_fk=>$protocol_fk,
proto_app_pk=>$proto_app_pk,
protocol_name=>$protocol_name,
performer_con_fk=>$performer_con_fk,
step_pks=>[map {$_->proto_step_pk} @protocol_step_dbs],
activity_date=>$activity_date);
}
} else {
%hidden = (debug=>$debug);
my @proto_dbs = Bio::Genex::Protocol->get_all_objects($dbh);
foreach my $proto_db (@proto_dbs) {
push(@protocols,[$proto_db->protocol_pk,
join(':',
$proto_db->name,
$proto_db->type,)
]);
}
}
ERROR : {
$data = qq[<font color="red"><h2>ERROR</h2><b>$data</b></font>]
if $error;
}
</%init>
|
|
From: <jas...@us...> - 2003-04-23 21:17:40
|
Update of /cvsroot/genex/genex-server/Mason/workspace
In directory sc8-pr-cvs1:/tmp/cvs-serv15318
Modified Files:
index.html
Log Message:
new files
Index: index.html
===================================================================
RCS file: /cvsroot/genex/genex-server/Mason/workspace/index.html,v
retrieving revision 1.8
retrieving revision 1.9
diff -C2 -d -r1.8 -r1.9
*** index.html 22 Apr 2003 01:16:46 -0000 1.8
--- index.html 23 Apr 2003 21:17:36 -0000 1.9
***************
*** 36,39 ****
--- 36,40 ----
<li><a href="protocol-insert.html">protocol-insert.html</a></li>
<li><a href="protocol-step-insert.html">protocol-step-insert.html</a></li>
+ <li><a href="protocol-application-insert.html">protocol-application-insert.html</a></li>
<li><a href="procedure-insert.html">procedure-insert.html</a></li>
<li><a href="sample-insert.html">sample-insert.html</a></li>
|
