#rR gscope_webservice.tcl

proc IdCard {Document {Quoi ""}} {
    #rR Attention je triche pour les retour a la ligne qui compte pour 2 carac en php mais pas en tcl
    #rR Attention je triche en php en faisant utf8_decode pour tout les chmaps

    global IdCard

    if {$Quoi==""} { set Quoi "ListOfFields" }

    if {[info exists IdCard($Document,$Quoi)]} { return $IdCard($Document,$Quoi) }
    if {[info exists IdCard($Document,"EstCharge")]} { return "" }
    set IdCard($Document,"EstCharge") 1

    set Url "[LbgiUrl]/puzz/phpRR/lance.php?action=IdCard::card&document=$Document&getwhat=GetCard"
    set Serial [ContenuDuFichier $Url]
    regsub -all "\n" $Serial "@!" Serial
    ArrayFromSerial $Serial TabCard

    set LesT {}
    set LesC {}
    foreach i [lsort -integer [array names TabCard]] {
	lassign $TabCard($i) t T c C
	set T [lindex $T 1]
	set C [lindex $C 1]
	regsub -all "@!" $C "\n" C 
	lappend IdCard($Document,ListOfFields) $T
	set IdCard($Document,$T) $C
    }
    return [IdCard $Document $Quoi]
}

proc Cps {{Pattern ""} {Genome ""} {Mismatch ""} {GetWhat ""}} {

    regsub -all -nocase {[^A-Z]} $Pattern "" Pattern

    if {$Genome==""} { set Genome "human_2006_nomask" }
    if {$Mismatch==""} { set Mismatch 0 }
    set Pattern [string trim $Pattern]
    if {[string length $Pattern] < 5} { return "Error: Pattern contain at least $MinLength bases" } 
    set    UrlCps "http://kilida.u-strasbg.fr:8086/CST_Java_Servlet/InterfaceWebCST?action=search&access_program=1"
    append UrlCps "&genome=$Genome"
    append UrlCps "&pattern=$Pattern"

    Espionne $UrlCps
    set LesHits {}
    set LeNice {}
    foreach Ligne [LesLignesDuFichier $UrlCps] {
Espionne $Ligne
	set C ""; set S ""; set D ""; set F ""; set H ""
	if { ! [regexp -nocase {^chr[^1-9XY]*([0-9XY]+) +\(?([FBR\+\-])\)? +([0-9]+)[ \-]+ ([0-9]+) +[^A-Z]*([A-Z]+)} $Ligne Match C S D F H]} { continue }
	regsub -nocase {[F]}  $S "+" S
	regsub -nocase {[RB]} $S "-" S
	set C "chr$C"
	lappend LesHits "$C:$D-${F}($S) $H"
	lappend LeNice [format "%-5s %9d %9d (%s) %s" $C $D $F $S $H]
    }
    if {$GetWhat=="Show"}    { return [AfficheListe $LeNice "" "Hits on $Genome"] }
    if {$GetWhat=="GetNice"} { return [join $LeNice "\n"] }
    if {$GetWhat=="GetText"} { return [join $LesHits "\n"] }
    return $LesHits
}

proc Login {} {
    global env
    set Login $env(LOGNAME)
    return $Login
}

proc AddLinxTest {} {
    return [AddLinx "poch" "" "http://raymondripp.fr" "Le site de RR" "public"]
}
 
proc AddLinx {{Login ""} {LinkName ""} {Link ""} {Description ""} {Belongs ""}} {
    if {$LinkName==""} { set LinkName [Entre "FromGscope"] }
    if {$Login==""} { set Login [Login] }
    if {$Link==""}        { set Link64 "" } else { set Link64 [Base64Encode $Link] }
    if {$Description==""} { set Desc64 "" } else { set Desc64 [Base64Encode $Description] }
    if {$Belongs==""}     { set Belo64 "" } else { set Belo64 [Base64Encode $Belongs] }
    set Url "[LbgiUrl]/MyLinx.php?do=addlinx&lo=$Login&ln=$LinkName&li=$Link64&de=$Desc64&be=$Belo64"
    set Status [ContenuDuFichier $Url]
#rR faut il le faire ici   ????????????????????????
    MyLinx ResetMyLinx
    return $Status
}

