package Bio::Graphics::Browser2::Plugin::CMapDumper;
# $Id: CMapDumper.pm,v 1.2 2005-12-09 22:19:09 mwz444 Exp $
use strict;
use Bio::Graphics::Browser2::Plugin;
use CGI qw(:standard *sup);
use vars '$VERSION', '@ISA';
$VERSION = '0.80';
@ISA = qw/ Bio::Graphics::Browser2::Plugin /;
sub name { "CMap File" }
sub description {
p("Dumps a CMap readable file.");
}
sub config_defaults {
my $self = shift;
return {
version => 2,
mode => 'selected',
disposition => 'view',
coords => 'absolute',
};
}
sub reconfigure {
my $self = shift;
my $current_config = $self->configuration;
delete $current_config->{embed};
foreach my $p ( $self->config_param() ) {
$current_config->{$p} = $self->config_param($p);
}
}
sub configure_form {
my $self = shift;
my $current_config = $self->configuration;
my $html;
$html .= p(
'Coordinates',
radio_group(
-name => $self->config_name('coords'),
-values => [ 'absolute', 'relative' ],
-labels => {
absolute => 'relative to chromosome/contig/clone',
relative => 'relative to dumped segment (start at 1)'
},
-default => $current_config->{coords},
-override => 1
)
);
autoEscape(0);
$html .= p(
radio_group(
-name => $self->config_name('disposition'),
-values => [ 'view', 'save', 'edit' ],
-labels => {
view => 'View',
save => 'Save to File',
edit => 'Edit' . sup('**'),
}
)
);
$html .= p(
'Where should the feature type be taken from (suggested: Method)?',
radio_group(
-name => $self->config_name('feature_type_source'),
-values => [ 'method', 'source' ],
-labels => {
method => 'Method',
source => 'Source',
}
)
);
autoEscape(1);
$html .= p(
sup('*'),
"To edit, install a helper application for MIME type",
cite('application/x-cmap'),
);
$html;
}
sub mime_type {
my $self = shift;
my $config = $self->configuration;
my $ps = $self->page_settings;
my $base = join '_', @{$ps}{qw(ref start stop)};
return $config->{disposition} eq 'view' ? 'text/plain'
: $config->{disposition} eq 'save'
? ( 'application/octet-stream', "$base" )
: $config->{disposition} eq 'edit' ? "application/x-cmap"
: 'text/plain';
}
sub dump {
my $self = shift;
my ( $segment, @more_feature_sets ) = @_;
my $page_settings = $self->page_settings;
my $conf = $self->browser_config;
my $config = $self->configuration;
my $version = $config->{version} || 2;
my $mode = $config->{mode} || 'selected';
my $db = $self->database;
my $whole_segment = $db->segment( Accession => $segment->ref )
|| $db->segment( $segment->ref );
my $ft_source = $config->{feature_type_source};
my $coords = $config->{coords};
my $embed = $config->{embed};
$segment->refseq($segment) if $coords eq 'relative';
print join( "\t",
'map_name', 'map_start',
'map_stop', 'feature_name',
'feature_start', 'feature_stop',
'feature_direction', 'feature_type_accession' )
. "\n";
my @args;
if ( $mode eq 'selected' ) {
my @feature_types = $self->selected_features;
@args = ( -types => \@feature_types );
}
my @feats = ();
my $ref_name = $segment->{'sourceseq'};
my $ref_start = $segment->start;
my $ref_stop = $segment->stop;
my $offset = $segment->start - $segment->abs_start;
my (
$feature_name, $feature_start, $feature_stop,
$strand_str, $feature_type
);
my $iterator = $segment->get_seq_stream(@args);
while ( my $f = $iterator->next_seq ) {
$feature_name = $f->{'group'}->name;
$feature_start = $f->{'start'} + $offset;
$feature_stop = $f->{'stop'} + $offset;
$strand_str = $f->{'fstrand'};
if ( $ft_source eq 'source' ) {
$feature_type = $f->{'type'}->source();
}
else {
$feature_type = $f->{'type'}->method();
}
$self->print_feature_row(
map_name => $ref_name,
map_start => $ref_start,
map_stop => $ref_stop,
feature_name => $feature_name,
feature_stop => $feature_stop,
feature_start => $feature_start,
strand_value => $strand_str,
feature_type_aid => $feature_type,
);
for my $set (@more_feature_sets) {
if ( $set->can('get_seq_stream') ) {
my @feats = ();
my $iterator = $set->get_seq_stream;
while ( my $f = $iterator->next_seq ) {
$feature_name = $f->{'group'}->name;
$feature_start = $f->{'start'} + $offset;
$feature_stop = $f->{'stop'} + $offset;
$strand_str = $f->{'fstrand'};
$feature_type = $f->{'type'}->method();
$self->print_feature_row(
map_name => $ref_name,
map_start => $ref_start,
map_stop => $ref_stop,
feature_name => $feature_name,
feature_stop => $feature_stop,
feature_start => $feature_start,
strand_value => $strand_str,
feature_type_aid => $feature_type,
);
}
}
}
}
if ($embed) {
my $dna = $segment->dna;
$dna =~ s/(\S{60})/$1\n/g;
print ">$segment\n$dna\n" if $dna;
}
}
sub print_feature_row {
my $self = shift;
my %args = @_;
my $map_name = $args{'map_name'};
my $map_start = $args{'map_start'};
my $map_stop = $args{'map_stop'};
my $feature_name = $args{'feature_name'};
my $feature_stop = $args{'feature_stop'};
my $feature_start = $args{'feature_start'};
my $strand_value = $args{'strand_value'};
my $feature_type_aid = $args{'feature_type_aid'};
my $feature_direction = ( $strand_value eq '-' ) ? -1 : 1;
print join( "\t",
$map_name, $map_start, $map_stop, $feature_name, $feature_start,
$feature_stop, $feature_direction, $feature_type_aid )
. "\n";
}
1;