ViewVC Help
View File | Revision Log | Show Annotations | Root Listing
root/Genquire/das.cfg
Revision: 1.2
Committed: Tue Jan 15 20:29:47 2002 UTC (14 years, 5 months ago) by markw
Branch: MAIN
CVS Tags: Release4, HEAD_NEW, HEAD
Changes since 1.1: +10 -2 lines
Log Message:
slight changes to the bulk_parse_contigs script, the code documentation, and the Context objects

Line File contents
1 use lib "/home/markw/BIOPERL/bioperl/bioperl-live";
2 use Tk;
3 use Tk::widgets qw(BrowseEntry);
4 use Bio::Das;
5 use LWP::UserAgent;
6
7 # need to wipe out what is already there
8 $Username = "";
9 $Password = "";
10 $IPAddress = "";
11 $Filename = "";
12
13
14 my $ua = new LWP::UserAgent;
15 my $req = new HTTP::Request GET => 'http://www.tigr.org/tdb/DAS/das_server_list.html';
16 my $res = $ua->request($req);
17 my @hosts;
18 if ($res->is_success) {
19 my $resp = $res->content;
20 @hosts = ($resp =~ /<p><a href="(.*?)">/g);
21 }
22
23 unless ($hosts[0]){
24 warn "unable to determine any DAS hosts from TIGR list at http://www.tigr.org/tdb/DAS/das_server_list.html\n";
25 return 0;
26 }
27
28 my $organism;
29 my $context;
30
31 my $dasmw = MainWindow->new;
32 my $sysms= "Begin searching for DAS servers";
33 my $msg = $dasmw->Label(-textvariable => \$sysms)->pack(-side => 'top');
34 my $btn1 = $dasmw->Button (
35 -text => "OK",
36 )->pack(-side => 'top');
37
38 my $btn2 = $dasmw->Button (
39 -text => "Exit",
40 -command => sub {
41 $dasmw->destroy;
42 return 0;
43 }
44 )->pack(-side => 'top');
45
46 $btn1->configure ( -command => sub {
47 $btn1->packForget;
48 $btn2->packForget;
49 $sysms = "SEARCHING.... please wait...";
50 $msg->update;
51 getChoices(@hosts, \$organism);
52 $sysms = "Please select a DAS source from the list below";
53 }
54 );
55
56 $dasmw->Popup;
57 $dasmw->focus;
58 $dasmw->waitVariable(\$context);
59 $dasmw->destroy;
60
61
62 sub getChoices {
63 my (@hosts, $organism) = @_;
64
65 my $choice = $dasmw->BrowseEntry(
66 -width => 50,
67 -listwidth => 400,
68 -variable => \$organism,
69 )->pack (-side => 'top');
70
71 my $btn = $dasmw->Button (
72 -text => "OK",
73 -command => sub {
74 print "Organism $organism\n";
75 $IPAddress = (($organism =~ /@(.*)$/) && $1);
76 $context = 1;
77 }
78 )->pack(-side => 'top');
79
80
81 foreach $host(@hosts){
82 my $db = Bio::Das->new($host);
83 foreach my $source($db->sources){
84 $choice->insert(1, ("".($source->name)." @".$host));
85 }
86 }
87 }