BioGeek has asked for the wisdom of the Perl Monks concerning the following question:
#usr/bin/perl -T use strict; use warnings; use diagnostics; use LWP; use DBI; use Data::Dumper; ######################## # Let user make a choice ######################## TOP: print "Typ the number of the disease you want the\n"; print "genes to be calculated and compared of.\n"; print "1\tAlzheimer disease (5, 6)\n"; print "2\tBardet Biedl (syndrome 1, 2, 3, 5)\n"; print "3\tBreast cancer (type 4)\n"; print "4\tdiabetes mellitus, noninsulin-dependent (3)\n"; print "5\tHypertension (essential, susceptibility to, 2)\n"; print "6\tInflammatory bowel disease (7)\n"; print "7\tSystemic lupus erythematosus (susceptibility to, 3)\n"; print "8\tmuscular dystrophy, limb-girdle (autosomal recessive) (type +1D, 1H)\n"; print "9\tparkinsons disease (type 3, 4, autosomal dominant, Lewy body +)\n"; print "10\tprostate cancer (susceptibility to)\n";
######################## # Define for which keywords to go looking in the different databases ######################## my $choice = <STDIN>; chomp($choice); if ($choice == 1) { #get_g2d('Alzheimer disease-5'); #get_g2d('Alzheimer disease 6'); get_pocus('alz'); #get_dgp('alz 10q'); #get_dgp('alz 12p11.23-q13.12'); } elsif ($choice == 2) { #get_g2d('Bardet-Biedl syndrome 1'); #get_g2d('Bardet-Biedl syndrome 2'); #get_g2d('Bardet-Biedl syndrome 3'); #get_g2d('Bardet-Biedl syndrome 5'); get_pocus('bb'); #get_dgp('bb 11q13'); #get_dgp('bb 16q21'); #get_dgp('bb 2q31'); #get_dgp('bb 3p13-p12'); } elsif ($choice == 3) { #get_g2d('Breast cancer, type 4'); get_pocus('bc'); #get_dgp('bc 13q21'); } elsif ($choice == 4) { #get_g2d('Diabetes mellitus, noninsulin-dependent, 3'); get_pocus('niddm'); #get_dgp('niddm 20q12-q13'); } elsif ($choice == 5) { #get_g2d('Hypertension, essential, susceptibility to, 2'); get_pocus('h'); #get_dgp('h 15q'); } elsif ($choice == 6) { #get_g2d('Inflammatory bowel disease 7'); get_pocus('ibd'); #get_dgp('ibd 1p36'); } elsif ($choice == 7) { #get_g2d('Systemic lupus erythematosus, susceptibility to, 3') +; get_pocus('sle'); #get_dgp('sle 4p16-15.2'); } elsif ($choice == 8) { #get_g2d('Muscular dystrophy, limb-girdle, type 1D'); #get_g2d('Muscular dystrophy, limb-girdle, type 2H'); get_pocus('md'); #get_dgp('md 7q'); #get_dgp('md 9q31-q33'); } elsif ($choice == 9) { #get_g2d('Parkinson disease, type 3'); #get_g2d('Parkinson disease 4, autosomal dominant, Lewy body') +; #get_pocus('pd'); #get_dgp('pd 4p15'); } elsif ($choice == 10) { #get_g2d('Prostate cancer, susceptibility to'); get_pocus('pc'); #get_dgp('pc 143000001-160000000'); } else { print "Type a number between 1 and 10.\n"; goto TOP }
#################### # open file with results from POCUS database, parse it, # and retrieve gene-name and score. #################### my @results=(); sub get_pocus { my @disease_name_pocus = @_; print "Getting the genes and rankings from the POCUS analysis +for:\n"; print "$disease_name_pocus[0]\n"; open (POCUS, "/home/jeroen/POCUS/results_100.out") || die "cou +ldn't open the file: $!\n"; while (<POCUS>) { push @results, [ split ]; } open (MARKER, ">marker.list.txt") || die $!; for (my $i = 0; $i < scalar @results; $i++) { if ($results[$i]->[0] eq $disease_name +_pocus[0]) { if ($results[$i]->[1] ne $resul +ts[($i+1)]->[1]){ print MARKER "$results[$i]->[1 +]\t$results[$i]->[4]\n"; } } } } close(MARKER);
################## # Make connection with Ensembl, and retrieve start, end and rank. ################## my $datasource = "DBI:mysql:homo_sapiens_core_23_34e:ensembldb.ensembl +.org"; my $dbh=(); my $sth=(); # database and statement handles my @rows; # to get results or queries my $row_count; # to see how much we get back my $username = "anonymous"; my $password = ""; my $marker = 'marker_list.txt'; # connect to database: $dbh = DBI->connect($datasource, $username, $password, {RaiseError => +1}); open (LIST, "<$marker") or die ("Couldn't open file $marker: $!.\n"); while (<LIST>){ my ($ensemblID, $score) = $_; # select all sequence entries: $row_count = 0; $sth = $dbh->prepare (qq{ SELECT gene_stable_id.stable_id, gene.seq_region_start, gene.s +eq_region_end, gene.seq_region_strand FROM gene, gene_stable_id WHERE gene_stable_id.gene_id = gene.gene_id AND gene_stable_id.stable_id ="$ensemblID" }); $sth->execute (); # read results: while (@rows = $sth->fetchrow_array () ) { $row_count++; print join ("\t", @rows), "\n"; } unless ( $row_count ) { print "This gene doesn't appear to be placed on the current as +sembly.\n"; } # tidy up: close(LIST); $sth->finish (); $dbh->disconnect (); }
|
|---|
| Replies are listed 'Best First'. | |
|---|---|
|
Re: Can't call on undefined value (DBI) + constructive feedback asked.
by graff (Chancellor) on Aug 03, 2004 at 14:55 UTC | |
|
Re: Can't call on undefined value (DBI) + constructive feedback asked.
by knoebi (Friar) on Aug 03, 2004 at 14:53 UTC | |
|
Re: Can't call on undefined value (DBI) + constructive feedback asked.
by dragonchild (Archbishop) on Aug 03, 2004 at 14:58 UTC | |
by mifflin (Curate) on Aug 03, 2004 at 15:27 UTC | |
|
Re: Can't call on undefined value (DBI) + constructive feedback asked.
by jZed (Prior) on Aug 03, 2004 at 16:43 UTC |