proc MyLinx {{Qui ""} {Quoi ""}} {
    global MyLinx
    if {$Qui=="ResetMyLinx"} { unset -nocomplain MyLinx ; return "" }
    set Login [Login]
    if {[info exists MyLinx($Qui,$Quoi)]}  { return $MyLinx($Qui,$Quoi) }
    if {[info exists MyLinx("EstCharge")]} { return "" }
    set MyLinx("EstCharge") 1
    set Url "[LbgiUrl]/MyLinx.php?login=$Login&getwhat=GetSerial"
    set Serial [ContenuDuFichier $Url]
    set MLX [SeriallistFromSerial $Serial]
    foreach {sLn sLnLiDeBe} [lindex $MLX 1] {
	set Ln [lindex $sLn 1]
	lappend MyLinx(ListOf,LinkName) $Ln
	foreach {sK sV} [lindex $sLnLiDeBe 1] {
	    set K [lindex $sK 1]
	    set V [lindex $sV 1]
	    set MyLinx($Ln,$K) $V
	}
    }
    return [MyLinx $Qui $Quoi]
}

proc TestQsub {{GetWhat ""}} {
    set S "-b y pwd"
    set S "tcsh -c 'pwd; hostname; pwd; ls'"
    return [Qsub $S $GetWhat "" "" "" ""]
}

proc Qsub {CommandeOuFichier {GetWhat ""} {O ""} {E ""} {Q ""} {Options ""}} {

    if {[regexp {^(sh|csh|bash|tcsh|tclsh|java) } $CommandeOuFichier]} {
	set CommandeOuFichier "-b y $CommandeOuFichier"
    }
    if {[regexp -- {^\-b y } $CommandeOuFichier]} {
	append Options " -b y"
	regsub -- {^\-b y } $CommandeOuFichier "" CommandeOuFichier
    }
    set Binary [regexp -- {-b y} $Options]

    set Notice [expr ! [regexp -nocase "NoNotice" $GetWhat]]
    regsub -nocase "NoNotice" $GetWhat "" GetWhat
    if {$GetWhat==""} { set GetWhat "GetAll" }

    if {$Q==""} { set Q "qsub" }
    if { ! $Binary && [regexp {[ ;]} $CommandeOuFichier]} {
	set ScriptFile "[TmpFile Qsub].tcsh"
	Sauve $CommandeOuFichier dans $ScriptFile
	file attribute $ScriptFile -permissions 0775
	if {$O==""} { regsub ".tcsh$" $ScriptFile ".log" O }
    } else {
	set ScriptFile $CommandeOuFichier
    }
    if {$O==""} { set O "[TmpFile Qsub].log" }
    if {$E==""} { set E $O }
    if {$E=="Oerror"} { regsub ".log$" $O "_error.log" E }
    
    set QsubCommand "\"source /usr/N1GE6/default/common/settings.csh ; $Q -l arch=lx24-amd64 -o $O -e $E -cwd -V $Options $ScriptFile\""
    if { ! [regexp -nocase "NoEval" $GetWhat]} {
	if {$Notice} { AppendAuFichier $O "[Date _] I run $Q\n$QsubCommand\n**********\n" }
	set Retour [eval exec tcsh -c $QsubCommand]
    }
    if {[regexp -nocase "GetCommand" $GetWhat] } { return $QsubCommand }
    if {[regexp -nocase "GetO"       $GetWhat] } { return $O }
    if {[regexp -nocase "GetE"       $GetWhat] } { return $E }
    if {[regexp -nocase "GetAll"     $GetWhat] } { return [list $O $E $QsubCommand $Retour] }
    return $Retour
}

proc WebServiceOOOOOOOOOOLD {Qui Commande args} {
    #rR args est une liste key value key value key value

    set Url [WebServiceUrl $Qui]
    
    set QueryEncode [eval ::http::formatQuery "webcommand" $Commande $args]

    Espionne $QueryEncode

    set Token [eval ::http::geturl $Url -query $QueryEncode]
    set Retour [::http::data $Token]
    set Retour [string trim $Retour]

    set iGetWhat [lsearch $args "getwhatfromserial"]
    if {$iGetWhat>=0} {
	set GetWhat [lindex $args [incr iGetWhat]]
	if {$GetWhat=="GetList"}       { return [ListFromSerial $Retour] }
	if {$GetWhat=="GetFirstValue"} { return [FirstElementFromSerial $Retour] }
    } 

    return $Retour
}

proc TestWebServiceOLD {} { ;#rR ????????
    package require http

    return [WebService "http://www.uniprot.org/mapping/?" toto [list from ACC to P_REFSEQ_AC format tab query P13368]]    
}

