[Bio] / FigKernelPackages / FIG.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/FIG.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.708, Sat Jul 12 22:51:27 2008 UTC revision 1.709, Sun Jul 13 23:10:59 2008 UTC
# Line 17338  Line 17338 
17338          }          }
17339          close(DATA);          close(DATA);
17340      }      }
17341      $who =~ s/master://i;      $who =~ s/^master://i;
17342      return $who;      return $who;
17343  }  }
17344    
# Line 18872  Line 18872 
18872    
18873      my $rdbH = $self->db_handle;      my $rdbH = $self->db_handle;
18874    
18875      my $relational_db_response =      my $db_resp =
18876               $rdbH->SQL( "SELECT  status, md5_hash, pubmed, curator, go_code               $rdbH->SQL( "SELECT  status, md5_hash, pubmed, curator, go_code
18877                            FROM dlits                            FROM dlits
18878                            WHERE ((md5_hash = '$md5') and (pubmed = '$pubmed'))"                            WHERE ((md5_hash = '$md5') and (pubmed = '$pubmed'))"
18879                         );                         );
18880    
18881      my $delete;      my $delete;
18882      if (@$relational_db_response == 1)      if (@$db_resp == 1)
18883      {      {
18884          #  Default is no clobber except uncurated (i.e., $status eq ' ') -- GJO          #  Default is no clobber except uncurated (i.e., $status eq ' ') -- GJO
18885          if ( ( $relational_db_response->[0]->[0] ne ' ' ) && ( ! $override ) ) { return 0 }          if ( ( $db_resp->[0]->[0] ne ' ' ) && ( ! $override ) ) { return 0 }
18886          $rdbH->SQL( "DELETE          $rdbH->SQL( "DELETE
18887                       FROM dlits                       FROM dlits
18888                       WHERE ((md5_hash = '$md5') and (pubmed = '$pubmed'))"                       WHERE ((md5_hash = '$md5') and (pubmed = '$pubmed'))"
18889                    );                    );
18890          $delete = join( "\t", 'delete', @{$relational_db_response->[0]} ) . "\n";          $delete = join( "\t", 'delete', @{$db_resp->[0]} ) . "\n";
18891      }      }
18892    
18893      my $rc =  $rdbH->SQL( "INSERT      my $rc =  $rdbH->SQL( "INSERT
# Line 18920  Line 18920 
18920  }  }
18921    
18922    
18923    =head3 dlit_status
18924    
18925        $rc = $fig->dlit_status(
18926                              -md5      => $md5,      # or -peg, one is required
18927                              -peg      => $peg,      # or -md5, one is required
18928                              -pubmed   => $pubmed,   # required
18929                              );
18930    
18931    This returns the current status code of a dlit, or undefined.
18932    The currently supported arguments are
18933    
18934        -md5    =>          supply an md5 hash code for the peg, not the id.
18935    
18936        -peg    =>          the peg being connected to literature.  This peg will
18937                            be treated as a representative of the set that have the
18938                            same protein sequence.
18939    
18940        -pubmed =>          pubmed ID (all numeric, but stored as string)
18941    
18942    The returned value will be
18943    
18944        $status             called in scalar context
18945        ( $status_code, $curator, $go_code) called in list array context
18946    =cut
18947    
18948    sub dlit_status {
18949        my( $self, @parms ) = @_;
18950        if (! $self->table_exists('dlits')) { system "load_dlits"; }
18951    
18952        my %parms = @parms;        #  Previous code clobbered the defaults
18953    
18954        #  Check for required parameters
18955    
18956        if ( ! ( $parms{-peg} || $parms{-md5} ) || ! $parms{-pubmed} )
18957        {
18958            return wantarray ? () : undef;
18959        }
18960    
18961        my $peg    = $parms{-peg};
18962        my $md5    = $peg ? $self->md5_of_peg($peg) : lc $parms{-md5};
18963        my $pubmed = $parms{-pubmed};
18964    
18965        my $rdbH = $self->db_handle;
18966    
18967        my $db_resp = $rdbH->SQL( "SELECT  status, curator, go_code
18968                                   FROM    dlits
18969                                   WHERE ((md5_hash = '$md5') and (pubmed = '$pubmed'))"
18970                                );
18971    
18972        return $db_resp && @$db_resp ? ( wantarray ? @{$db_resp->[0]} : $db_resp->[0]->[0] )
18973                                     : ( wantarray ? () : undef );
18974    }
18975    
18976    
18977    =head3 all_dlits
18978    
18979        $dlits = $fig->all_dlits();
18980    
18981    Returns a reference to an array of all current dlit data.
18982    
18983    The returned value is
18984    
18985        [ [ status, md5_hash, pubmed, curator, go_code ], ... ]
18986    =cut
18987    
18988    sub all_dlits {
18989        my($self) = @_;
18990        my $rdbH  = $self->db_handle;
18991    
18992        my $db_resp = $rdbH->SQL( "SELECT * FROM dlits" );
18993        return [ sort { $a->[1] cmp $b->[1] }  #  Sorted by protein
18994                 @$db_resp
18995               ];
18996    }
18997    
18998    
18999    =head3 export_dlits
19000    
19001        $rc = $fig->export_dlits();
19002        $rc = $fig->export_dlits( $file );
19003    
19004    Writs all current dlit data to $FIG_Config::data/Dlits/dlits, or to a
19005    specified file.
19006    
19007    The returned value is 1 on success, or 0 on failure.
19008    =cut
19009    
19010    sub export_dlits {
19011        my ( $self, $file ) = @_;
19012        my $rdbH = $self->db_handle;
19013    
19014        $file ||= "$FIG_Config::data/Dlits/dlits";
19015        open( DLITS, ">$file" ) || return 0;
19016        my $db_resp = $rdbH->SQL( "SELECT * FROM dlits" );
19017        $db_resp || return 0;
19018        foreach my $x ( @$db_resp ) { print DLITS join( "\t", @$x ), "\n" }
19019        close(DLITS);
19020        return 1;
19021    }
19022    
19023    
19024    =head3 add_title
19025    
19026        $rc = $fig->add_title( $pubmed_id, $title )
19027    
19028    Add a pubmed title to the database.  If the pubmed_id is not already
19029    present, the id and title are added.  The return code reflects that success
19030    or failure of the add.  If the pubmed_id is already defined,
19031    and the titles match, there is no change, and the return code is 2.
19032    If the id exists and the title is different, no change is made, and
19033    the return code is 0.  To change an existing title, use:
19034    
19035        $rc = $fig->update_title( $pubmed_id, $title )
19036    
19037    The returned values are:
19038    
19039        0  attempting to change a title, or failure;
19040        1  successful addition of a new title; or
19041        2  existing and new titles are the same
19042    
19043    =cut
19044    
19045  sub add_title {  sub add_title {
19046      my($self,$pubmed,$title) = @_;      my($self,$pubmed,$title) = @_;
19047    
19048      my $rdbH  = $self->db_handle;      my $rdbH  = $self->db_handle;
19049      my $rc =  $rdbH->SQL( "INSERT  
19050        #  If there is already a title, do not duplicate it.
19051    
19052        my $db_resp = $rdbH->SQL( "SELECT title
19053                                   FROM pubmed_titles
19054                                   WHERE ( pubmed = '$pubmed' )"
19055                                );
19056    
19057        #  Same title is success; different title is failure.
19058    
19059        if ( $db_resp && @$db_resp )
19060        {
19061            return $db_resp->[0]->[0] eq $title ? 2 : 0;  # Same title is success
19062        }
19063    
19064        #  If it does not exist, add it
19065    
19066        return $rdbH->SQL( "INSERT
19067                             INTO pubmed_titles ( pubmed,title )                             INTO pubmed_titles ( pubmed,title )
19068                             VALUES ( '$pubmed','$title')"                             VALUES ( '$pubmed','$title')"
19069                          );                          );
     return $rc;  
19070  }  }
19071    
19072    
19073  sub all_dlits {  =head3 update_title
19074    
19075        $rc = $fig->update_title( $pubmed_id, $title )
19076    
19077    Add or change a pubmed title to the database.  If the pubmed_id is not already
19078    present, the id and title are added.  The return code reflects that success
19079    or failure of the add.  If the pubmed_id is already defined,
19080    and the titles match, there is no change, and the return code is 2.
19081    If the id exists and the title is different, no change is made, and
19082    the return code is 0.  To change an existing title, use:
19083    
19084        $rc = $fig->update_title( $pubmed_id, $title )
19085    
19086    The returned values are:
19087    
19088        0  on failure;
19089        1  successful addition or change of a title; or
19090        2  existing and new titles are the same
19091    
19092    =cut
19093    
19094    sub update_title {
19095        my( $self, $pubmed, $title ) = @_;
19096    
19097        my $rdbH  = $self->db_handle;
19098    
19099        #  If there is already a title, do not duplicate it.
19100    
19101        my $rc = $rdbH->SQL( "SELECT title
19102                              FROM pubmed_titles
19103                              WHERE ( pubmed = '$pubmed' )"
19104                           );
19105    
19106        #  If there is a title, make sure that it is what we want.
19107    
19108        if ( $rc && @$rc )
19109        {
19110            return 2 if $rc->[0]->[0] eq $title;     # Same title is success
19111    
19112            # title is different, change it
19113    
19114            return $rdbH->SQL( "UPDATE pubmed_titles
19115                                SET title = '$title'
19116                                WHERE ( pubmed = '$pubmed' )"
19117                             );
19118        }
19119    
19120        return $rdbH->SQL( "INSERT
19121                            INTO pubmed_titles ( pubmed, title )
19122                            VALUES ( '$pubmed', '$title')"
19123                         );
19124    }
19125    
19126    
19127    =head3 get_title
19128    
19129        $title = $fig->get_title( $pubmed_id )
19130    
19131    Get a title for a literature id
19132    
19133    Returned value:
19134    
19135        $title   upon success
19136        undef    upon failure
19137    
19138    =cut
19139    
19140    sub get_title {
19141        my( $self, $pubmed ) = @_;
19142    
19143        my $rdbH  = $self->db_handle;
19144    
19145        #  If there is already a title, do not duplicate it.
19146    
19147        my $db_resp = $rdbH->SQL( "SELECT title
19148                                   FROM pubmed_titles
19149                                   WHERE ( pubmed = '$pubmed' )"
19150                                );
19151    
19152        return ( $db_resp && @$db_resp ) ? $db_resp->[0]->[0] : undef;
19153    }
19154    
19155    
19156    =head3 all_titles
19157    
19158        [ [ id, title ], ... ] = $fig->all_titles()
19159    
19160    Get all pubmed_id, title pairs
19161    
19162    Returned value:
19163    
19164        [ [ id, title ], ... ]   upon success
19165        []                       upon failure
19166    
19167    =cut
19168    
19169    sub all_titles {
19170      my($self) = @_;      my($self) = @_;
19171      my $rdbH  = $self->db_handle;      my $rdbH  = $self->db_handle;
19172    
19173      my $relational_db_response = $rdbH->SQL( "SELECT * FROM dlits" );      my $db_resp = $rdbH->SQL( "SELECT DISTINCT * FROM pubmed_titles" );
19174      return [ sort { $a->[1] cmp $b->[1] }  #  Sorted by protein      return $db_resp ? [ sort { $a->[0] <=> $b->[0] }  @$db_resp ] : [];
              @$relational_db_response  
            ];  
19175  }  }
19176    
19177    
19178    sub export_titles {
19179        my ( $self, $file ) = @_;
19180        my $rdbH = $self->db_handle;
19181    
19182        $file ||= "$FIG_Config::data/Dlits/titles";
19183        open( TITLES, ">$file" ) || return 0;
19184        my $db_resp = $rdbH->SQL( "SELECT DISTINCT * FROM pubmed_titles" );
19185        $db_resp || return 0;
19186        foreach my $x ( @$db_resp ) { print TITLES join( "\t", @$x ), "\n" }
19187        close(TITLES);
19188        return 1;
19189    }
19190    
19191    
19192    
19193  ################################# PEG Translation  ####################################  ################################# PEG Translation  ####################################
19194    
19195  =head2 PEG Translations  =head2 PEG Translations

Legend:
Removed from v.1.708  
changed lines
  Added in v.1.709

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3