Mercurial > repos > mahtabm > ensembl

comparison variant_effect_predictor/Bio/EnsEMBL/DBSQL/ArchiveStableIdAdaptor.pm @ 0:1f6dce3d34e0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Uploaded
author mahtabm
date Thu, 11 Apr 2013 02:01:53 -0400
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:1f6dce3d34e0
1 =head1 LICENSE
2
3 Copyright (c) 1999-2012 The European Bioinformatics Institute and
4 Genome Research Limited. All rights reserved.
5
6 This software is distributed under a modified Apache license.
7 For license details, please see
8
9 http://www.ensembl.org/info/about/code_licence.html
10
11 =head1 CONTACT
12
13 Please email comments or questions to the public Ensembl
14 developers list at <dev@ensembl.org>.
15
16 Questions may also be sent to the Ensembl help desk at
17 <helpdesk@ensembl.org>.
18
19 =cut
20
21 =head1 NAME
22
23 Bio::EnsEMBL::ArchiveStableIdAdaptor
24
25 =head1 SYNOPSIS
26
27 my $registry = "Bio::EnsEMBL::Registry";
28
29 my $archiveStableIdAdaptor =
30 $registry->get_adaptor( 'Human', 'Core', 'ArchiveStableId' );
31
32 my $stable_id = 'ENSG00000068990';
33
34 my $arch_id = $archiveStableIdAdaptor->fetch_by_stable_id($stable_id);
35
36 print("Latest incarnation of this stable ID:\n");
37 printf( " Stable ID: %s.%d\n",
38 $arch_id->stable_id(), $arch_id->version() );
39 print(" Release: "
40 . $arch_id->release() . " ("
41 . $arch_id->assembly() . ", "
42 . $arch_id->db_name()
43 . ")\n" );
44
45 print "\nStable ID history:\n\n";
46
47 my $history =
48 $archiveStableIdAdaptor->fetch_history_tree_by_stable_id(
49 $stable_id);
50
51 foreach my $a ( @{ $history->get_all_ArchiveStableIds } ) {
52 printf( " Stable ID: %s.%d\n", $a->stable_id(), $a->version() );
53 print(" Release: "
54 . $a->release() . " ("
55 . $a->assembly() . ", "
56 . $a->db_name()
57 . ")\n\n" );
58 }
59
60 =head1 DESCRIPTION
61
62 ArchiveStableIdAdaptor does all SQL to create ArchiveStableIds and works
63 of
64
65 stable_id_event
66 mapping_session
67 peptite_archive
68 gene_archive
69
70 tables inside the core database.
71
72 This whole module has a status of At Risk as it is under development.
73
74 =head1 METHODS
75
76 fetch_by_stable_id
77 fetch_by_stable_id_version
78 fetch_by_stable_id_dbname
79 fetch_all_by_archive_id
80 fetch_predecessors_by_archive_id
81 fetch_successors_by_archive_id
82 fetch_history_tree_by_stable_id
83 add_all_current_to_history
84 list_dbnames
85 previous_dbname
86 next_dbname
87 get_peptide
88 get_current_release
89 get_current_assembly
90
91 =head1 RELATED MODULES
92
93 Bio::EnsEMBL::ArchiveStableId
94 Bio::EnsEMBL::StableIdEvent
95 Bio::EnsEMBL::StableIdHistoryTree
96
97 =head1 METHODS
98
99 =cut
100
101 package Bio::EnsEMBL::DBSQL::ArchiveStableIdAdaptor;
102
103 use strict;
104 use warnings;
105 no warnings qw(uninitialized);
106
107 use Bio::EnsEMBL::DBSQL::BaseAdaptor;
108 our @ISA = qw(Bio::EnsEMBL::DBSQL::BaseAdaptor);
109
110 use Bio::EnsEMBL::ArchiveStableId;
111 use Bio::EnsEMBL::StableIdEvent;
112 use Bio::EnsEMBL::StableIdHistoryTree;
113 use Bio::EnsEMBL::Utils::Exception qw(deprecate warning throw);
114
115 use constant MAX_ROWS => 30;
116 use constant NUM_HIGH_SCORERS => 20;
117
118
119 =head2 fetch_by_stable_id
120
121 Arg [1] : string $stable_id
122 Arg [2] : (optional) string $type
123 Example : none
124 Description : Retrives an ArchiveStableId that is the latest incarnation of
125 given stable_id.
126 Returntype : Bio::EnsEMBL::ArchiveStableId or undef if not in database
127 Exceptions : none
128 Caller : general
129 Status : At Risk
130 : under development
131
132 =cut
133
134 sub fetch_by_stable_id {
135 my $self = shift;
136 my $stable_id = shift;
137
138 my $arch_id = Bio::EnsEMBL::ArchiveStableId->new(
139 -stable_id => $stable_id,
140 -adaptor => $self
141 );
142
143 @_ ? $arch_id->type(shift) : $self->_resolve_type($arch_id);
144
145 if ($self->lookup_current($arch_id)) {
146
147 # stable ID is in current release
148 $arch_id->version($arch_id->current_version);
149 $arch_id->db_name($self->dbc->dbname);
150 $arch_id->release($self->get_current_release);
151 $arch_id->assembly($self->get_current_assembly);
152
153 } else {
154
155 # look for latest version of this stable id
156 my $extra_sql = defined($arch_id->{'type'}) ?
157 " AND sie.type = '@{[lc($arch_id->{'type'})]}'" : '';
158
159 my $r = $self->_fetch_archive_id($stable_id, $extra_sql, $extra_sql);
160
161 if ($r->{'new_stable_id'} and $r->{'new_stable_id'} eq $stable_id) {
162 # latest event is a self event, use new_* data
163 $arch_id->version($r->{'new_version'});
164 $arch_id->release($r->{'new_release'});
165 $arch_id->assembly($r->{'new_assembly'});
166 $arch_id->db_name($r->{'new_db_name'});
167 } else {
168 # latest event is a deletion event (or mapping to other ID; this clause
169 # is only used to cope with buggy data where deletion events are
170 # missing), use old_* data
171 $arch_id->version($r->{'old_version'});
172 $arch_id->release($r->{'old_release'});
173 $arch_id->assembly($r->{'old_assembly'});
174 $arch_id->db_name($r->{'old_db_name'});
175 }
176
177 $arch_id->type(ucfirst(lc($r->{'type'})));
178 }
179
180 if (! defined $arch_id->db_name) {
181 # couldn't find stable ID in archive or current db
182 return undef;
183 }
184
185 $arch_id->is_latest(1);
186
187 return $arch_id;
188 }
189
190
191 =head2 fetch_by_stable_id_version
192
193 Arg [1] : string $stable_id
194 Arg [2] : int $version
195 Example : none
196 Description : Retrieve an ArchiveStableId with given version and stable ID.
197 Returntype : Bio::EnsEMBL::ArchiveStableId
198 Exceptions : none
199 Caller : general
200 Status : At Risk
201 : under development
202
203 =cut
204
205 sub fetch_by_stable_id_version {
206 my $self = shift;
207 my $stable_id = shift;
208 my $version = shift;
209
210 my $arch_id = Bio::EnsEMBL::ArchiveStableId->new(
211 -stable_id => $stable_id,
212 -version => $version,
213 -adaptor => $self
214 );
215
216 @_ ? $arch_id->type(shift) : $self->_resolve_type($arch_id);
217
218 if ($self->lookup_current($arch_id) && $arch_id->is_current) {
219
220 # this version is the current one
221 $arch_id->db_name($self->dbc->dbname);
222 $arch_id->release($self->get_current_release);
223 $arch_id->assembly($self->get_current_assembly);
224
225 } else {
226
227 # find latest release this stable ID version is found in archive
228 my $extra_sql1 = qq(AND sie.old_version = "$version");
229 my $extra_sql2 = qq(AND sie.new_version = "$version");
230 my $r = $self->_fetch_archive_id($stable_id, $extra_sql1, $extra_sql2);
231
232 if ($r->{'new_stable_id'} and $r->{'new_stable_id'} eq $stable_id
233 and $r->{'new_version'} == $version) {
234 # latest event is a self event, use new_* data
235 $arch_id->release($r->{'new_release'});
236 $arch_id->assembly($r->{'new_assembly'});
237 $arch_id->db_name($r->{'new_db_name'});
238 } else {
239 # latest event is a deletion event (or mapping to other ID; this clause
240 # is only used to cope with buggy data where deletion events are
241 # missing), use old_* data
242 $arch_id->release($r->{'old_release'});
243 $arch_id->assembly($r->{'old_assembly'});
244 $arch_id->db_name($r->{'old_db_name'});
245 }
246
247 $arch_id->type(ucfirst(lc($r->{'type'})));
248 }
249
250 if (! defined $arch_id->db_name) {
251 # couldn't find stable ID version in archive or current release
252 return undef;
253 }
254
255 return $arch_id;
256 }
257
258
259 =head2 fetch_by_stable_id_dbname
260
261 Arg [1] : string $stable_id
262 Arg [2] : string $db_name
263 Example : none
264 Description : Create an ArchiveStableId from given arguments.
265 Returntype : Bio::EnsEMBL::ArchiveStableId or undef if not in database
266 Exceptions : none
267 Caller : general
268 Status : At Risk
269 : under development
270
271 =cut
272
273 sub fetch_by_stable_id_dbname {
274 my $self = shift;
275 my $stable_id = shift;
276 my $db_name = shift;
277
278 my $arch_id = Bio::EnsEMBL::ArchiveStableId->new(
279 -stable_id => $stable_id,
280 -db_name => $db_name,
281 -adaptor => $self
282 );
283
284 @_ ? $arch_id->type(shift) : $self->_resolve_type($arch_id);
285
286 if ($self->lookup_current($arch_id) and $db_name eq $self->dbc->dbname) {
287
288 # this version is the current one
289 $arch_id->version($arch_id->current_version);
290 $arch_id->release($self->get_current_release);
291 $arch_id->assembly($self->get_current_assembly);
292
293 } else {
294
295 # find version for this dbname in the stable ID archive
296 my $extra_sql = defined($arch_id->{'type'}) ?
297 " AND sie.type = '@{[lc($arch_id->{'type'})]}'" : '';
298 my $extra_sql1 = $extra_sql . qq( AND ms.old_db_name = "$db_name");
299 my $extra_sql2 = $extra_sql . qq( AND ms.new_db_name = "$db_name");
300 my $r = $self->_fetch_archive_id($stable_id, $extra_sql1, $extra_sql2);
301
302 if ($r->{'new_stable_id'} and $r->{'new_stable_id'} eq $stable_id
303 and $r->{'new_db_name'} eq $db_name) {
304
305 # latest event is a self event, use new_* data
306 $arch_id->release($r->{'new_release'});
307 $arch_id->assembly($r->{'new_assembly'});
308 $arch_id->version($r->{'new_version'});
309 } else {
310 # latest event is a deletion event (or mapping to other ID; this clause
311 # is only used to cope with buggy data where deletion events are
312 # missing), use old_* data
313 $arch_id->release($r->{'old_release'});
314 $arch_id->assembly($r->{'old_assembly'});
315 $arch_id->version($r->{'old_version'});
316 }
317
318 $arch_id->type(ucfirst(lc($r->{'type'})));
319 }
320
321 if (! defined $arch_id->version ) {
322 # couldn't find stable ID version in archive or current release
323 return undef;
324 }
325
326 return $arch_id;
327 }
328
329 #
330 # Helper method to do fetch ArchiveStableId from db.
331 # Used by fetch_by_stable_id(), fetch_by_stable_id_version() and
332 # fetch_by_stable_id_dbname().
333 # Returns hashref as returned by DBI::sth::fetchrow_hashref
334 #
335 sub _fetch_archive_id {
336 my $self = shift;
337 my $stable_id = shift;
338 my $extra_sql1 = shift;
339 my $extra_sql2 = shift;
340
341 # using a UNION is much faster in this query than somthing like
342 # "... AND (sie.old_stable_id = ? OR sie.new_stable_id = ?)"
343 my $sql = qq(
344 (SELECT * FROM stable_id_event sie, mapping_session ms
345 WHERE sie.mapping_session_id = ms.mapping_session_id
346 AND sie.old_stable_id = ?
347 $extra_sql1)
348 UNION
349 (SELECT * FROM stable_id_event sie, mapping_session ms
350 WHERE sie.mapping_session_id = ms.mapping_session_id
351 AND sie.new_stable_id = ?
352 $extra_sql2)
353 ORDER BY created DESC
354 LIMIT 1
355 );
356
357 my $sth = $self->prepare($sql);
358 $sth->execute($stable_id,$stable_id);
359 my $r = $sth->fetchrow_hashref;
360 $sth->finish;
361
362 return $r;
363 }
364
365
366 =head2 fetch_all_by_archive_id
367
368 Arg [1] : Bio::EnsEMBL::ArchiveStableId $archive_id
369 Arg [2] : String $return_type - type of ArchiveStableId to fetch
370 Example : my $arch_id = $arch_adaptor->fetch_by_stable_id('ENSG0001');
371 my @archived_transcripts =
372 $arch_adaptor->fetch_all_by_archive_id($arch_id, 'Transcript');
373 Description : Given a ArchiveStableId it retrieves associated ArchiveStableIds
374 of specified type (e.g. retrieve transcripts for genes or vice
375 versa).
376
377 See also fetch_associated_archived() for a different approach to
378 retrieve this data.
379 Returntype : listref Bio::EnsEMBL::ArchiveStableId
380 Exceptions : none
381 Caller : Bio::EnsEMBL::ArchiveStableId->get_all_gene_archive_ids,
382 get_all_transcript_archive_ids, get_all_translation_archive_ids
383 Status : At Risk
384 : under development
385
386 =cut
387
388 sub fetch_all_by_archive_id {
389 my $self = shift;
390 my $archive_id = shift;
391 my $return_type = shift;
392
393 my @result = ();
394 my $lc_self_type = lc($archive_id->type);
395 my $lc_return_type = lc($return_type);
396
397 my $sql = qq(
398 SELECT
399 ga.${lc_return_type}_stable_id,
400 ga.${lc_return_type}_version,
401 m.old_db_name,
402 m.old_release,
403 m.old_assembly
404 FROM gene_archive ga, mapping_session m
405 WHERE ga.${lc_self_type}_stable_id = ?
406 AND ga.${lc_self_type}_version = ?
407 AND ga.mapping_session_id = m.mapping_session_id
408 );
409
410 my $sth = $self->prepare($sql);
411 $sth->bind_param(1, $archive_id->stable_id, SQL_VARCHAR);
412 $sth->bind_param(2, $archive_id->version, SQL_SMALLINT);
413 $sth->execute;
414
415 my ($stable_id, $version, $db_name, $release, $assembly);
416 $sth->bind_columns(\$stable_id, \$version, \$db_name, \$release, \$assembly);
417
418 while ($sth->fetch) {
419 my $new_arch_id = Bio::EnsEMBL::ArchiveStableId->new(
420 -stable_id => $stable_id,
421 -version => $version,
422 -db_name => $db_name,
423 -release => $release,
424 -assembly => $assembly,
425 -type => $return_type,
426 -adaptor => $self
427 );
428
429 push( @result, $new_arch_id );
430 }
431
432 $sth->finish();
433 return \@result;
434 }
435
436
437 =head2 fetch_associated_archived
438
439 Arg[1] : Bio::EnsEMBL::ArchiveStableId $arch_id -
440 the ArchiveStableId to fetch associated archived IDs for
441 Example : my ($arch_gene, $arch_tr, $arch_tl, $pep_seq) =
442 @{ $archive_adaptor->fetch_associated_archived($arch_id) };
443 Description : Fetches associated archived stable IDs from the db for a given
444 ArchiveStableId (version is taken into account).
445 Return type : Listref of
446 ArchiveStableId archived gene
447 ArchiveStableId archived transcript
448 (optional) ArchiveStableId archived translation
449 (optional) peptide sequence
450 Exceptions : thrown on missing or wrong argument
451 thrown if ArchiveStableID has no type
452 Caller : Bio::EnsEMBL::ArchiveStableId->get_all_associated_archived()
453 Status : At Risk
454 : under development
455
456 =cut
457
458 sub fetch_associated_archived {
459 my $self = shift;
460 my $arch_id = shift;
461
462 throw("Need a Bio::EnsEMBL::ArchiveStableId") unless ($arch_id
463 and ref($arch_id) and $arch_id->isa('Bio::EnsEMBL::ArchiveStableId'));
464
465 my $type = $arch_id->type();
466
467 if ( !defined($type) ) {
468 throw("Can't deduce ArchiveStableId type.");
469 }
470
471 $type = lc($type);
472
473 my $sql = qq(
474 SELECT ga.gene_stable_id,
475 ga.gene_version,
476 ga.transcript_stable_id,
477 ga.transcript_version,
478 ga.translation_stable_id,
479 ga.translation_version,
480 pa.peptide_seq,
481 ms.old_release,
482 ms.old_assembly,
483 ms.old_db_name
484 FROM (mapping_session ms, gene_archive ga)
485 LEFT JOIN peptide_archive pa
486 ON ga.peptide_archive_id = pa.peptide_archive_id
487 WHERE ga.mapping_session_id = ms.mapping_session_id
488 AND ga.${type}_stable_id = ?
489 AND ga.${type}_version = ?
490 );
491
492 my $sth = $self->prepare($sql);
493 $sth->bind_param(1, $arch_id->stable_id, SQL_VARCHAR);
494 $sth->bind_param(2, $arch_id->version, SQL_SMALLINT);
495 $sth->execute;
496
497 my @result = ();
498
499 while (my $r = $sth->fetchrow_hashref) {
500
501 my @row = ();
502
503 # create ArchiveStableIds genes, transcripts and translations
504 push @row, Bio::EnsEMBL::ArchiveStableId->new(
505 -stable_id => $r->{'gene_stable_id'},
506 -version => $r->{'gene_version'},
507 -db_name => $r->{'old_db_name'},
508 -release => $r->{'old_release'},
509 -assembly => $r->{'old_assembly'},
510 -type => 'Gene',
511 -adaptor => $self
512 );
513
514 push @row, Bio::EnsEMBL::ArchiveStableId->new(
515 -stable_id => $r->{'transcript_stable_id'},
516 -version => $r->{'transcript_version'},
517 -db_name => $r->{'old_db_name'},
518 -release => $r->{'old_release'},
519 -assembly => $r->{'old_assembly'},
520 -type => 'Transcript',
521 -adaptor => $self
522 );
523
524 if ($r->{'translation_stable_id'}) {
525 push @row, Bio::EnsEMBL::ArchiveStableId->new(
526 -stable_id => $r->{'translation_stable_id'},
527 -version => $r->{'translation_version'},
528 -db_name => $r->{'old_db_name'},
529 -release => $r->{'old_release'},
530 -assembly => $r->{'old_assembly'},
531 -type => 'Translation',
532 -adaptor => $self
533 );
534
535 # push peptide sequence onto result list
536 push @row, $r->{'peptide_seq'};
537 }
538
539 push @result, \@row;
540 }
541
542 return \@result;
543 }
544
545
546 =head2 fetch_predecessors_by_archive_id
547
548 Arg [1] : Bio::EnsEMBL::ArchiveStableId
549 Example : none
550 Description : Retrieve a list of ArchiveStableIds that were mapped to the
551 given one. This method goes back only one level, to retrieve
552 a full predecessor history use fetch_predecessor_history, or
553 ideally fetch_history_tree_by_stable_id for the complete
554 history network.
555 Returntype : listref Bio::EnsEMBL::ArchiveStableId
556 Exceptions : none
557 Caller : Bio::EnsEMBL::ArchiveStableId->get_all_predecessors
558 Status : At Risk
559 : under development
560
561 =cut
562
563 sub fetch_predecessors_by_archive_id {
564 my $self = shift;
565 my $arch_id = shift;
566
567 my @result;
568
569 if( ! ( defined $arch_id->stable_id() &&
570 defined $arch_id->db_name() )) {
571 throw( "Need db_name for predecessor retrieval" );
572 }
573
574 my $sql = qq(
575 SELECT
576 sie.old_stable_id,
577 sie.old_version,
578 sie.type,
579 m.old_db_name,
580 m.old_release,
581 m.old_assembly
582 FROM mapping_session m, stable_id_event sie
583 WHERE sie.mapping_session_id = m.mapping_session_id
584 AND sie.new_stable_id = ?
585 AND m.new_db_name = ?
586 );
587
588 my $sth = $self->prepare($sql);
589 $sth->bind_param(1, $arch_id->stable_id, SQL_VARCHAR);
590 $sth->bind_param(2, $arch_id->db_name, SQL_VARCHAR);
591 $sth->execute();
592
593 my ($old_stable_id, $old_version, $type, $old_db_name, $old_release, $old_assembly);
594 $sth->bind_columns(\$old_stable_id, \$old_version, \$type, \$old_db_name, \$old_release, \$old_assembly);
595
596 while ($sth->fetch) {
597 if (defined $old_stable_id) {
598 my $old_arch_id = Bio::EnsEMBL::ArchiveStableId->new(
599 -stable_id => $old_stable_id,
600 -version => $old_version,
601 -db_name => $old_db_name,
602 -release => $old_release,
603 -assembly => $old_assembly,
604 -type => $type,
605 -adaptor => $self
606 );
607 push( @result, $old_arch_id );
608 }
609 }
610 $sth->finish();
611
612 # if you didn't find any predecessors, there might be a gap in the
613 # mapping_session history (i.e. databases in mapping_session don't chain). To
614 # bridge the gap, look in the previous mapping_session for identical
615 # stable_id.version
616 unless (@result) {
617
618 $sql = qq(
619 SELECT
620 sie.new_stable_id,
621 sie.new_version,
622 sie.type,
623 m.new_db_name,
624 m.new_release,
625 m.new_assembly
626 FROM mapping_session m, stable_id_event sie
627 WHERE sie.mapping_session_id = m.mapping_session_id
628 AND sie.new_stable_id = ?
629 AND m.new_db_name = ?
630 );
631
632 $sth = $self->prepare($sql);
633
634 my $curr_dbname = $arch_id->db_name;
635
636 PREV:
637 while (my $prev_dbname = $self->previous_dbname($curr_dbname)) {
638
639 $sth->bind_param(1,$arch_id->stable_id, SQL_VARCHAR);
640 $sth->bind_param(2,$prev_dbname, SQL_VARCHAR);
641 $sth->execute();
642
643 $sth->bind_columns(\$old_stable_id, \$old_version, \$type, \$old_db_name, \$old_release, \$old_assembly);
644
645 while( $sth->fetch() ) {
646 if (defined $old_stable_id) {
647 my $old_arch_id = Bio::EnsEMBL::ArchiveStableId->new(
648 -stable_id => $old_stable_id,
649 -version => $old_version,
650 -db_name => $old_db_name,
651 -release => $old_release,
652 -assembly => $old_assembly,
653 -type => $type,
654 -adaptor => $self
655 );
656 push( @result, $old_arch_id );
657
658 last PREV;
659 }
660 }
661
662 $curr_dbname = $prev_dbname;
663
664 }
665
666 $sth->finish();
667 }
668
669 return \@result;
670 }
671
672
673 =head2 fetch_successors_by_archive_id
674
675 Arg [1] : Bio::EnsEMBL::ArchiveStableId
676 Example : none
677 Description : Retrieve a list of ArchiveStableIds that the given one was
678 mapped to. This method goes forward only one level, to retrieve
679 a full successor history use fetch_successor_history, or
680 ideally fetch_history_tree_by_stable_id for the complete
681 history network.
682 Returntype : listref Bio::EnsEMBL::ArchiveStableId
683 Exceptions : none
684 Caller : Bio::EnsEMBL::ArchiveStableId->get_all_successors
685 Status : At Risk
686 : under development
687
688 =cut
689
690 sub fetch_successors_by_archive_id {
691 my $self = shift;
692 my $arch_id = shift;
693 my @result;
694
695
696 if( ! ( defined $arch_id->stable_id() &&
697 defined $arch_id->db_name() )) {
698 throw( "Need db_name for successor retrieval" );
699 }
700
701 my $sql = qq(
702 SELECT
703 sie.new_stable_id,
704 sie.new_version,
705 sie.type,
706 m.new_db_name,
707 m.new_release,
708 m.new_assembly
709 FROM mapping_session m, stable_id_event sie
710 WHERE sie.mapping_session_id = m.mapping_session_id
711 AND sie.old_stable_id = ?
712 AND m.old_db_name = ?
713 );
714
715 my $sth = $self->prepare( $sql );
716 $sth->bind_param(1,$arch_id->stable_id,SQL_VARCHAR);
717 $sth->bind_param(2,$arch_id->db_name,SQL_VARCHAR);
718 $sth->execute();
719
720 my ($new_stable_id, $new_version, $type, $new_db_name, $new_release, $new_assembly);
721 $sth->bind_columns(\$new_stable_id, \$new_version, \$type, \$new_db_name, \$new_release, \$new_assembly);
722
723 while( $sth->fetch() ) {
724 if( defined $new_stable_id ) {
725 my $new_arch_id = Bio::EnsEMBL::ArchiveStableId->new(
726 -stable_id => $new_stable_id,
727 -version => $new_version,
728 -db_name => $new_db_name,
729 -release => $new_release,
730 -assembly => $new_assembly,
731 -type => $type,
732 -adaptor => $self
733 );
734
735 push( @result, $new_arch_id );
736 }
737 }
738 $sth->finish();
739
740 # if you didn't find any successors, there might be a gap in the
741 # mapping_session history (i.e. databases in mapping_session don't chain). To
742 # bridge the gap, look in the next mapping_session for identical
743 # stable_id.version
744 unless (@result) {
745
746 $sql = qq(
747 SELECT
748 sie.old_stable_id,
749 sie.old_version,
750 sie.type,
751 m.old_db_name,
752 m.old_release,
753 m.old_assembly
754 FROM mapping_session m, stable_id_event sie
755 WHERE sie.mapping_session_id = m.mapping_session_id
756 AND sie.old_stable_id = ?
757 AND m.old_db_name = ?
758 );
759
760 $sth = $self->prepare($sql);
761
762 my $curr_dbname = $arch_id->db_name;
763
764 NEXTDB:
765 while (my $next_dbname = $self->next_dbname($curr_dbname)) {
766
767 $sth->bind_param(1, $arch_id->stable_id, SQL_VARCHAR);
768 $sth->bind_param(2, $next_dbname, SQL_VARCHAR);
769 $sth->execute();
770
771 $sth->bind_columns(\$new_stable_id, \$new_version, \$type, \$new_db_name, \$new_release, \$new_assembly);
772
773 while( $sth->fetch() ) {
774 if (defined $new_stable_id) {
775 my $new_arch_id = Bio::EnsEMBL::ArchiveStableId->new(
776 -stable_id => $new_stable_id,
777 -version => $new_version,
778 -db_name => $new_db_name,
779 -release => $new_release,
780 -assembly => $new_assembly,
781 -type => $type,
782 -adaptor => $self
783 );
784
785 push( @result, $new_arch_id );
786
787 last NEXTDB;
788 }
789 }
790
791 $curr_dbname = $next_dbname;
792
793 }
794
795 $sth->finish();
796 }
797
798 return \@result;
799 }
800
801
802
803 =head2 fetch_history_tree_by_stable_id
804
805 Arg[1] : String $stable_id - the stable ID to fetch the history tree for
806 Arg[2] : (optional) Int $num_high_scorers
807 number of mappings per stable ID allowed when filtering
808 Arg[3] : (optional) Int $max_rows
809 maximum number of stable IDs in history tree (used for
810 filtering)
811 Example : my $history = $archive_adaptor->fetch_history_tree_by_stable_id(
812 'ENSG00023747897');
813 Description : Returns the history tree for a given stable ID. This will
814 include a network of all stable IDs it is related to. The
815 method will try to return a minimal (sparse) set of nodes
816 (ArchiveStableIds) and links (StableIdEvents) by removing any
817 redundant entries and consolidating mapping events so that only
818 changes are recorded.
819 Return type : Bio::EnsEMBL::StableIdHistoryTree
820 Exceptions : thrown on missing argument
821 Caller : Bio::EnsEMBL::ArchiveStableId::get_history_tree, general
822 Status : At Risk
823 : under development
824
825 =cut
826
827 sub fetch_history_tree_by_stable_id {
828 my ($self, $stable_id, $num_high_scorers, $max_rows) = @_;
829
830 throw("Expecting a stable ID argument.") unless $stable_id;
831
832 $num_high_scorers ||= NUM_HIGH_SCORERS;
833 $max_rows ||= MAX_ROWS;
834
835 # using a UNION is much faster in this query than somthing like
836 # "... AND (sie.old_stable_id = ?) OR (sie.new_stable_id = ?)"
837 my $sql = qq(
838 SELECT sie.old_stable_id, sie.old_version,
839 ms.old_db_name, ms.old_release, ms.old_assembly,
840 sie.new_stable_id, sie.new_version,
841 ms.new_db_name, ms.new_release, ms.new_assembly,
842 sie.type, sie.score
843 FROM stable_id_event sie, mapping_session ms
844 WHERE sie.mapping_session_id = ms.mapping_session_id
845 AND sie.old_stable_id = ?
846 UNION
847 SELECT sie.old_stable_id, sie.old_version,
848 ms.old_db_name, ms.old_release, ms.old_assembly,
849 sie.new_stable_id, sie.new_version,
850 ms.new_db_name, ms.new_release, ms.new_assembly,
851 sie.type, sie.score
852 FROM stable_id_event sie, mapping_session ms
853 WHERE sie.mapping_session_id = ms.mapping_session_id
854 AND sie.new_stable_id = ?
855 );
856
857 my $sth = $self->prepare($sql);
858
859 my $history = Bio::EnsEMBL::StableIdHistoryTree->new(
860 -CURRENT_DBNAME => $self->dbc->dbname,
861 -CURRENT_RELEASE => $self->get_current_release,
862 -CURRENT_ASSEMBLY => $self->get_current_assembly,
863 );
864
865 # remember stable IDs you need to do and those that are done. Initialise the
866 # former hash with the focus stable ID
867 my %do = ($stable_id => 1);
868 my %done;
869
870 # while we got someting to do
871 while (my ($id) = keys(%do)) {
872
873 # if we already have more than MAX_ROWS stable IDs in this tree, we can't
874 # build the full tree. Return undef.
875 if (scalar(keys(%done)) > $max_rows) {
876 # warning("Too many related stable IDs (".scalar(keys(%done)).") to draw a history tree.");
877 $history->is_incomplete(1);
878 $sth->finish;
879 last;
880 }
881
882 # mark this stable ID as done
883 delete $do{$id};
884 $done{$id} = 1;
885
886 # fetch all stable IDs related to this one from the database
887 $sth->bind_param(1, $id, SQL_VARCHAR);
888 $sth->bind_param(2, $id, SQL_VARCHAR);
889 $sth->execute;
890
891 my @events;
892
893 while (my $r = $sth->fetchrow_hashref) {
894
895 #
896 # create old and new ArchiveStableIds and a StableIdEvent to link them
897 # add all of these to the history tree
898 #
899 my ($old_id, $new_id);
900
901 if ($r->{'old_stable_id'}) {
902 $old_id = Bio::EnsEMBL::ArchiveStableId->new(
903 -stable_id => $r->{'old_stable_id'},
904 -version => $r->{'old_version'},
905 -db_name => $r->{'old_db_name'},
906 -release => $r->{'old_release'},
907 -assembly => $r->{'old_assembly'},
908 -type => $r->{'type'},
909 -adaptor => $self
910 );
911 }
912
913 if ($r->{'new_stable_id'}) {
914 $new_id = Bio::EnsEMBL::ArchiveStableId->new(
915 -stable_id => $r->{'new_stable_id'},
916 -version => $r->{'new_version'},
917 -db_name => $r->{'new_db_name'},
918 -release => $r->{'new_release'},
919 -assembly => $r->{'new_assembly'},
920 -type => $r->{'type'},
921 -adaptor => $self
922 );
923 }
924
925 my $event = Bio::EnsEMBL::StableIdEvent->new(
926 -old_id => $old_id,
927 -new_id => $new_id,
928 -score => $r->{'score'}
929 );
930
931 push @events, $event;
932
933 }
934
935 # filter out low-scoring events; the number of highest scoring events
936 # returned is defined by NUM_HIGH_SCORERS
937 my @others;
938
939 foreach my $event (@events) {
940
941 my $old_id = $event->old_ArchiveStableId;
942 my $new_id = $event->new_ArchiveStableId;
943
944 # creation, deletion and mapping-to-self events are added to the history
945 # tree directly
946 if (!$old_id || !$new_id || ($old_id->stable_id eq $new_id->stable_id)) {
947 $history->add_StableIdEvents($event);
948 } else {
949 push @others, $event;
950 }
951
952 }
953
954 #if (scalar(@others) > $num_high_scorers) {
955 # warn "Filtering ".(scalar(@others) - $num_high_scorers).
956 # " low-scoring events.\n";
957 #}
958
959 my $k = 0;
960 foreach my $event (sort { $b->score <=> $a->score } @others) {
961 $history->add_StableIdEvents($event);
962
963 # mark stable IDs as todo if appropriate
964 $do{$event->old_ArchiveStableId->stable_id} = 1
965 unless $done{$event->old_ArchiveStableId->stable_id};
966 $do{$event->new_ArchiveStableId->stable_id} = 1
967 unless $done{$event->new_ArchiveStableId->stable_id};
968
969 last if (++$k == $num_high_scorers);
970 }
971
972 }
973
974 $sth->finish;
975
976 # try to consolidate the tree (remove redundant nodes, bridge gaps)
977 $history->consolidate_tree;
978
979 # now add ArchiveStableIds for current Ids not found in the archive
980 $self->add_all_current_to_history($history);
981
982 # calculate grid coordinates for the sorted tree; this will also try to
983 # untangle the tree
984 $history->calculate_coords;
985
986 return $history;
987 }
988
989
990 =head2 add_all_current_to_history
991
992 Arg[1] : Bio::EnsEMBL::StableIdHistoryTree $history -
993 the StableIdHistoryTree object to add the current IDs to
994 Description : This method adds the current versions of all stable IDs found
995 in a StableIdHistoryTree object to the tree, by creating
996 appropriate Events for the stable IDs found in the *_stable_id
997 tables. This is a helper method for
998 fetch_history_tree_by_stable_id(), see there for more
999 documentation.
1000 Return type : none (passed-in object is manipulated)
1001 Exceptions : thrown on missing or wrong argument
1002 Caller : internal
1003 Status : At Risk
1004 : under development
1005
1006 =cut
1007
1008 sub add_all_current_to_history {
1009 my $self = shift;
1010 my $history = shift;
1011
1012 unless ($history and $history->isa('Bio::EnsEMBL::StableIdHistoryTree')) {
1013 throw("Need a Bio::EnsEMBL::StableIdHistoryTree.");
1014 }
1015
1016 my @ids = @{ $history->get_unique_stable_ids };
1017 my $id_string = join("', '", @ids);
1018
1019 my $tmp_id = Bio::EnsEMBL::ArchiveStableId->new(-stable_id => $ids[0]);
1020 my $type = lc($self->_resolve_type($tmp_id));
1021 return unless ($type);
1022
1023 # get current stable IDs from db
1024 my $sql = qq(
1025 SELECT stable_id, version FROM ${type}
1026 WHERE stable_id IN ('$id_string')
1027 );
1028 my $sth = $self->prepare($sql);
1029 $sth->execute;
1030
1031 while (my ($stable_id, $version) = $sth->fetchrow_array) {
1032
1033 my $new_id = Bio::EnsEMBL::ArchiveStableId->new(
1034 -stable_id => $stable_id,
1035 -version => $version,
1036 -current_version => $version,
1037 -db_name => $self->dbc->dbname,
1038 -release => $self->get_current_release,
1039 -assembly => $self->get_current_assembly,
1040 -type => $type,
1041 -adaptor => $self
1042 );
1043
1044 my $event = $history->get_latest_StableIdEvent($new_id);
1045 next unless ($event);
1046
1047 if ($event->old_ArchiveStableId and
1048 $event->old_ArchiveStableId->stable_id eq $stable_id) {
1049
1050 # latest event was a self event
1051 # update it with current stable ID and add to tree
1052 $event->new_ArchiveStableId($new_id);
1053
1054 } else {
1055
1056 # latest event was a non-self event
1057 # create a new event where the old_id is the new_id from latest
1058 my $new_event = Bio::EnsEMBL::StableIdEvent->new(
1059 -old_id => $event->new_ArchiveStableId,
1060 -new_id => $new_id,
1061 -score => $event->score,
1062 );
1063 $history->add_StableIdEvents($new_event);
1064 }
1065
1066 }
1067
1068 # refresh node cache
1069 $history->flush_ArchiveStableIds;
1070 $history->add_ArchiveStableIds_for_events;
1071 }
1072
1073
1074 =head2 fetch_successor_history
1075
1076 Arg [1] : Bio::EnsEMBL::ArchiveStableId $arch_id
1077 Example : none
1078 Description : Gives back a list of archive stable ids which are successors in
1079 the stable_id_event tree of the given stable_id. Might well be
1080 empty.
1081
1082 This method isn't deprecated, but in most cases you will rather
1083 want to use fetch_history_tree_by_stable_id().
1084 Returntype : listref Bio::EnsEMBL::ArchiveStableId
1085 Since every ArchiveStableId knows about it's successors, this is
1086 a linked tree.
1087 Exceptions : none
1088 Caller : webcode for archive
1089 Status : At Risk
1090 : under development
1091
1092 =cut
1093
1094 sub fetch_successor_history {
1095 my $self = shift;
1096 my $arch_id = shift;
1097
1098 my $current_db_name = $self->list_dbnames->[0];
1099 my $dbname = $arch_id->db_name;
1100
1101 if ($dbname eq $current_db_name) {
1102 return [$arch_id];
1103 }
1104
1105 my $old = [];
1106 my @result = ();
1107
1108 push @$old, $arch_id;
1109
1110 while ($dbname ne $current_db_name) {
1111 my $new = [];
1112 while (my $asi = (shift @$old)) {
1113 push @$new, @{ $asi->get_all_successors };
1114 }
1115
1116 if (@$new) {
1117 $dbname = $new->[0]->db_name;
1118 } else {
1119 last;
1120 }
1121
1122 # filter duplicates
1123 my %unique = map { join(":", $_->stable_id, $_->version, $_->release) =>
1124 $_ } @$new;
1125 @$new = values %unique;
1126
1127 @$old = @$new;
1128 push @result, @$new;
1129 }
1130
1131 return \@result;
1132 }
1133
1134
1135 =head2 fetch_predecessor_history
1136
1137 Arg [1] : Bio::EnsEMBL::ArchiveStableId $arch_id
1138 Example : none
1139 Description : Gives back a list of archive stable ids which are predecessors
1140 in the stable_id_event tree of the given stable_id. Might well
1141 be empty.
1142
1143 This method isn't deprecated, but in most cases you will rather
1144 want to use fetch_history_tree_by_stable_id().
1145 Returntype : listref Bio::EnsEMBL::ArchiveStableId
1146 Since every ArchiveStableId knows about it's successors, this is
1147 a linked tree.
1148 Exceptions : none
1149 Caller : webcode for archive
1150 Status : At Risk
1151 : under development
1152
1153 =cut
1154
1155 sub fetch_predecessor_history {
1156 my $self = shift;
1157 my $arch_id = shift;
1158
1159 my $oldest_db_name = $self->list_dbnames->[-1];
1160 my $dbname = $arch_id->db_name;
1161
1162 if ($dbname eq $oldest_db_name) {
1163 return [$arch_id];
1164 }
1165
1166 my $old = [];
1167 my @result = ();
1168
1169 push @$old, $arch_id;
1170
1171 while ($dbname ne $oldest_db_name) {
1172 my $new = [];
1173 while (my $asi = (shift @$old)) {
1174 push @$new, @{ $asi->get_all_predecessors };
1175 }
1176
1177 if( @$new ) {
1178 $dbname = $new->[0]->db_name;
1179 } else {
1180 last;
1181 }
1182
1183 # filter duplicates
1184 my %unique = map { join(":", $_->stable_id, $_->version, $_->release) =>
1185 $_ } @$new;
1186 @$new = values %unique;
1187
1188 @$old = @$new;
1189 push @result, @$new;
1190 }
1191
1192 return \@result;
1193 }
1194
1195
1196 =head2 list_dbnames
1197
1198 Args : none
1199 Example : none
1200 Description : A list of available database names from the latest (current) to
1201 the oldest (ordered).
1202 Returntype : listref of strings
1203 Exceptions : none
1204 Caller : general
1205 Status : At Risk
1206 : under development
1207
1208 =cut
1209
1210 sub list_dbnames {
1211 my $self = shift;
1212
1213 if( ! defined $self->{'dbnames'} ) {
1214
1215 my $sql = qq(
1216 SELECT old_db_name, new_db_name
1217 FROM mapping_session
1218 ORDER BY created DESC
1219 );
1220 my $sth = $self->prepare( $sql );
1221 $sth->execute();
1222 my ( $old_db_name, $new_db_name );
1223
1224 my @dbnames = ();
1225 my %seen;
1226
1227 $sth->bind_columns( \$old_db_name, \$new_db_name );
1228
1229 while( $sth->fetch() ) {
1230 # this code now can deal with non-chaining mapping sessions
1231 push(@{ $self->{'dbnames'} }, $new_db_name) unless ($seen{$new_db_name});
1232 $seen{$new_db_name} = 1;
1233
1234 push(@{ $self->{'dbnames'} }, $old_db_name) unless ($seen{$old_db_name});
1235 $seen{$old_db_name} = 1;
1236 }
1237
1238 $sth->finish();
1239
1240 }
1241
1242 return $self->{'dbnames'};
1243 }
1244
1245
1246 =head2 previous_dbname
1247
1248 Arg[1] : String $dbname - focus db name
1249 Example : my $prev_db = $self->previous_dbname($curr_db);
1250 Description : Returns the name of the next oldest database which has mapping
1251 session information.
1252 Return type : String (or undef if not available)
1253 Exceptions : none
1254 Caller : general
1255 Status : At Risk
1256
1257 =cut
1258
1259 sub previous_dbname {
1260 my $self = shift;
1261 my $dbname = shift;
1262
1263 my $curr_idx = $self->_dbname_index($dbname);
1264 my @dbnames = @{ $self->list_dbnames };
1265
1266 if ($curr_idx == @dbnames) {
1267 # this is the oldest dbname, so no previous one available
1268 return undef;
1269 } else {
1270 return $dbnames[$curr_idx+1];
1271 }
1272 }
1273
1274
1275 =head2 next_dbname
1276
1277 Arg[1] : String $dbname - focus db name
1278 Example : my $prev_db = $self->next_dbname($curr_db);
1279 Description : Returns the name of the next newest database which has mapping
1280 session information.
1281 Return type : String (or undef if not available)
1282 Exceptions : none
1283 Caller : general
1284 Status : At Risk
1285
1286 =cut
1287
1288 sub next_dbname {
1289 my $self = shift;
1290 my $dbname = shift;
1291
1292 my $curr_idx = $self->_dbname_index($dbname);
1293 my @dbnames = @{ $self->list_dbnames };
1294
1295 if ($curr_idx == 0) {
1296 # this is the latest dbname, so no next one available
1297 return undef;
1298 } else {
1299 return $dbnames[$curr_idx-1];
1300 }
1301 }
1302
1303
1304 #
1305 # helper method to return the array index of a database in the ordered list of
1306 # available databases (as returned by list_dbnames()
1307 #
1308 sub _dbname_index {
1309 my $self = shift;
1310 my $dbname = shift;
1311
1312 my @dbnames = @{ $self->list_dbnames };
1313
1314 for (my $i = 0; $i < @dbnames; $i++) {
1315 if ($dbnames[$i] eq $dbname) {
1316 return $i;
1317 }
1318 }
1319 }
1320
1321
1322 =head2 get_peptide
1323
1324 Arg [1] : Bio::EnsEMBL::ArchiveStableId $arch_id
1325 Example : none
1326 Description : Retrieves the peptide string for given ArchiveStableId. If its
1327 not a peptide or not in the database returns undef.
1328 Returntype : string or undef
1329 Exceptions : none
1330 Caller : Bio::EnsEMBL::ArchiveStableId->get_peptide, general
1331 Status : At Risk
1332 : under development
1333
1334 =cut
1335
1336 sub get_peptide {
1337 my $self = shift;
1338 my $arch_id = shift;
1339
1340 if ( lc( $arch_id->type() ) ne 'translation' ) {
1341 return undef;
1342 }
1343
1344 my $sql = qq(
1345 SELECT pa.peptide_seq
1346 FROM peptide_archive pa, gene_archive ga
1347 WHERE ga.translation_stable_id = ?
1348 AND ga.translation_version = ?
1349 AND ga.peptide_archive_id = pa.peptide_archive_id
1350 );
1351
1352 my $sth = $self->prepare($sql);
1353 $sth->bind_param( 1, $arch_id->stable_id, SQL_VARCHAR );
1354 $sth->bind_param( 2, $arch_id->version, SQL_SMALLINT );
1355 $sth->execute();
1356
1357 my ($peptide_seq) = $sth->fetchrow_array();
1358 $sth->finish();
1359
1360 return $peptide_seq;
1361 } ## end sub get_peptide
1362
1363
1364 =head2 get_current_release
1365
1366 Example : my $current_release = $archive_adaptor->get_current_release;
1367 Description : Returns the current release number (as found in the meta table).
1368 Return type : Int
1369 Exceptions : none
1370 Caller : general
1371 Status : At Risk
1372 : under development
1373
1374 =cut
1375
1376 sub get_current_release {
1377 my $self = shift;
1378
1379 unless ($self->{'current_release'}) {
1380 my $mca = $self->db->get_MetaContainer;
1381 my ($release) = @{ $mca->list_value_by_key('schema_version') };
1382 $self->{'current_release'} = $release;
1383 }
1384
1385 return $self->{'current_release'};
1386 }
1387
1388
1389 =head2 get_current_assembly
1390
1391 Example : my $current_assembly = $archive_adaptor->get_current_assembly;
1392 Description : Returns the current assembly version (as found in the meta
1393 table).
1394 Return type : String
1395 Exceptions : none
1396 Caller : general
1397 Status : At Risk
1398 : under development
1399
1400 =cut
1401
1402 sub get_current_assembly {
1403 my $self = shift;
1404
1405 unless ($self->{'current_assembly'}) {
1406 my $mca = $self->db->get_MetaContainer;
1407 my ($assembly) = @{ $mca->list_value_by_key('assembly.default') };
1408 $self->{'current_assembly'} = $assembly;
1409 }
1410
1411 return $self->{'current_assembly'};
1412 }
1413
1414
1415 =head2 lookup_current
1416
1417 Arg[1] : Bio::EnsEMBL::ArchiveStableId $arch_id -
1418 the stalbe ID to find the current version for
1419 Example : if ($self->lookup_version($arch_id) {
1420 $arch_id->version($arch_id->current_version);
1421 $arch_id->db_name($self->dbc->dbname);
1422 Description : Look in [gene|transcript|translation]_stable_id if you can find
1423 a current version for this stable ID. Set
1424 ArchiveStableId->current_version if found.
1425 Return type : Boolean (TRUE if current version found, else FALSE)
1426 Exceptions : none
1427 Caller : general
1428 Status : At Risk
1429 : under development
1430
1431 =cut
1432
1433 sub lookup_current {
1434 my $self = shift;
1435 my $arch_id = shift;
1436
1437 my $type = lc( $arch_id->type );
1438
1439 unless ($type) {
1440 warning("Can't lookup current version without a type.");
1441 return 0;
1442 }
1443
1444 my $sql = qq(
1445 SELECT version FROM ${type}
1446 WHERE stable_id = ?
1447 );
1448 my $sth = $self->prepare($sql);
1449 $sth->execute( $arch_id->stable_id );
1450 my ($version) = $sth->fetchrow_array;
1451 $sth->finish;
1452
1453 if ($version) {
1454 $arch_id->current_version($version);
1455 return 1;
1456 }
1457
1458 # didn't find a current version
1459 return 0;
1460 } ## end sub lookup_current
1461
1462
1463 # infer type from stable ID format
1464 sub _resolve_type {
1465 my $self = shift;
1466 my $arch_id = shift;
1467
1468 my $stable_id = $arch_id->stable_id();
1469 my $id_type;
1470
1471 # first, try to infer type from stable ID format
1472 #
1473 # Anopheles IDs
1474 if ($stable_id =~ /^AGAP.*/) {
1475 if ($stable_id =~ /.*-RA/) {
1476 $id_type = "Transcript";
1477 } elsif ($stable_id =~ /.*-PA/) {
1478 $id_type = "Translation";
1479 } else {
1480 $id_type = "Gene";
1481 }
1482
1483 # standard Ensembl IDs
1484 } elsif ($stable_id =~ /.*G\d+$/) {
1485 $id_type = "Gene";
1486 } elsif ($stable_id =~ /.*T\d+$/) {
1487 $id_type = "Transcript";
1488 } elsif ($stable_id =~ /.*P\d+$/) {
1489 $id_type = "Translation";
1490 } elsif ($stable_id =~ /.*E\d+$/) {
1491 $id_type = "Exon";
1492
1493 # if guessing fails, look in db
1494 } else {
1495 my $sql = qq(
1496 SELECT type from stable_id_event
1497 WHERE old_stable_id = ?
1498 OR new_stable_id = ?
1499 );
1500 my $sth = $self->prepare($sql);
1501 $sth->execute($stable_id, $stable_id);
1502 ($id_type) = $sth->fetchrow_array;
1503 $sth->finish;
1504 }
1505
1506 warning("Couldn't resolve stable ID type.") unless ($id_type);
1507
1508 $arch_id->type($id_type);
1509 }
1510
1511
1512 1;
1513