#declaration de l espace de travail et du chemin de l executable R : use strict; use Carp; use Statistics::R; use Cwd qw(abs_path); use File::Basename; use Getopt::Long; my ($file_in,$NA_code,$stat,$stat_chosen,$ploting,$plot_chosen,$outputfile); my ($working_dir,$r_bin,$log_dir,$R,$cmd,$line,$stat_out); #pour voir ce que le xml renvoie au wrapper perl. Sachant que $0 est la ligne de commande et @ARGV les arguments #printf STDERR "%s\n",join("***** ",$0,@ARGV); #Parametres d'entree my $file_in; #fichier de donnees en entree #--filein $file_in my $NA_code; #ex : "NA" Comment specifier "" #--NAcode $NA_code my $stat; #Valeurs possibles T or F #--statcondstat $stat_cond.stat my $stat_chosen; #ex : "mean,sd,variance,median,quartile,decile" #--statcondstatchosen $stat_cond.stat_chosen (IF) my $ploting; #Valeurs possibles T or F #--plotingcondploting $ploting_cond.ploting my $plot_chosen; #ex : "boxplot,histogram,density,pairsplot,MAplot" #--statcondplotchosen $stat_cond.plot_chosen (IF) my $outputfile; #--outputfile $outputfile Getopt::Long::Configure( 'no_ignorecase', 'bundling' ); GetOptions ( 'filein=s' => \$file_in, 'NAcode=s' => \$NA_code, 'statcondstat=s' => \$stat, 'statcondstatchosen=s' => \$stat_chosen, 'plotingcondploting=s' => \$ploting, 'plotingcondplotchosen=s' => \$plot_chosen, 'outputfile=s' => \$outputfile ) or die "Usage: Error in command line arguments\n"; print STDOUT "Input file : $file_in \n NAcode : $NA_code\n stat cond : $stat \n stat chosen : $stat_chosen \n ploting cond $ploting \n plot chosen : $plot_chosen \n outputfile : $outputfile \n "; #Récuperer le numero (unique) de l'output my ($nb) = ($outputfile=~/galaxy_dataset_(\d+)\.\S+$/); #On suppose que le fichier de donnees en entree a ete place dans un repertoire #de travail working_dir ## smaman : $working_dir=abs_path($file_in); #Repertoire de sortie cree par le script, verif des droits d'ecriture sur ce repertoire de sortie my $working_dir= "."; #$working_dir=~s/\/[^\/]*$//; #$file_in=~s/^.*\///; #Recuperation de la matrice entrante dans le repertoir de travail #Fichier de sortie des donnees de description statistiques #smaman #$stat_out=$file_in; #$stat_out=~s/\.([^.]*)$/_statistics.$1/; #smaman $stat_out = "$working_dir/stat_out"; # Rbin path $r_bin = '/usr/local/bioinfo/src/R/current/bin/R'; #Log dir $log_dir = $working_dir; #déaration de l'objet $R et ouverture du pont : $R = Statistics::R->new( "r_bin" => $r_bin, "log_dir" => $log_dir, ) or die "Problem with R : $!\n"; # Ouverture du pont $R->startR; #envoi du repertoire de travail $R->send( qq` setwd("$working_dir") `); #Read R script $cmd=""; open IN,"< Graphics_desc.R" or die "Unable to read R script : $!\n"; while ($line=) { $cmd.=$line; } close(IN); #Declare R function $R->send($cmd); my $NA_code2 = " "; if ($NA_code eq ""){$NA_code = $NA_code2} else {$NA_code = $NA_code}; $R->send( qq` desc_fct(file.in="$working_dir/infile", nacode="$NA_code",stat.out="$working_dir/stat_out",stat=$stat, chosen.stat="$stat_chosen",ploting=$ploting,chosen.plot="$plot_chosen") ` ); print STDOUT "APPEL R : desc_fct(file.in=\"$working_dir/infile\", nacode=\"$NA_code\",stat.out=\"$working_dir/stat_out\",stat=$stat, chosen.stat=\"$stat_chosen\",ploting=$ploting,chosen.plot=\"$plot_chosen\")\n\n"; #Fermeture du pont $R->stopR(); #Mise en forme d'un rapport HTML open OUT,"> $working_dir/statistics_report.html" or die "Unable to create HTML output file : $!\n"; print OUT "Descriptive statistics\n"; print OUT "\n"; #if (-f "$working_dir/$stat_out" ) { if (-f "$working_dir/stat_out" ) { print OUT "

