#!/usr/bin/perl -w
use strict;
use warnings;

# perl command for this script : 
####################################################
# perl JasparDBmemeParsing.pl  folder jasparfolder
# perl JasparDBmemeParsing.pl  file jasparfile
####################################################

# 12 May 2020 : rev 2 (25 March 2020 : rev 1)
# this script loads motif matrix profiles in .meme format from the jaspar database
# and creates a file describing the motif matrices in PWM format for MotifSuite. 

# ARGV[0] = 'folder' or 'file'
# ARGV[1] = the jaspar input 
# the Jaspar input can be in "folder" format : use "folder" followed by the name of the folder containing the individual files each describing one matrix profile in MEME format
##### MEME format == file extension equals ".meme" - as provided per Jaspar download
# the Jaspar input can be in "file" format : use "file" followed by the name of the file describing all the matrix profiles in MEME format

# the output = a PWM databasefile with a name based on ARGV[1]_DB.mtrx
  
# Additionally to this script, the created database must be made available in the webservice :
# add the files to /var/www/html/MotifSuite/motifcomparison-motif-databases
# make them selectable via motifcomparison.php and motiflocator.php

# Author : Marleen Claeys - questions or remarks : mclaeys.mc@gmail.com
############################################################################

if ($ARGV[0] ne "folder" && $ARGV[0] ne "file") { 
  print "Error: 'file' or 'folder' was not described as input for script [perl JasparDBmemeParsing.pl  file|folder jasparfile|folder]. Exit.\n"; exit(-1);
} 
my $fileformat = 0; if ( $ARGV[0] eq 'file') { $fileformat = 1;}

if (not defined $ARGV[1]) { 
  print "Error : Jaspar (file or folder) name was not defined as input for script [perl JasparDBmemeParsing.pl  file|folder jasparfile|folder]. Exit.\n"; exit(-1);
} 

my $inputpath = "./";
my $jasparfilename = $ARGV[1]; 
my $outputfile = $ARGV[1]; # use input file or folder name as basis

if (!$fileformat) { 
  $inputpath .= $ARGV[1]; #folder
  $jasparfilename = "?";  
} 
else { 

  if ( !isMEME($jasparfilename))
  {
    print "Warning: We note '.$jasparfilename.' does not have the '.meme' file-extension. If the matrix profiles IN this file are not in MEME format, you will receive an emtpy file as output. If this happens, consult the JASPAR source for details on the requested MEME format.\n";
  }
}

# open/create the outputfile to write results 
$outputfile =~ s/\.+/_/; # replace all dots with underscores
$outputfile .= "_DB.mtrx";

if (-e $outputfile) {
  print "Warning: ".$outputfile." already exists. Please first delete, remove or rename the existing file. Exit for safety.\n"; exit(-1);}
open(FO,'>>', $outputfile) or die $!;
print FO "#INCLUSive Motif Model\n#\n";
print FO "#PWM Database constructed based on ".$ARGV[1]."\n";
print FO "#Printed on local Date/Time = "; print FO scalar localtime();
print FO "\n#with script [perl JasparDBmemeParsing.pl  file|folder jasparfile|folder]\n";
print FO "#Number of printed motifs=XX ";
if (!$fileformat){ print FO "(out of files-in-folder=XX)";}
print FO "\n";
print FO "#Citation Source http://jaspar.genereg.net/downloads/\n\n";

#local variables
my $memefile;
my $counterFiles = 0; #for folder-format
my $counterPrint = 0;  
my $line = "";
my $ID = "";
my $parsedresult = "";
my $matrix = "";
 
