Mercurial > repos > mini > strelka

comparison lib/Utils.pm @ 6:87568e5a7d4f

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