|
0
|
1 #!/bin/env perl
|
|
|
2
|
|
|
3 =pod
|
|
|
4
|
|
|
5 =head1 NAME
|
|
|
6
|
|
|
7 parse - parse Ryan's MAF and CNV files and generate a summary table of all genes and their mutations and CNV status
|
|
|
8
|
|
|
9 =head1 SYNOPSIS
|
|
|
10
|
|
|
11 # automatically load etc/parse.conf
|
|
|
12 bin/parse
|
|
|
13
|
|
|
14 # if config file is elsewhere
|
|
|
15 bin/parse -conf elsewhere/my.conf
|
|
|
16
|
|
|
17 =head1 DESCRIPTION
|
|
|
18
|
|
|
19 See etc/parse.conf for all settings.
|
|
|
20
|
|
|
21 =head1 OPTIONS
|
|
|
22
|
|
|
23 =cut
|
|
|
24
|
|
|
25 use strict;
|
|
|
26 use warnings FATAL=>"all";
|
|
|
27
|
|
|
28 use Carp;
|
|
|
29 use Config::General;
|
|
|
30 use Cwd qw(getcwd abs_path);
|
|
|
31 use Data::Dumper;
|
|
|
32 use File::Basename;
|
|
|
33 use FindBin;
|
|
|
34 use Getopt::Long;
|
|
|
35 use Math::Round qw(round nearest);
|
|
|
36 use Math::VecStat qw(sum min max average);
|
|
|
37 use Pod::Usage;
|
|
|
38 use Time::HiRes qw(gettimeofday tv_interval);
|
|
|
39 use Statistics::Basic qw(median);
|
|
|
40 use Storable;
|
|
|
41 use lib "$FindBin::RealBin";
|
|
|
42 use lib "$FindBin::RealBin/../lib";
|
|
|
43 use lib "$FindBin::RealBin/lib";
|
|
|
44
|
|
|
45 our (%OPT,%CONF,$conf);
|
|
|
46 our @COMMAND_LINE = ("file=s",
|
|
|
47 "configfile=s",
|
|
|
48 "help",
|
|
|
49 "cdump",
|
|
|
50 "man",
|
|
|
51 "debug");
|
|
|
52 our $VERSION = 0.02;
|
|
|
53
|
|
|
54 # common and custom module imports below
|
|
|
55 #use Regexp::Common;
|
|
|
56 #use IO::File;
|
|
|
57 #use List::Util;
|
|
|
58 #use List::MoreUtils;
|
|
|
59 use Set::IntSpan;
|
|
|
60 #use Statistics::Descriptive;
|
|
|
61
|
|
|
62 # read and parse configuration file
|
|
|
63 parse_config();
|
|
|
64
|
|
|
65 sub validateconfiguration {
|
|
|
66 }
|
|
|
67
|
|
6
|
68 #map2interval(5,$CONF{cnv}{log2});
|
|
|
69 #exit;
|
|
|
70
|
|
0
|
71 ################################################################
|
|
|
72 # get files
|
|
|
73 my $sv = read_file($CONF{files}{sv} ,"sv" );
|
|
|
74 my $genes = read_file($CONF{files}{mart},"genes");
|
|
|
75 my $cnv = read_file($CONF{files}{cnv} ,"cnv" );
|
|
6
|
76 my $cnvlg = read_file($CONF{files}{cnvlg},"cnvlg");
|
|
|
77 my %affected_genes;
|
|
|
78 open(GENES, $CONF{files}{genes}) or die "#! $CONF{files}{genes}\n";
|
|
|
79 while(<GENES>){
|
|
|
80 chomp;
|
|
|
81 $affected_genes{$_}++;
|
|
|
82 }
|
|
|
83
|
|
|
84
|
|
0
|
85
|
|
|
86 ################################################################
|
|
|
87 # traverse all genes from biomart and determine number
|
|
|
88 # of SV and CNV events across samples
|
|
|
89 for my $chr (keys %$genes) {
|
|
|
90 next if $CONF{filter}{chr} && $chr ne $CONF{filter}{chr};
|
|
|
91 printdebug("processing",$chr);
|
|
|
92 for my $gene (@{$genes->{$chr}}) {
|
|
6
|
93 my $id = $gene->{id};
|
|
|
94 my $name = $gene->{name};
|
|
|
95 #print "GENE: $name, ID: $id\n";
|
|
0
|
96 # filter out by presence and number of SV events
|
|
6
|
97
|
|
0
|
98 # number of samples that have SV event
|
|
|
99 my @samples_sv = keys %{$sv->{$id}};
|
|
6
|
100 if(defined $affected_genes{$name}){
|
|
|
101 #override normal criteria for this gene
|
|
|
102
|
|
|
103 }
|
|
|
104 else{
|
|
|
105 next if $CONF{filter}{sv} && ! $sv->{$id};
|
|
|
106 next if $CONF{filter}{sv_num} && @samples_sv < $CONF{filter}{sv_num};
|
|
|
107 }
|
|
0
|
108 $gene->{affected} = 1;
|
|
|
109
|
|
|
110 # register SV events
|
|
|
111 my $pos;
|
|
|
112 for my $sample (@samples_sv) {
|
|
|
113 for my $sv (sort {$b->{weight} <=> $a->{weight}} @{$sv->{$id}{$sample}}) {
|
|
|
114 $gene->{sv}{ $sv->{type} }++;
|
|
|
115 $gene->{sv}{ "*" }++;
|
|
|
116 $pos->{ $sv->{aa} }++; # register the protein position of the SV
|
|
|
117 next if $CONF{sv}{top_damage_only};
|
|
|
118 }
|
|
|
119 }
|
|
|
120 # top SV event
|
|
|
121 if($gene->{sv}) {
|
|
|
122 my ($sv_top) = sort {$gene->{sv}{$b} <=> $gene->{sv}{$a}} grep($_ ne "*",keys %{$gene->{sv}});
|
|
|
123 $gene->{sv_top}{$sv_top} = $gene->{sv}{$sv_top};
|
|
|
124 }
|
|
|
125 for my $aa (sort {$pos->{$b} <=> $pos->{$a}} keys %$pos) {
|
|
|
126 #next unless $pos->{$aa} > 1;
|
|
|
127 my $n = $pos->{$aa};
|
|
|
128 $gene->{svaa_top}{$aa} = $n if ! defined $gene->{svaa_top};
|
|
|
129 $gene->{svaa}{"*"} += $n;
|
|
|
130 $gene->{svaa}{$aa} = $n;
|
|
|
131 }
|
|
|
132 # register CNV events
|
|
|
133 my @samples_cnv = keys %$cnv;
|
|
|
134 # lookup any CNV events -- this can take a bit of time
|
|
|
135 # we can bin the CNV hash later if needed
|
|
|
136 for my $sample (@samples_cnv) {
|
|
|
137 my $chr = $gene->{chr};
|
|
|
138 next unless $cnv->{$sample}{$chr};
|
|
|
139 for my $cnv (@{$cnv->{$sample}{$chr}}) {
|
|
|
140 my $int = $cnv->{set}->intersect($gene->{set})->cardinality;
|
|
|
141 next unless $int;
|
|
|
142 push @{$gene->{cnv}{$cnv->{category}}{$sample}}, $cnv->{avg};
|
|
|
143 }
|
|
|
144 }
|
|
6
|
145 for my $sample (keys %$cnvlg) {
|
|
|
146 my $chr = $gene->{chr};
|
|
|
147 next unless $cnvlg->{$chr};
|
|
|
148 for my $cnv (@{$cnvlg->{$chr}}) {
|
|
|
149 my $int = $cnv->{set}->intersect($gene->{set})->cardinality;
|
|
|
150 next unless $int;
|
|
|
151 $gene->{cnvlg}{$cnv->{idx}} = $cnv->{type};
|
|
|
152 }
|
|
|
153 }
|
|
0
|
154 }
|
|
|
155 }
|
|
|
156
|
|
|
157 ################################################################
|
|
|
158 # report
|
|
|
159 my $i = 0;
|
|
|
160 for my $chr (1..22,"X","Y") {
|
|
|
161 next unless $genes->{$chr};
|
|
|
162 for my $gene (sort {$a->{start} <=> $b->{start}} @{$genes->{$chr}}) {
|
|
|
163 next unless $gene->{affected};
|
|
|
164 my @report = ($i++,@{$gene}{qw(id name chr start end size)});
|
|
|
165 if($gene->{sv}) {
|
|
|
166 push @report, sprintf("sv_top:%s:%d",keys %{$gene->{sv_top}},values %{$gene->{sv_top}});
|
|
|
167 for my $type (sort keys %{$gene->{sv}}) {
|
|
|
168 push @report, sprintf("sv:%s:%d",$type,$gene->{sv}{$type});
|
|
|
169 }
|
|
|
170 }
|
|
|
171 if($gene->{svaa}) {
|
|
|
172 push @report, sprintf("svaa_top:%s:%d",keys %{$gene->{svaa_top}},values %{$gene->{svaa_top}});
|
|
|
173 for my $aa (sort {$gene->{svaa}{$b} <=> $gene->{svaa}{$a}} keys %{$gene->{svaa}}) {
|
|
|
174 push @report, sprintf("svaa:%s:%d",$aa,$gene->{svaa}{$aa});
|
|
|
175 }
|
|
|
176 }
|
|
|
177 if($gene->{cnv}) {
|
|
|
178 my $type_count;
|
|
|
179 my $delins_count;
|
|
|
180 my $values_by_type;
|
|
|
181 for my $type (sort keys %{$gene->{cnv}}) {
|
|
|
182 my @sample_avg;
|
|
|
183 for my $sample (keys %{$gene->{cnv}{$type}}) {
|
|
|
184 # number of samples with this kind of CNV event
|
|
|
185 $type_count->{$type}++;
|
|
|
186 my @values = @{$gene->{cnv}{$type}{$sample}};
|
|
|
187 push @sample_avg, average(@values);
|
|
|
188 push @{$values_by_type->{$type}}, @values;
|
|
|
189 }
|
|
|
190 push @report, sprintf("cnv:%s:%d:%f:%f:%f:%f",
|
|
|
191 $type,
|
|
|
192 int(@sample_avg),
|
|
|
193 scalar(min(@sample_avg)),
|
|
|
194 average(@sample_avg),
|
|
|
195 median(@sample_avg)->query,
|
|
|
196 scalar(max(@sample_avg)));
|
|
|
197 }
|
|
|
198 my ($top_type) = sort {$type_count->{$b} <=> $type_count->{$a}} keys %$type_count;
|
|
|
199 push @report, sprintf("cnv_top:%s:%d:%f:%f:%f:%f",
|
|
|
200 $top_type,
|
|
|
201 $type_count->{$top_type},
|
|
|
202 scalar(min(@{$values_by_type->{$top_type}})),
|
|
|
203 average(@{$values_by_type->{$top_type}}),
|
|
|
204 median(@{$values_by_type->{$top_type}})->query,
|
|
|
205 scalar(max(@{$values_by_type->{$top_type}})));
|
|
|
206 }
|
|
6
|
207 if($gene->{cnvlg}) {
|
|
|
208 for my $cnv_idx (sort {$a <=> $b} keys %{$gene->{cnvlg}}) {
|
|
|
209 push @report, sprintf("cnvlg:%d:%s",
|
|
|
210 $cnv_idx,
|
|
|
211 $gene->{cnvlg}{$cnv_idx});
|
|
|
212 }
|
|
|
213 }
|
|
0
|
214 printinfo(@report);
|
|
|
215 }
|
|
|
216 }
|
|
|
217
|
|
|
218 exit;
|
|
|
219
|
|
6
|
220 ################################################################
|
|
|
221
|
|
|
222 sub map2value {
|
|
|
223 my ($field_name,$x) = @_;
|
|
|
224 if($CONF{map}{$field_name}) {
|
|
|
225 my ($var,$fn) = split(":",$CONF{map}{$field_name});
|
|
|
226 $fn =~ s/x/$x/g;
|
|
|
227 my $value = eval $fn;
|
|
|
228 die "Could not evaluate remapping [$fn]" if $@;
|
|
|
229 return ($var,$value);
|
|
|
230 } else {
|
|
|
231 return ($field_name,$x);
|
|
|
232 }
|
|
|
233 }
|
|
|
234
|
|
|
235 sub str2leaf {
|
|
|
236 my $str = shift;
|
|
|
237 my $delim = "}{";
|
|
|
238 $str =~ s/\//$delim/g;
|
|
|
239 $str = sprintf("\$CONF{$str}");
|
|
|
240 my $leaf = eval $str;
|
|
|
241 if($@) {
|
|
|
242 die "Could not parse [$str] as a data structure.";
|
|
|
243 }
|
|
|
244 return $leaf;
|
|
|
245 }
|
|
|
246
|
|
0
|
247 sub read_file {
|
|
|
248 my ($file,$type) = @_;
|
|
6
|
249
|
|
0
|
250 open(F,$file) || die "Could not open file [$file] for reading";
|
|
|
251 my $data;
|
|
|
252
|
|
|
253 my @fields = grep(/\d/,keys %{$CONF{fields}{$type}});
|
|
|
254 my @keys = split(",",$CONF{fields}{$type}{key});
|
|
|
255
|
|
6
|
256 my $i = 0;
|
|
0
|
257 while(<F>) {
|
|
|
258 chomp;
|
|
|
259 next if /^\#/;
|
|
|
260 my @tok = split "\t";
|
|
6
|
261 my $entry = {class=>$type,idx=>$i};
|
|
0
|
262 for my $col (@fields) {
|
|
|
263 my ($field_name,$field_transform) = split(":",$CONF{fields}{$type}{$col});
|
|
6
|
264 my ($new_field_name,$value) = map2value($field_name,$tok[$col]);
|
|
|
265 if($new_field_name ne $field_name) {
|
|
|
266 $entry->{$field_name} = $tok[$col];
|
|
|
267 $field_name = $new_field_name;
|
|
|
268 }
|
|
0
|
269 if($field_transform) {
|
|
6
|
270 if($field_transform eq "lc") {
|
|
|
271 $value = lc $value;
|
|
|
272 } elsif ($field_transform =~ /map\((.+),(.+)\)/) {
|
|
|
273 $entry->{$field_name} = $value;
|
|
|
274 $field_name = $1;
|
|
|
275 $value = map2interval($value,str2leaf($2));
|
|
|
276 }
|
|
0
|
277 }
|
|
|
278 $entry->{ $field_name } = $value;
|
|
|
279 }
|
|
|
280 # skip mutation types that are not important
|
|
6
|
281 next if $CONF{sv}{filter} && $type eq "sv" && exists $entry->{type} && ! $CONF{sv}{types}{$entry->{type}};
|
|
0
|
282 next if $CONF{cnv}{filter} && $type eq "cnv" && exists $entry->{category} && ! $CONF{cnv}{types}{$entry->{category}};
|
|
|
283 if($type eq "sv") {
|
|
|
284 $entry->{weight} = $CONF{sv}{types}{$entry->{type}};
|
|
|
285 }
|
|
|
286 $entry->{chr} = "X" if $entry->{chr} eq 23;
|
|
|
287 $entry->{chr} = "Y" if $entry->{chr} eq 24;
|
|
|
288 next unless grep($entry->{chr} eq $_, (1..22,"X","Y"));
|
|
|
289 $entry->{set} = span(@{$entry}{qw(start end)}) if $entry->{start};
|
|
|
290 $entry->{size} = $entry->{set}->cardinality;
|
|
|
291 #printdumper($entry);
|
|
|
292 $i++;
|
|
|
293 if(@keys == 1) {
|
|
|
294 push @{$data->{$entry->{$keys[0]}}}, $entry;
|
|
|
295 } elsif (@keys == 2) {
|
|
|
296 push @{$data->{$entry->{$keys[0]}}{$entry->{$keys[1]}}}, $entry;
|
|
|
297 }
|
|
|
298 }
|
|
|
299 printdebug("got",$i,$type);
|
|
|
300 return $data;
|
|
|
301 }
|
|
|
302
|
|
6
|
303 sub map2interval {
|
|
|
304 my ($x,$conf) = @_;
|
|
|
305 for my $int (keys %$conf) {
|
|
|
306 my $cat = $conf->{$int};
|
|
|
307 return $cat if in_interval($x,$int);
|
|
|
308 }
|
|
|
309 printdumper($conf);
|
|
|
310 die "Could not map $x into any of the intervals seen";
|
|
|
311 }
|
|
|
312
|
|
|
313 sub in_interval {
|
|
|
314 my ($x,$int) = @_;
|
|
|
315 my $open_L = "\\(";
|
|
|
316 my $closed_L = "\\[";
|
|
|
317 my $open_R = "\\)";
|
|
|
318 my $closed_R = "\\]";
|
|
|
319 my $num = "[0-9]*"; #[0-9]+(?:.[0-9]+)?";
|
|
|
320 my $rx = "($open_L|$closed_L)($num),($num)($open_R|$closed_R)";
|
|
|
321 my $bool = 1;
|
|
|
322 if($int =~ /$rx/) {
|
|
|
323 if($2 ne "") {
|
|
|
324 $bool &&= $1 eq "(" ? $x > $2 : $x >= $2;
|
|
|
325 }
|
|
|
326 if($3 ne "") {
|
|
|
327 $bool &&= $4 eq ")" ? $x < $3 : $x <= $3;
|
|
|
328 }
|
|
|
329 } else {
|
|
|
330 $bool = $x == $int;
|
|
|
331 }
|
|
|
332 return $bool;
|
|
|
333 }
|
|
|
334
|
|
0
|
335 sub list2hash {
|
|
|
336 my %h;
|
|
|
337 map {$h{$_}=1} @_;
|
|
|
338 return %h;
|
|
|
339 }
|
|
|
340
|
|
|
341 sub span {
|
|
|
342 my ($x,$y) = @_;
|
|
|
343 if($x==$y) {
|
|
|
344 return Set::IntSpan->new($x);
|
|
|
345 } else {
|
|
|
346 return Set::IntSpan->new("$x-$y");
|
|
|
347 }
|
|
|
348 }
|
|
|
349
|
|
|
350 sub get_handle {
|
|
|
351 my $h;
|
|
|
352 if(my $file = $CONF{file}) {
|
|
|
353 die "No such file [$file]" unless -e $file;
|
|
|
354 open(FILE,$file);
|
|
|
355 $h = \*FILE;
|
|
|
356 } else {
|
|
|
357 $h = \*STDIN;
|
|
|
358 }
|
|
|
359 return $h;
|
|
|
360 }
|
|
|
361
|
|
|
362 # HOUSEKEEPING ###############################################################
|
|
|
363
|
|
|
364 sub dump_config {
|
|
|
365 printdumper(\%OPT,\%CONF);
|
|
|
366 }
|
|
|
367
|
|
|
368 sub parse_config {
|
|
|
369 my $dump_debug_level = 3;
|
|
|
370 GetOptions(\%OPT,@COMMAND_LINE);
|
|
|
371 pod2usage() if $OPT{help};
|
|
|
372 pod2usage(-verbose=>2) if $OPT{man};
|
|
|
373 loadconfiguration($OPT{configfile});
|
|
|
374 populateconfiguration(); # copy command line options to config hash
|
|
|
375 validateconfiguration();
|
|
|
376 if ($CONF{cdump}) {
|
|
|
377 $Data::Dumper::Indent = 2;
|
|
|
378 $Data::Dumper::Quotekeys = 0;
|
|
|
379 $Data::Dumper::Terse = 0;
|
|
|
380 $Data::Dumper::Sortkeys = 1;
|
|
|
381 $Data::Dumper::Varname = "OPT";
|
|
|
382 printdumper(\%OPT);
|
|
|
383 $Data::Dumper::Varname = "CONF";
|
|
|
384 printdumper(\%CONF);
|
|
|
385 exit;
|
|
|
386 }
|
|
|
387 }
|
|
|
388
|
|
|
389 sub populateconfiguration {
|
|
|
390 for my $var (keys %OPT) {
|
|
|
391 $CONF{$var} = $OPT{$var};
|
|
|
392 }
|
|
|
393 repopulateconfiguration(\%CONF);
|
|
|
394 }
|
|
|
395
|
|
|
396 sub repopulateconfiguration {
|
|
|
397 my ($node,$parent_node_name) = shift;
|
|
|
398 return unless ref($node) eq "HASH";
|
|
|
399 for my $key (keys %$node) {
|
|
|
400 my $value = $node->{$key};
|
|
|
401 if (ref($value) eq "HASH") {
|
|
|
402 repopulateconfiguration($value,$key);
|
|
|
403 } elsif (ref($value) eq "ARRAY") {
|
|
|
404 for my $item (@$value) {
|
|
|
405 repopulateconfiguration($item,$key);
|
|
|
406 }
|
|
|
407 } elsif (defined $value) {
|
|
|
408 my $new_value = parse_field($value,$key,$parent_node_name,$node);
|
|
|
409 $node->{$key} = $new_value;
|
|
|
410 }
|
|
|
411 }
|
|
|
412 }
|
|
|
413
|
|
|
414 sub parse_field {
|
|
|
415 my ($str,$key,$parent_node_name,$node) = @_;
|
|
|
416 # replace configuration field
|
|
|
417 # conf(LEAF,LEAF,...)
|
|
|
418 while ( $str =~ /(conf\(\s*(.+?)\s*\))/g ) {
|
|
|
419 my ($template,$leaf) = ($1,$2);
|
|
|
420 if (defined $template && defined $leaf) {
|
|
|
421 my @leaf = split(/\s*,\s*/,$leaf);
|
|
|
422 my $new_template;
|
|
|
423 if (@leaf == 2 && $leaf[0] eq ".") {
|
|
|
424 $new_template = $node->{$leaf[1]};
|
|
|
425 } else {
|
|
|
426 $new_template = fetch_conf(@leaf);
|
|
|
427 }
|
|
|
428 $str =~ s/\Q$template\E/$new_template/g;
|
|
|
429 }
|
|
|
430 }
|
|
|
431 if ($str =~ /\s*eval\s*\(\s*(.+)\s*\)/) {
|
|
|
432 my $fn = $1;
|
|
|
433 $str = eval $fn;
|
|
|
434 if ($@) {
|
|
|
435 die "could not parse configuration parameter [$@]";
|
|
|
436 }
|
|
|
437 }
|
|
|
438 return $str;
|
|
|
439 }
|
|
|
440
|
|
|
441 sub fetch_configuration {
|
|
|
442 my @config_path = @_;
|
|
|
443 my $node = \%CONF;
|
|
|
444 if(! @config_path) {
|
|
|
445 return \%CONF;
|
|
|
446 }
|
|
|
447 for my $path_element (@config_path) {
|
|
|
448 if (! exists $node->{$path_element}) {
|
|
|
449 return undef;
|
|
|
450 } else {
|
|
|
451 $node = $node->{$path_element};
|
|
|
452 }
|
|
|
453 }
|
|
|
454 return $node;
|
|
|
455 }
|
|
|
456
|
|
|
457 sub fetch_conf {
|
|
|
458 return fetch_configuration(@_);
|
|
|
459 }
|
|
|
460
|
|
|
461 sub loadconfiguration {
|
|
|
462 my $file = shift;
|
|
|
463 if (defined $file) {
|
|
|
464 if (-e $file && -r _) {
|
|
|
465 # provided configuration file exists and can be read
|
|
|
466 $file = abs_path($file);
|
|
|
467 } else {
|
|
|
468 confess "The configuration file [$file] passed with -configfile does not exist or cannot be read.";
|
|
|
469 }
|
|
|
470 } else {
|
|
|
471 # otherwise, try to automatically find a configuration file
|
|
|
472 my ($scriptname,$path,$suffix) = fileparse($0);
|
|
|
473 my $cwd = getcwd();
|
|
|
474 my $bindir = $FindBin::RealBin;
|
|
|
475 my $userdir = $ENV{HOME};
|
|
|
476 my @candidate_files = (
|
|
|
477 "$cwd/$scriptname.conf",
|
|
|
478 "$cwd/etc/$scriptname.conf",
|
|
|
479 "$cwd/../etc/$scriptname.conf",
|
|
|
480 "$bindir/$scriptname.conf",
|
|
|
481 "$bindir/etc/$scriptname.conf",
|
|
|
482 "$bindir/../etc/$scriptname.conf",
|
|
|
483 "$userdir/.$scriptname.conf",
|
|
|
484 );
|
|
|
485 my @additional_files = ();
|
|
|
486 for my $candidate_file (@additional_files,@candidate_files) {
|
|
|
487 #printinfo("configsearch",$candidate_file);
|
|
|
488 if (-e $candidate_file && -r _) {
|
|
|
489 $file = $candidate_file;
|
|
|
490 #printinfo("configfound",$candidate_file);
|
|
|
491 last;
|
|
|
492 }
|
|
|
493 }
|
|
|
494 }
|
|
|
495 if (defined $file) {
|
|
|
496 $OPT{configfile} = $file;
|
|
|
497 $conf = new Config::General(
|
|
|
498 -ConfigFile=>$file,
|
|
|
499 -IncludeRelative=>1,
|
|
|
500 -IncludeAgain=>1,
|
|
|
501 -ExtendedAccess=>1,
|
|
|
502 -AllowMultiOptions=>"yes",
|
|
|
503 #-LowerCaseNames=>1,
|
|
|
504 -AutoTrue=>1
|
|
|
505 );
|
|
|
506 %CONF = $conf->getall;
|
|
|
507 }
|
|
|
508 }
|
|
|
509
|
|
|
510 sub printdebug {
|
|
|
511 printinfo("debug",@_) if defined $CONF{debug};
|
|
|
512 }
|
|
|
513
|
|
|
514 sub printinfo {
|
|
|
515 print join(" ",map { defined $_ ? $_ : "_undef_" } @_),"\n";
|
|
|
516 }
|
|
|
517
|
|
|
518 sub printfinfo {
|
|
|
519 my ($fmt,@args) = @_;
|
|
|
520 @args = map { defined $_ ? $_ : "_undef_" } @args;
|
|
|
521 printf("$fmt\n",@args);
|
|
|
522 }
|
|
|
523
|
|
|
524 sub printerr {
|
|
|
525 print STDERR join(" ",map { defined $_ ? $_ : "_undef_" } @_),"\n";
|
|
|
526 }
|
|
|
527
|
|
|
528 sub printdumper {
|
|
|
529 print Dumper(@_);
|
|
|
530 }
|
|
|
531
|
|
|
532 =pod
|
|
|
533
|
|
|
534 =head1 HISTORY
|
|
|
535
|
|
|
536 =over
|
|
|
537
|
|
|
538 =item * 30 Nov 2015
|
|
|
539
|
|
|
540 Started.
|
|
|
541
|
|
|
542 =back
|
|
|
543
|
|
|
544 =head1 AUTHOR
|
|
|
545
|
|
|
546 Martin Krzywinski
|
|
|
547
|
|
|
548 =head1 CONTACT
|
|
|
549
|
|
|
550 Martin Krzywinski
|
|
|
551 Genome Sciences Center
|
|
|
552 BC Cancer Research Center
|
|
|
553 100-570 W 7th Ave
|
|
|
554 Vancouver BC V5Z 4S6
|
|
|
555
|
|
|
556 mkweb.bcgsc.ca
|
|
|
557 martink@bcgsc.ca
|
|
|
558
|
|
|
559 =cut
|
