| 6 | 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; |