1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
|
package Bio::Graphics::Browser2::ExternalData;
# base class for Bio::Graphics::Browser::RemoteSet;
use strict;
use Carp 'croak';
use Bio::Graphics::Browser2::Util 'error';
use Bio::Graphics::Wiggle;
use constant DEBUG => 0;
sub new {
croak 'virtual base class';
}
sub uploadid { croak "virtual method" }
sub config { shift->{config} }
sub state { shift->{state} }
sub readline {
my $self = shift;
my $fh = shift;
my $line;
while (<$fh>) {
chomp;
next if /^\s*$/; # blank
next if /^\s*#/; # comment
s/[\r]//g; # get rid of carriage returns from Macintosh/DOS systems
$line .= $_;
return $line unless $line =~ s/\\$//;
}
return $line;
}
# this converts .wig files and other UCSC formats into feature files that we can handle
sub convert_ucsc_file {
my $self = shift;
my ($in,$out) = @_;
eval "require Bio::Graphics::Wiggle::Loader;1"
unless Bio::Graphics::Wiggle::Loader->can('new');
my $dummy_name = $self->name_file('foo');
$dummy_name =~ s/foo$//; # get the directory part only!
eval {
my $loader = Bio::Graphics::Wiggle::Loader->new($dummy_name);
$loader->load($in);
my $featurefile = $loader->featurefile('featurefile');
print $out $featurefile;
};
error($@) if $@;
}
sub convert_feature_file {
my $self = shift;
my ($in,$out) = @_;
while ($_ = <$in>) {
chomp;
print $out $_,"\n";
}
}
sub process_uploaded_file {
my $self = shift;
my ($infh,$outfh) = @_;
local $/ = $self->_guess_eol($infh);
my $pos = tell($infh);
my $first_line = $self->readline($infh);
return unless defined $first_line;
seek($infh,$pos,0);
if ($first_line =~ /^(track|browser)/) {
$self->convert_ucsc_file($infh,$outfh);
} else {
$self->convert_feature_file($infh,$outfh);
}
}
sub maybe_unzip {
my $self = shift;
my $filename = shift;
my $fh = shift;
# If the file is in gzip format,
# try to intercept and decompress the file
if ($filename =~ /^(.+)\.gz$/) {
$fh ||= IO::File->new($filename);
$fh->binmode(1) if $fh->can('binmode');
require File::Temp;
my $fname = File::Temp->tmpnam;
my $unzip = IO::File->new("|gunzip -c > $fname") or die $!;
$unzip->binmode(1);
my $buffer;
$unzip->print($buffer) while read($fh,$buffer,1024);
$unzip->close;
$fh = IO::File->new($fname);
$fh->binmode(1);
unlink $fname;
return $fh;
}
return;
}
sub _guess_eol {
my $self = shift;
my $fh = shift;
my $buffer;
my $pos = tell($fh);
read($fh,$buffer,1024);
seek($fh,$pos,0); # back to where we were
return "\015\012" if $buffer =~ /\015\012/;
return "\015" if $buffer =~ /\015/;
return "\012" if $buffer =~ /\012/;
}
sub name_file {
my $self = shift;
my $filename = shift;
my $strip = shift;
my $state = $self->state;
my $config = $self->config;
my $id = $self->uploadid || $state->{userid} or return;
my ($url,$path) = $self->file2path($config,$id,$filename,$strip);
warn "name_file() returns => ($url,$path)" if DEBUG;
return ($url,$path);
}
sub file2path {
my $self = shift;
my ($config,$id,$filename,$strip) = @_;
$strip = 1 unless defined $strip;
# keep last non-[\\\/:] part of name
my ($name) = $strip ? $filename =~ /([^:\\\/]+)$/ : $filename;
$name =~ tr!-/!__!; # get rid of hyphens and slashes
my $tmpdir = $config->userdata($id);
my $path = File::Spec->catfile($tmpdir,$name);
my $url = "file:$name";
return wantarray ? ($url,$path) : $path;
}
sub http_proxy {
my $self = shift;
my $config = $self->config;
my $proxy = $config->setting('proxy') || '';
return $config->setting('http proxy') || $proxy || '';
}
sub ftp_proxy {
my $self = shift;
my $config = $self->config;
my $proxy = $config->setting('proxy') || '';
return $config->setting('ftp proxy') || $proxy || '';
}
# ugly hack, but needed for performance gains when looking at really big data sets
sub probe_for_overview_sections {
my $self = shift;
my $fh = shift;
my $overview;
my $pos = tell($fh);
while (<$fh>) {
next unless /\S/; # skip blank lines
last unless /[\#\[=]/; # not a configuration section
if (/^section\s*=.*(region|overview)/) {
$overview++;
last;
}
}
seek($fh,$pos,0);
return $overview;
}
1;
|