proc TestWebService {} {
    set R [WebService "Gx" Execute \
	       querytext "GxFun::SignalIntensity&&0&1&301&&T&&&GeneAsText&limit 10"]
    return $R

    set R [WebService "Gx" GxDbSqlExec querytext "select name,pk_tissue from tissue" getwhatfromserial "GetList"]
    return $R

    set R [WebService "Gx" GxDbSqlExec \
	    querytext "select probeset_id,pk_probeset from probeset where probeset_id in ('1415670_at','1415672_at');" \
	    getwhatfromserial "GetList"]
    return $R

}

proc WebService {Qui Commande args} {
    #rR args est une liste key value key value key value
    #rR pour Execute il faut utiliser querytext 
    #rR voir les exemples dans TestWebService

    package require http

    set Url [WebServiceUrl $Qui]
    
    if {$Commande==""} {
	set QueryEncode [::http::formatQuery                        {*}$args]
    } else {
	set QueryEncode [::http::formatQuery "webcommand" $Commande {*}$args]
    }
#    set QueryEncode [::http::formatQuery from ACC to P_REFSEQ_AC format tab query P13368]

#    Espionne $QueryEncode

    set Token  [::http::geturl $Url -query $QueryEncode]
    set Retour [::http::data $Token]
    set Retour [string trim $Retour]

    set iGetWhat [lsearch $args "getwhatfromserial"]
    if {$iGetWhat>=0} {
	set GetWhat [lindex $args [incr iGetWhat]]
	if {$GetWhat=="GetList"}       { return [ListFromSerial $Retour] }
	if {$GetWhat=="GetFirstValue"} { return [FirstElementFromSerial $Retour] }
    } 

    return $Retour
}

proc FirstElementFromSerial Texte {
    set LesKV [ListFromSerial $Texte]
    set V [lindex $LesKV 0]
    return $V
}

proc ValueFromSerial Texte {
    return [ValueFromSeriallist [SeriallistFromSerial $Texte]]
}

proc ArrayFromSerial {Texte aT} {
    upvar $aT T
    return [ArrayFromSeriallist [SeriallistFromSerial $Texte] T]
}

proc ListFromSerial {Texte} {
    return [ListFromSeriallist [SeriallistFromSerial $Texte]]
}

proc ValueFromSeriallist Liste {
    return [lindex $Liste 1]
}

proc ArrayFromSeriallist {Liste aT} {
    upvar $aT T
    foreach {K V} [lindex $Liste 1] {
	set T([ValueFromSeriallist $K]) [ValueFromSeriallist $V]
    }
    return $aT
}

proc ListFromSeriallist {Liste} {
    set L {}
    foreach {K V} [lindex $Liste 1] {
	lappend L [ValueFromSeriallist $V]
    }
    return $L
}

proc TestSeriallistFromSerial {{F ""}} {
    if {$F!=""} { 
	set Texte [ContenuDuFichier $F]
    } else {
	set Texte "a:4:{i:0;s:10:\"1415670_at\";i:1;s:6:\"270637\";i:2;s:10:\"1415672_at\";i:3;s:6:\"270639\";}"
    }
#    ArrayFromSerial $Texte A
#parray A
#    exit
    set R [SeriallistFromSerial $Texte]
    return $R

    set A(coucou) 1
    ArrayFromSerial $Texte A
parray A
    exit
}

proc SeriallistFromSerial {Texte} {
    set fin [string length $Texte]
    set deb 0
    return [RecurSeriallistFromSerial Texte deb $fin]
}

