BioPerl

 view release on metacpan or  search on metacpan

Bio/SeqFeature/Tools/Unflattener.pm  view on Meta::CPAN

1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
#
# for example, the CDS feature may have a resolver tag of /derives_from
# which is a 'foreign key' into the /label tag of the mRNA feature
#
# this kind of tag-based resolution is possible for a certain subset
# of genbank records
#
# if no resolver tag is specified, we revert to the normal
# resolver_method
if ($resolver_tag) {
    my $backup_resolver_method = $resolver_method;
    # closure: $resolver_tag is remembered by this sub
    my $sub = 
      sub {
          my ($self, $sf, @possible_container_sfs) = @_;
          my @container_sfs = ();
          if ($sf->has_tag($resolver_tag)) {
              my ($resolver_tagval) = $sf->get_tag_values($resolver_tag);
              # if a feature has a resolver_tag (e.g. /derives_from)
              # this specifies the /product, /symbol or /label for the
              # parent feature

Bio/SeqFeature/Tools/Unflattener.pm  view on Meta::CPAN

1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
                            if (grep {$_ eq $resolver_tagval} @vals) {
                                $match = 1;
                                last;
                            }
                        }   
                    }
                    $match;
                } @possible_container_sfs;
          } 
          else {
              return $backup_resolver_method->($sf, @possible_container_sfs);
          }
          return map {$_=>0} @container_sfs;
      };
    $resolver_method = $sub;
}
else {
    # CONDITION: $resolver_tag is NOT set
    $self->throw("assertion error") if $resolver_tag;
}
# we have now set $resolver_method to a subroutine for

Bio/SeqIO/Handler/GenericRichSeqHandler.pm  view on Meta::CPAN

839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
                               $data->{ORGANISM} || '');
my ($organelle,$abbr_name, $common);    
my @class = reverse split m{\s*;\s*}, $class;
# have to treat swiss different from everything else...
if ($sl =~ m{^(mitochondrion|chloroplast|plastid)?   # GenBank format
            \s*(.*?)
            \s*(?: \( (.*?) \) )?\.?$ 
     }xmso ){ 
    ($organelle, $abbr_name, $common) = ($1, $2, $3); # optional
} else {
    $abbr_name = $sl;       # nothing caught; this is a backup!
}
# there is no 'abbreviated name' for EMBL
$sci_name = $abbr_name if $seqformat ne 'genbank';
$organelle ||= '';
$common ||= '';
$sci_name || return;
unshift @class, $sci_name;
# no genus/species parsing here; moving to Bio::Taxon-based taxonomy
my $make = Bio::Species->new();
$make->scientific_name($sci_name);

Bio/SeqIO/genbank.pm  view on Meta::CPAN

1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
# entire SOURCE line just in case
if ($sl =~ m{^(mitochondrion|chloroplast|plastid)?
              \s*(.*?)
              \s*(?: \( (.*?) \) )?\.?
              $
             }xms
    ) {
    ($organelle, $abbr_name, $common) = ($1, $2, $3); # optional
}
else {
    $abbr_name = $sl; # nothing caught; this is a backup!
}
 
# Convert data in classification lines into classification array.
# only split on ';' or '.' so that classification that is 2 or more words will
# still get matched, use map() to remove trailing/leading/intervening spaces
my @class = map { $_ =~ s/^\s+//;
                  $_ =~ s/\s+$//;
                  $_ =~ s/\s{2,}/ /g;
                  $_; }
            split /(?<!subgen)[;\.]+/, $class_lines;

ide/bioperl-mode/site-lisp/bioperl-mode.el  view on Meta::CPAN

1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
          (and mod (not (string-match "^\*" mod))))
  (setq done t)
(let (
      ;; local vars here
      )
  (setq name-list (bioperl-module-names nmspc nil t))
  (setq mod (completing-read
             (concat prompt-prefix nmspc " Module: ")
             name-list nil (not no-retry)
             (if mod (replace-regexp-in-string "^\*" "" mod) nil)))
  ;; allow a backup into namespace completion
  (if (or no-retry (not (string-equal mod "")))
      (setq done t)
    ;; retry setup
    ;; try again, backing up
    (setq done nil)
    (let ( (splt (bioperl-split-name nmspc nil)) )
      (if (elt splt 1)
          (progn
            (setq nmspc (elt splt 0))
            ;; kludge : "pretend" mod is not found using the "*"

ide/bioperl-mode/site-lisp/bioperl-mode.el  view on Meta::CPAN

1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
    (setq name-list (bioperl-method-names (concat nmspc "::" mod) t pthn))
    (let (
          ;; local vars here...
          )
      (setq mth (completing-read
                 (concat prompt-prefix "Method in " nmspc "::" mod ": ")
                 name-list nil (not no-retry)))
      (if (or no-retry (not (string-equal mth "")))
          (setq done t)
        ;; retry setup
        ;; allow a backup into module completion
        (setq done nil)
        (let ( 
              (splt (bioperl-split-name (concat nmspc "::" mod) nil pthn))
              )
          (setq nmspc (elt splt 0))
          ;; kludge : "pretend" mod is not found using the "*"
          (setq mod (concat "*" (elt splt 1))))))
    ))
;; return values
(if get-method