# open de folder with MEME file(s) 
opendir (DIR, $inputpath) or die $!; # ./ or ./jasparfolder
# process each file
while ( my $memefile = readdir(DIR))
{ 
  $memefile = $inputpath."/".$memefile;
  # pick the input jasparfile if so provided
  if ( $fileformat) { 
   $memefile = $inputpath.$jasparfilename;
   $counterFiles = 0;
  }
  elsif (!isMEME($memefile)) # files-in-folder expected to have .meme extension
  { print "Warning: ".$memefile." is not a .meme file. Skip file.\n"; 
    next;
  }
  open(FI,'<', $memefile) or die $!;
  $counterFiles++;
  #read through file
  while (!eof) 
  {
    $line = <FI>; chomp($line);
    if ( isMOTIF($line)) #MOTIF UN0001.1 PK00315.1
    { 
      $ID = "";
      $line =~ s/\s+/_/g; $ID = "#ID = ".$line;
      #read next line
      #letter-probability matrix: alength= 4 w= 11 nsites= 998 E= 0
      $line = <FI>; chomp($line);
      my ($w, $nsites) = isINFO($line); 
      if ( !($w > 0 && $nsites > 0)) 
      { print "Error_INFO: ".$memefile." is not in correct MEME format. Exit.\n"; exit(-1);} 
      $ID .= "_nsites=".$nsites;
      #read the next w lines 
      $matrix = "";
      for (my $i = 0; $i < $w; $i++)
      { $line = <FI>; chomp($line);
        $line =~ s/^\s+//; #first white space
        $line =~ s/\s+/_/g; #other white spaces
        my @splitt = split("_",$line);
        if ( scalar(@splitt) != 4 ) 
        { print "Error_PROB: ".$memefile." is not in correct MEME format. Exit.\n"; exit(-1);} 
        $line = join("\t",@splitt);
        $matrix .= $line."\n";
      }
      # read the last line
      # URL http://jaspar.genereg.net/matrix/UN0001.1
      $line = <FI>; chomp($line);
      if (!isURL($line))
      { print "Error_URL: ".$memefile." is not in correct MEME format. Exit.\n"; exit(-1);} 
      $line =~ s/\s+/_/g;; $ID .= "_".$line."\n";
      #collect the parsed results 
      $parsedresult = $ID."#Score = NA\n#W = ".$w."\n#Consensus = NA\n".$matrix;
      $matrix = ""; #reset
      print FO $parsedresult."\n";
      $counterPrint++;  
    }
  }
  close FI; 
  # break DIR as there's only 1 jasparinputfile
  if ($fileformat){last;}
}
close DIR; 
close FO;

# end the script with information
print "Program ends succesfully. ".$counterPrint." motifs ";
if (!$fileformat){print "(from ".$counterFiles." input motifs) "}
print "were added to ".$outputfile.".\n"; 
print "Use these commands to update the number_of_motifs information in the outputfile :\n";
print "perl -pi -e 's/motifs=XX/motifs=".$counterPrint."/' ".$outputfile."\n";
if (!$fileformat) {
print "perl -pi -e 's/files-in-folder=XX/files-in-folder==".$counterFiles."/' ".$outputfile."\n";}

exit(1);

#######
# xx.meme
sub isMEME {
  my ($filename) = @_;
  my $tail = substr($filename, -5); 
  if ($tail ne '.meme')
  { return 0; } else {return 1;}
}

#MOTIF UN0001.1 PK00315.1
sub isMOTIF {
  my ($read) = @_;
  my @splitt = split(' ',$read);
  if (scalar(@splitt) > 0 && $splitt[0] eq 'MOTIF') {return 1;}
  else {return 0;}
}

# letter-probability matrix: alength= 4 w= 11 nsites= 2000 E= 0
sub isINFO {
  my ($read) = @_;
  my @splitt = split(' ',$read);
  my $ww = 0; 
  my $nnsites = 0; 
  if (scalar(@splitt) > 7 && $splitt[4] eq "w=")    
  { $ww = $splitt[5]; $nnsites = $splitt[7];}
  return ($ww, $nnsites);
}
# URL http://jaspar.genereg.net/matrix/MA0002.2
sub isURL {
  my ($read) = @_;
  my @splitt = split(' ',$read);
  if (scalar(@splitt) > 0 && $splitt[0] eq 'URL') {return 1;}
  else {return 0;}
}

#############################


