annotate lib/Utils.pm @ 14:ca84a74ff567

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