proc RecurSeriallistFromSerial {aTexte aiT fin} {
    upvar $aTexte Texte
    upvar $aiT iT
    while {[set Prem [string index $Texte $iT]] eq ";" || $Prem eq ":" || $Prem eq "\}"} { incr iT }
    if {$iT>=$fin} { return {} }
    if {0 && $iT%1000==0} { Espionne $iT }    
    set X [string index $Texte $iT]

    if {$X=="N"} {
	incr iT 2
	return ""
    } 
    if {$X=="i" || $X=="d"} {
	set V ""
	incr iT 2
	while 1 {
	    set Z [string index $Texte $iT]
	    incr iT
	    if {$iT > $fin} { return "ERROR scanning_{$X}_in_$Texte" }
	    if {$Z eq ";"} { break }
	    append V $Z
	}
	set Liste [list "i" $V]
	return $Liste
    }
    if {$X=="s"} {
	set N ""
	incr iT 2
	while 1 {
	    set Z [string index $Texte $iT]
	    incr iT
	    if {$iT > $fin} { return "ERROR scanning_{$X}_in_$Texte" }
	    if {$Z eq ":"} { break }
	    append N $Z
	}
	incr iT 1                 ;# on passe le "
	set d [expr $iT]
	set f [expr $iT+$N-1]
	set S [string range $Texte $d $f]
	set Liste [list "s" $S]
	incr iT $N
	incr iT
	return $Liste
    }
    if {$X=="a"} {
	set N ""
	incr iT 2
	while 1 {
	    set Z [string index $Texte $iT]
	    incr iT
	    if {$iT > $fin} { return "ERROR scanning_{$X}_in_$Texte" }
	    if {$Z eq ":"} { break }
	    append N $Z
	}
	incr iT
	set LKV {}
	for {set i 0} {$i<$N} {incr i} {
	    lappend LKV [RecurSeriallistFromSerial Texte iT $fin] [RecurSeriallistFromSerial Texte iT $fin]
	}
	set Liste [list "a" $LKV]
	return $Liste
    }
    return "ERROR scanning_unknown_{$X}_in_$Texte"
}

proc WithWebService {{Qui ""} {Valeur ""}} {
    global WithWebService

    if {[string equal -nocase $Valeur "TestIfExists"]} { return [info exists WithWebService($Qui)] }

    if {$Qui==""} { set Qui "Gx" }

    if {$Valeur!=""} { set WithWebService($Qui) $Valeur}
    if {[info exists WithWebService($Qui)]} { return $WithWebService($Qui) }
    set WithWebService($Qui) 1
    return [WithWebService $Qui]
}

proc ArraytypeWithPipeWork {{Qui ""} {Valeur ""}} {
    global ArraytypeWithPipeWork

    if {$Qui==""} { set Qui "Gx" }

    if {$Valeur!=""} { set ArraytypeWithPipeWork($Qui) $Valeur}
    if {[info exists ArraytypeWithPipeWork($Qui)]} { return $ArraytypeWithPipeWork($Qui) }
    set ArraytypeWithPipeWork($Qui) 1
    return [ArraytypeWithPipeWork $Qui]
}

proc WebServiceUrl {{Qui ""}} {
    if {$Qui=="GxDb"   } { return "http://gx.lbgi.fr/gx/phpRR/lance.php?action=Munitions::WebService" }
    if {$Qui=="Gx"     } { return "http://gx.lbgi.fr/gx/phpRR/lance.php?action=Munitions::WebService" }
    if {$Qui=="Genoret"} { return "http://genoret.lbgi.fr/genoret/phpRR/lance.php?action=Munitions::WebService" }
    return $Qui
}

proc CreateArrayFromList {aT Index Liste} {
    upvar $aT T

    foreach a $Liste {
	set T($Index) $a
	incr Index
    }
    return $aT
}

proc CreateArray {aT Index args} {
    upvar $aT T

    return [CreateArrayFromList T $Index $args]
}

proc PhpSerialize {aT {TypeK ""} {TypeV ""}} {
    upvar $aT T
    return [SerialFromArray T $TypeK $TypeV]
} 

proc SerialFromArray {aT {TypeK ""} {TypeV ""}} {
    upvar $aT T

    if {$TypeK==""} { set TypeK "s" }
    if {$TypeV==""} { set TypeV "s" }

    set LesKey [lsort -integer [array names T]]
    set N [llength $LesKey]
    set LesElements {}
    foreach K $LesKey {
	set V $T($K)
	if {$TypeK=="i"} {
	    set EK "i:$K"
	} else {
	    set LK [string length $K]
	    set EK "s:$LK:\"$K\""
	}
	if {$TypeV=="i" || $TypeV=="d"} {
	    set EV "$TypeV:$V"
	} else {
	    set LV [string length $V]
	    set EV "s:$LV:\"$V\""
	}
	lappend LesElements "$EK;$EV"
    }
    set Elements [join $LesElements ";"]
    set S "a:$N:{$Elements;}"
    return $S
    
} 

proc SerialFromList {Liste} {
    CreateArrayFromList T 0 $Liste
    return [SerialFromArray T "i" "s"]
} 

proc SerialFromLinesOfFile {File} {
    set Liste [LesLignesDuFichier $File]
    CreateArrayFromList T 0 $Liste
    return [SerialFromArray T "i" "s"]
}