annotate strelka2/lib/Utils.pm @ 0:7a9f20ca4ad5

Uploaded
author mini
date Thu, 25 Sep 2014 11:59:08 -0400
parents
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
1
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
2 =head1 LICENSE
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
3
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
4 Strelka Workflow Software
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
5 Copyright (c) 2009-2013 Illumina, Inc.
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
6
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
7 This software is provided under the terms and conditions of the
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
8 Illumina Open Source Software License 1.
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
9
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
10 You should have received a copy of the Illumina Open Source
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
11 Software License 1 along with this program. If not, see
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
12 <https://github.com/downloads/sequencing/licenses/>.
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
13
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
14 =cut
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
15
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
16
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
17 package Utils;
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
18
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
19 use base 'Exporter';
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
20
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
21 our @EXPORT = qw(
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
22 errorX logX executeCmd checkFile checkDir checkMove
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
23 getAbsPath checkMakeDir getBinList
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
24 parseConfigIni writeConfigIni
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
25 );
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
26
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
27 use warnings FATAL => 'all';
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
28 use strict;
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
29
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
30 use Carp;
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
31 use Cwd qw(realpath);
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
32 use File::Copy qw(move);
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
33 use File::Path qw(mkpath);
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
34
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
35
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
36 sub errorX($) {
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
37 confess "\nERROR: " . $_[0] . "\n\n";
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
38 }
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
39
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
40 sub logX($) {
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
41 print STDERR "INFO: " . $_[0] . "\n";
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
42 }
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
43
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
44
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
45 sub executeCmd($;$) {
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
46 my $cmd = shift;
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
47 my $isVerbose = shift;
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
48
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
49 logX("Running: '$cmd'") if(defined($isVerbose) and $isVerbose);
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
50 system($cmd) == 0
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
51 or errorX("Failed system call: '$cmd'");
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
52 }
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
53 #return an error if file does not exist
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
54 sub checkFile($;$) {
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
55 my $file = shift;
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
56 return if(-f $file);
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
57 my $label = shift;
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
58 errorX("Can't find" . (defined($label) ? " $label" : "") . " file: '$file'");
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
59 }
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
60 #return an error if file does not Exist
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
61 sub checkDir($;$) {
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
62 my $dir = shift;
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
63 return if(-d $dir);
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
64 my $label = shift;
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
65 errorX("Can't find" . (defined($label) ? " $label" : "") . " directory: '$dir'");
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
66 }
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
67
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
68 sub checkMove($$) {
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
69 my ($old,$new) = @_;
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
70 move($old,$new) || errorX("File move failed: $!\n\tAttempting to move '$old' to '$new'");
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
71 }
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
72
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
73
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
74
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
75
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
76 =item getAbsPath($path)
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
77
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
78 This procedure attempts to convert a path provided by the user on the
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
79 command line into an absolute path. It should be able to handle "~"
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
80 paths and conventional relative paths using ".." or ".". Resolution of
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
81 links should follow the convention of "Cwd::realpath".
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
82
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
83 B<Parameters:>
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
84
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
85 $dirRef - path (converted to absolute path in place)
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
86
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
87 B<Returns:>
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
88
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
89 returns zero if successful, non-zero otherwise.
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
90
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
91 =cut
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
92 sub getAbsPath(\$) {
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
93 my ($dirRef) = @_;
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
94 my @tmp=glob($$dirRef);
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
95 return 1 if(scalar(@tmp) != 1);
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
96 my $ret = Cwd::realpath($tmp[0]);
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
97 return 1 if !$ret && !($ret = File::Spec->rel2abs($tmp[0]));
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
98 $$dirRef = $ret;
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
99 return 0;
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
100 }
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
101
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
102
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
103 #verify path is not a file, then create a directory with this name if does not exist
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
104 sub checkMakeDir($) {
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
105 my $dir = shift;
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
106 unless (-e $dir) {
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
107 File::Path::mkpath($dir) || errorX("Can't create directory '$dir'");
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
108 } else {
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
109 errorX("Path is not a directory '$dir'\n") unless(-d $dir);
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
110 }
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
111 }
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
112
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
113
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
114
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
115 sub getBinList($$) {
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
116 my ($chromSize,$binSize) = @_;
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
117
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
118 my $nm1 = (($chromSize-1) / $binSize);
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
119 return [ map {sprintf("%04i",$_)} (0..$nm1) ];
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
120 }
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
121
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
122
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
123
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
124 sub parseConfigError($$) {
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
125 my ($file,$line) = @_;
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
126 errorX("Config file '$file' contains unexpected line '$line'\n");
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
127 }
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
128
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
129 #lis le fichier de config, si la ligne est de type : some space + [ some character ] + some space then register ther character in $section. ( [user] , then $section=user).
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
130 sub parseConfigIni($) {
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
131 my $file = shift;
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
132 my %config;
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
133 open(my $FH,"< $file") || errorX("Can't open config file '$file'");
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
134 my $section = "noSection";
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
135 while(<$FH>) {
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
136 next if(/^[;#]/);
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
137 next if(/^\s*$/);
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
138 chomp;
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
139 my $line=$_;
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
140 my @ncl = split(/[;#]/);
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
141 next unless(scalar(@ncl));
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
142 my $nc = $ncl[0];
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
143 if($nc =~ /^\s*\[([^\]]*)\]\s*$/) {
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
144 $section = $1;
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
145 next;
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
146 }
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
147 my ($key,$val) = map { s/^\s+//; s/\s+$//; $_ } split(/=/,$nc,2);
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
148 unless(defined($key) && defined($val) && ($key ne "")) { parseConfigError($file,$line); }
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
149
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
150 $config{$section}{$key} = $val;
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
151 }
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
152 close($FH);
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
153 return \%config;
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
154 }
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
155
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
156
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
157 # minimal ini stringifier:
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
158 #
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
159 sub writeConfigIni($) {
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
160 my $config = shift;
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
161 my $val = "";
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
162 for my $section (sort(keys(%$config))) {
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
163 $val .= "\n[$section]\n";
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
164 for my $key (sort(keys(%{$config->{$section}}))) {
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
165 $val .= "$key = " . $config->{$section}{$key} . "\n";
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
166 }
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
167 }
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
168 return $val;
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
169 }
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
170
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
171
7a9f20ca4ad5 Uploaded
mini
parents:
diff changeset
172 1;