bin/perlcyc_dump_database.pl

   1 #!/usr/local/bin/perl -w
   2 use strict;
   3
   4 use perlcyc;
   5
   6 my $database = shift;
   7
   8 if (!$database) {
   9     print qq {This script dumps a Pathway Tools (PGDB) database.
  10 Please specify database to dump (i.e. ARA for AraCyc, LYCO for lycocyc etc.)
  11 Version 1.1, Nov 23, 2006...
  12 };
  13     exit(0);
  14 }
  15
  16
  17 ##edited by Danny 4/12/2005
  18
  19 my $cyc = new perlcyc("ARA");
  20
  21 my @pathways = $cyc -> all_pathways();
  22 #my @pathways = ("PWY-1186");
  23
  24 foreach my $p (@pathways) {
  25     my $pathwayName = getPathwayName($p);
  26     my @subpathways=$cyc -> get_slot_values($p, "SUB-PATHWAYS");
  27     if (!@subpathways) {
  28         my @reactions = $cyc -> get_slot_values ($p, "REACTION-LIST");
  29         foreach my $r (@reactions) {
  30             my $rname = $cyc -> get_slot_value($r, "EC-NUMBER");
  31             if (!$rname) { $rname=$r; }
  32             my @proteins = $cyc -> enzymes_of_reaction($r);
  33
  34             if (!@proteins) {
  35                 print "$pathwayName\t$rname\tunknown\tunknown\n";
  36             }
  37             else {
  38                 printProteinsReport($pathwayName, $rname, @proteins);
  39             }
  40         }
  41     }
  42 }
  43
  44
  45
  46 sub printProteinsReport {
  47     my ($pathwayName, $rname, @proteins) = @_;
  48     for my $protein (@proteins) {
  49         my $pname = getProteinName($protein);
  50         my @genes = $cyc -> genes_of_protein($protein);
  51         if (!@genes) {
  52             print "$pathwayName\t$rname\t$pname\tunknown\n";
  53         }
  54         else {
  55             printGenesReport($pathwayName, $rname, $pname, @genes);
  56         }
  57     }
  58 }
  59
  60
  61
  62 sub printGenesReport {
  63     my ($pathwayName, $rname, $pname, @genes) = @_;
  64     foreach my $g (@genes) {
  65         my $gname = getGeneName($g);
  66         print "$pathwayName\t$rname\t$pname\t$gname\n";
  67     }
  68 }
  69
  70
  71
  72
  73
  74 sub getPathwayName {
  75     my ($p) = @_;
  76     my $pathwayName = $cyc -> get_slot_value($p, "COMMON-NAME");
  77     if (!$pathwayName) {$pathwayName = "unknown";}
  78     return $pathwayName;
  79 }
  80
  81
  82
  83 sub getGeneName {
  84     my ($g) = @_;
  85     if ($g =~ /(At\dg\d{5})/i) {
  86         return $1;
  87     }
  88
  89     my @synonyms = $cyc -> get_slot_values($g, "SYNONYMS");
  90     foreach my $s (@synonyms) {
  91         if ($s =~ /(At\dg\d{5})/i) {
  92             return $1;
  93         }
  94     }
  95
  96     my $name = $cyc -> get_slot_value($g, "COMMON-NAME");
  97     if ($name) {
  98         return $name;
  99     }
 100
 101     return $g;
 102 }
 103
 104
 105
 106 sub getProteinName {
 107     my ($protein) = @_;
 108     if (!$protein) { return "unknown"; }
 109
 110     my $pname = $cyc -> get_slot_value($protein, "COMMON-NAME");
 111     if ($pname) { return $pname; }
 112
 113     my @others = $cyc -> get_slot_values($protein, "CATALYZES");
 114     my @names;
 115     foreach my $other (@others) {
 116         push @names, $cyc -> get_slot_value($other, "COMMON-NAME");
 117     }
 118     return (join "||", @names);
 119 }