# returns data structure
- my ( @lines, $line, %hash, $ft, $seq, $key );
+ my ( @lines, $i, %hash, $ft, $seq );
@lines = split "\n", $entry;
- foreach $line ( @lines )
+ $i = 0;
+
+ while ( $i < @lines )
{
if ( exists $args->{ "keys" } )
{
- if ( $line =~ /^(\w{2})\s+(.*)/ and exists $args->{ "keys" }->{ $1 } )
+ if ( $lines[ $i ] =~ /^(\w{2})\s+(.*)/ and exists $args->{ "keys" }->{ $1 } )
{
- if ( exists $hash{ $1 } and $1 eq "FT" ) {
+ if ( $1 =~ /RN|RP|RG|RA|RT|RL/ ) {
+ add_ref( \%hash, \@lines, $i, $args->{ "keys" } );
+ } elsif ( exists $hash{ $1 } and $1 eq "FT" ) {
$hash{ $1 } .= "\n" . $2;
} elsif ( exists $hash{ $1 } ) {
$hash{ $1 } .= " " . $2;
$hash{ $1 } = $2;
}
}
- elsif ( $line =~ /^\s+(.*)\s+\d+$/ and exists $args->{ "keys" }->{ "SEQ" } )
+ elsif ( $lines[ $i ] =~ /^\s+(.*)\s+\d+$/ and exists $args->{ "keys" }->{ "SEQ" } )
{
$seq .= $1;
}
}
else
{
- if ( $line =~ /^(\w{2})\s+(.*)/ )
+ if ( $lines[ $i ] =~ /^(\w{2})\s+(.*)/ )
{
- if ( exists $hash{ $1 } and $1 eq "FT" ) {
+ if ( $1 eq "RN" ) {
+ add_ref( \%hash, \@lines, $i );
+ } elsif ( exists $hash{ $1 } and $1 eq "FT" ) {
$hash{ $1 } .= "\n" . $2;
} elsif ( exists $hash{ $1 } ) {
$hash{ $1 } .= " " . $2;
$hash{ $1 } = $2;
}
}
- elsif ( $line =~ /^\s+(.*)\s+\d+$/ )
+ elsif ( $lines[ $i ] =~ /^\s+(.*)\s+\d+$/ )
{
$seq .= $1;
}
}
+
+ $i++;
}
if ( $seq )
$hash{ "SEQ" } = $seq;
}
-# foreach $key ( keys %hash )
-# {
-# next if $key =~ /^(SEQ|SEQ_FT|FT)/;
-#
-# if ( not $hash{ $key } =~ /$args->{ $key }/i ) {
-# return wantarray ? () : {} ;
-# }
-# }
-
if ( exists $hash{ "FT" } )
{
- $seq =~ tr/ //d;
$ft = parse_feature_table( $hash{ "FT" }, $seq, $args );
$hash{ "FT" } = $ft;
}
}
+sub add_ref
+{
+ # Martin A. Hansen, August 2009.
+
+ # Add a EMBL reference.
+
+ my ( $hash, # Parsed EMBL data
+ $lines, # EMBL entry lines
+ $i, # line index
+ $args, # hashref with keys to save - OPTIONAL
+ ) = @_;
+
+ # Returns nothing.
+
+ my ( %ref );
+
+ if ( $args )
+ {
+ while ( $lines->[ $i ] =~ /^(\w{2})\s+(.*)/ and $1 ne 'XX' and exists $args->{ $1 } )
+ {
+ if ( exists $ref{ $1 } ) {
+ $ref{ $1 } .= " " . $2;
+ } else {
+ $ref{ $1 } = $2;
+ }
+
+ $i++;
+ }
+ }
+ else
+ {
+ while ( $lines->[ $i ] =~ /^(\w{2})\s+(.*)/ and $1 ne 'XX' )
+ {
+ if ( exists $ref{ $1 } ) {
+ $ref{ $1 } .= " " . $2;
+ } else {
+ $ref{ $1 } = $2;
+ }
+
+ $i++;
+ }
+ }
+
+ push @{ $hash->{ 'REF' } }, \%ref;
+}
+
+
sub parse_feature_table
{
# Martin A. Hansen, June 2006.
# argument hash are returned.
my ( $ft, # feature table
- $seq, # entry sequnce
+ $seq, # entry sequence
$args, # argument hash
) = @_;
push @{ $qual_hash{ "_locator" } }, $locator;
- # ---- getting subsequence
+ if ( $seq )
+ {
+ # ---- getting subsequence
- $subseq = parse_locator( $locator, $seq );
+ $subseq = parse_locator( $locator, $seq );
- push @{ $qual_hash{ "_seq" } }, $subseq;
+ push @{ $qual_hash{ "_seq" } }, $subseq;
+ }
# ----- getting qualifiers
}
+sub embl2biopieces
+{
+ # Martin A. Hansen, July 2009.
+
+ # Given a complete EMBL entry and an option hash,
+ # configure the arguments for the EMBL parser so
+ # only wanted information is retrieved and returned
+ # as a Biopiece record.
+
+ my ( $entry, # EMBL entry to parse
+ $options, # Biopiece options
+ ) = @_;
+
+ # Returns a hashref.
+
+ my ( %args, $data, $record, $key_record, $key, $feat, $feat2, $qual, $qual_val, @records, $no_seq );
+
+ map { $args{ 'keys' }{ $_ } = 1 } @{ $options->{ 'keys' } };
+ map { $args{ 'feats' }{ $_ } = 1 } @{ $options->{ 'features' } };
+ map { $args{ 'quals' }{ $_ } = 1 } @{ $options->{ 'qualifiers' } };
+
+ if ( @{ $options->{ 'features' } } > 0 or @{ $options->{ 'qualifiers' } } > 0 ) {
+ $args{ 'keys' }{ 'FT' } = 1;
+ }
+
+ if ( ( $args{ 'feats' } and $args{ 'feats' }{ 'SEQ' } ) or ( $args{ 'quals' } and $args{ 'quals' }{ 'SEQ' } ) )
+ {
+ $no_seq = 1 if not $args{ 'keys' }{ 'SEQ' };
+
+ $args{ 'keys' }{ 'SEQ' } = 1;
+ delete $args{ 'feats' }{ 'SEQ' } if $args{ 'feats' };
+ delete $args{ 'quals' }{ 'SEQ' } if $args{ 'quals' };
+ }
+
+ $data = parse_embl_entry( $entry, \%args );
+
+ foreach $key ( keys %{ $data } )
+ {
+ if ( $key eq 'SEQ' and $no_seq ) {
+ next;
+ }
+
+ if ( $key eq 'REF' ) {
+ $key_record->{ $key } = inline_ref( $data->{ $key } );
+ }
+
+ if ( $key ne 'FT' and $key ne 'REF' ) {
+ $key_record->{ $key } = $data->{ $key };
+ }
+ }
+
+ if ( exists $data->{ 'FT' } )
+ {
+ foreach $feat ( keys %{ $data->{ 'FT' } } )
+ {
+ $record = {};
+ $record->{ "FEATURE" } = $feat;
+
+ foreach $feat2 ( @{ $data->{ 'FT' }->{ $feat } } )
+ {
+ foreach $qual ( keys %{ $feat2 } )
+ {
+ $qual_val = join "; ", @{ $feat2->{ $qual } };
+
+ $qual = "SEQ" if $qual eq "_seq";
+ $qual = "LOCATOR" if $qual eq "_locator";
+
+ $record->{ $qual } = $qual_val;
+ }
+ }
+
+ map { $record->{ $_ } = $key_record->{ $_ } } keys %{ $key_record };
+
+ push @records, $record;
+ }
+ }
+ else
+ {
+ push @records, $key_record;
+ }
+
+ return wantarray ? @records : \@records;
+}
+
+
+sub inline_ref
+{
+ # Martin A. Hansen, August 2009.
+
+ # Flattens a data structure with EMBL reference info to a string.
+
+ my ( $data, # list of hashrefs
+ ) = @_;
+
+ # Returns a string.
+
+ my ( $ref, $key, $str, @keys, @refs );
+
+ foreach $ref ( @{ $data } )
+ {
+ undef @keys;
+
+ foreach $key ( qw( RN RP RG RA RT RL ) ) {
+ push @keys, "$key => '$ref->{ $key }'" if exists $ref->{ $key };
+ }
+
+ push @refs, "{ " . join( ", ", @keys ) . " }";
+ }
+
+ $str = '[ ' . join( ', ', @refs ) . ' ]';
+
+ return $str;
+}
+
+
# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
projects / biopieces.git / blobdiff