Statistical measures :

\n"; print OUT "\n"; # open IN,"< $working_dir/$stat_out" open IN,"< $working_dir/stat_out" # or die "Unable to open $working_dir/$stat_out : $!\n"; or die "Unable to open $working_dir/stat_out : $!\n"; my $noLine=0; while ($line=) { chomp($line); $noLine++; if ($noLine==1) { $line=~s/\t/<\/TH>\n"; next; } $line=~s/\t/<\/TD>\n"; } #print OUT "

/g; print OUT "
$line
/g; $line=~s/<\/TD>/<\/TH>/; #pour la premiere colonne print OUT "
$line

Download table

\n"; my $file ="$working_dir/stat_out"; my $file2 = "/galaxydata/database/files/workspace/$nb.stat_out" ; `cp $file $file2;`; $file2 =~s/^\/galaxydata\/database\/files\/workspace/\/galaxy-dev\/download/; #print OUT "
Download table

\n"; print OUT "
Download table

\n"; } my ($idxFile,$graphicType,$i,$label,$file,$graphicTypeList,$graphicList); my (@files); @files=glob("$working_dir/*png"); if ($#files!=-1) { $idxFile=0; $graphicList=join " ",@files; $graphicList=~s/ [^ ]*\// /g; $graphicList=~s/^[^ ]*\///g; system("cd $working_dir; tar czf all_graphics.tgz $graphicList"); while ($idxFile<=$#files) { if ($idxFile==0) { print OUT "

Statistical graphics :

\n"; } $graphicType=$files[$idxFile]; $graphicType=~s/^.*\///; $graphicType=~s/_.*$//; $graphicTypeList=""; $i=$idxFile; #smaman #my $graph = "${graphicType}_graphics.tgz"; my $graph = "${graphicType}_graphics.tgz"; # print OUT "1 : $graph"; my $graph_url = "$working_dir/$graph"; my $graph_url2 = "/galaxydata/database/files/workspace/$nb.$graph" ; `ln -s $graph_url $graph_url2;`; # print OUT "cp $graph_url $graph_url2;"; $graph_url2 =~s/^\/galaxydata\/database\/files\/workspace/\/galaxy-dev\/download/; print OUT ""; while ($files[$i]=~/\/${graphicType}_/) { $file=$files[$i]; $file=~s/^.*\///; if ($graphicTypeList ne "") {$graphicTypeList.=" ";} $graphicTypeList.=$file; my $file_url = "$working_dir/$file"; my $file_url2 = "/galaxydata/database/files/workspace/$nb.$file" ; `cp $file_url $file_url2;`; $file_url2 =~s/^\/galaxydata\/database\/files\/workspace/\/galaxy-dev\/download/; print OUT ""; $i++; if ($i>$#files) {last;} } print OUT "

$graphicType

\n"; system("cd $working_dir; tar czf ${graphicType}_graphics.tgz $graphicTypeList"); $idxFile=$i+1; } #smaman my $graphs_tar = "$working_dir/all_graphics.tgz"; my $graphs_tar2 = "/galaxydata/database/files/workspace/$nb.all_graphics.tgz" ; `cp $graphs_tar $graphs_tar2;`; $graphs_tar2 =~s/^\/galaxydata\/database\/files\/workspace/\/galaxy-dev\/download/; #print OUT "Download all graphics\n"; print OUT "Download all graphics\n"; print OUT ""; close(OUT); } #Recuperation des outputs dans Galaxy my $cmdhtml =''; my $out= "$working_dir/statistics_report.html"; if (! -e $out){print STDERR "Pas de fichier html produit \n";} else {$cmdhtml = "(mv $out $outputfile) >& ./cp_html.log 2>&1"; system $cmdhtml;}