#!/usr/bin/perl
# this script reads a DNA sequence on STDIN (fasta format)
# and runs a hardcoded promoter profile (sigma 70 + UP element + FIS binding site) 

use SOAP::Lite;
use strict;

my $tools = SOAP::Lite
		->service('http://www.cbs.dtu.dk/ws/SmallTools/SmallTools_1_0.wsdl')
		->on_fault(
			sub { my($self, $res) = @_;
				die 
				"faultcode:", ref $res ? $res->faultcode : $self->transport->status, "\n" , 
				"faultstring:", ref $res ? $res->faultstring : $self->transport->status, "\n" , 
				;
		});
		
my @IDS;
my @SEQ;
	
# read fasta sequence from STDIN
my $id = -1;
while (<>) {
	chomp;
	if ( /^>(.*)/ ) {
		$id++;
		$IDS[$id] = $1;
	} elsif (/^([A-Za-z]+)$/) {
		$SEQ[$id] .= $1;
	}
}


foreach my $id (0 .. $#IDS) {
	my $xml = "
<parameters>
<sequence>$SEQ[$id]</sequence>
<unit>
	<pwm>
		<id>-10 region</id>
		<weight>1</weight>
		<A>0</A><A>90</A><A>0</A><A>91</A><A>91</A><A>0</A>
		<T>90</T><T>1</T><T>91</T><T>0</T><T>0</T><T>90</T>
		<G>1</G><G>0</G><G>0</G><G>0</G><G>0</G><G>0</G>
		<C>0</C><C>0</C><C>0</C><C>0</C><C>0</C><C>1</C>
	</pwm>
	<spacer>
		<min>13</min>
		<center>16</center>
		<max>19</max>
	</spacer>
</unit>
<unit>
	<pwm>
		<id>-35 region</id>
		<weight>1</weight>
		<A>1</A><A>0</A><A>0</A><A>0</A><A>0</A><A>52</A>
		<T>90</T><T>91</T><T>0</T><T>77</T><T>1</T><T>13</T>
		<G>0</G><G>0</G><G>91</G><G>1</G><G>26</G><G>13</G>
		<C>0</C><C>0</C><C>0</C><C>13</C><C>64</C><C>13</C>
	</pwm>
	<spacer>
		<min>0</min>
		<center>3</center>
		<max>6</max>
	</spacer>
</unit>
<unit>
	<pwm>
		<id>UP element</id>
		<weight>0.5</weight>
		<A>25</A><A>0</A><A>61</A><A>38</A><A>65</A><A>77</A><A>75</A><A>77</A><A>26</A><A>13</A><A>65</A><A>13</A><A>2</A><A>14</A><A>25</A><A>66</A><A>77</A><A>66</A><A>13</A><A>7</A><A>0</A><A>13</A>
		<T>66</T><T>16</T><T>0</T><T>1</T><T>25</T><T>0</T><T>14</T><T>13</T><T>53</T><T>64</T><T>25</T><T>78</T><T>64</T><T>64</T><T>39</T><T>12</T><T>13</T><T>25</T><T>78</T><T>77</T><T>91</T><T>25</T>
		<G>0</G><G>14</G><G>29</G><G>52</G><G>1</G><G>1</G><G>2</G><G>1</G><G>12</G><G>13</G><G>0</G><G>0</G><G>1</G><G>13</G><G>14</G><G>0</G><G>0</G><G>0</G><G>0</G><G>7</G><G>0</G><G>0</G>
		<C>0</C><C>61</C><C>1</C><C>0</C><C>0</C><C>13</C><C>0</C><C>0</C><C>0</C><C>1</C><C>1</C><C>0</C><C>24</C><C>0</C><C>13</C><C>13</C><C>1</C><C>0</C><C>0</C><C>0</C><C>0</C><C>53</C>
	</pwm>
	<spacer>
		<min>-4</min>
		<center>2</center>
		<max>4</max>
	</spacer>
</unit>
<unit>
	<pwm>
		<id>FIS</id>
		<weight>0.5</weight>
		<threshold>0</threshold>
		<A>38</A><A>39</A><A>26</A><A>0</A><A>26</A><A>13</A><A>0</A><A>39</A><A>78</A><A>77</A><A>77</A><A>65</A><A>59</A><A>10</A><A>0</A><A>51</A><A>15</A><A>0</A><A>26</A><A>31</A><A>26</A>
		<T>52</T><T>51</T><T>65</T><T>0</T><T>0</T><T>53</T><T>65</T><T>0</T><T>0</T><T>1</T><T>13</T><T>0</T><T>26</T><T>65</T><T>1</T><T>0</T><T>0</T><T>1</T><T>1</T><T>0</T><T>65</T>
		<G>1</G><G>0</G><G>0</G><G>91</G><G>26</G><G>13</G><G>26</G><G>52</G><G>13</G><G>13</G><G>1</G><G>26</G><G>6</G><G>16</G><G>64</G><G>0</G><G>76</G><G>0</G><G>64</G><G>60</G><G>0</G>
		<C>0</C><C>1</C><C>0</C><C>0</C><C>39</C><C>12</C><C>0</C><C>0</C><C>0</C><C>0</C><C>0</C><C>0</C><C>0</C><C>0</C><C>26</C><C>40</C><C>0</C><C>90</C><C>0</C><C>0</C><C>0</C>
	</pwm>
</unit>
</parameters>";

  my $infscan_request = SOAP::Data->type('xml' => $xml);
	my $result = $tools->infscan($infscan_request);
	my @RESULT;
	if ( ref ( $result->{entry} ) eq 'ARRAY') {
		@RESULT = @{$result->{entry}};
	} else {
		@RESULT = ( $result->{entry});
	}
	foreach my $r (@RESULT) {
		print $IDS[$id],"\t",$r->{pos},"\t",$r->{bitscore_tot};
		my @UNIT;
		if (ref ( $r->{unit} ) eq 'ARRAY') {
			@UNIT = @{$r->{unit}};
		} else {
			@UNIT = ( $r->{unit});
		}
		foreach my $u (@UNIT) {
			if ( defined ( $u->{'seq'} ) ) {
				print "\t";
				print "($u->{'spacer'} nt) " if defined $u->{'spacer'};
				print $u->{'seq'};
			} else {
				print "\t-"; 
			}
		}
		print "\n";
	}
}