How to include a TCL script in a PHP page ?

Short answer : echo tclsh script.tcl

Here’s my Pluton code.

Include a $body tcl script
  1. //Les scripts TCL s’exécutent dans _includesTCL et se voient passés en argument l’user_id et la session_id
  2. chdir(“_includes/TCL”);
  3. echo tclsh ../../$body $Utilisateur['user_id'] $_SESSION['ID'];
  4. //Revenons maintenant à notre dossier / pour ajouter correctement notre footer
  5. chdir(“../../”);

Pluton is the PHP engine developed on Espace Win and also used on Double V Network website. I’ve learned PHP coding it in 2001.

 

You’ll certainly need some libraries ; I’ve a TCL script initializing MySQL connection and another with user profiles functions. Let’s put all in a directory, chdir to it, and no need to worry about paths.
Of couse, after the script, we come back to our initial directory to avoid broke the end of our php app.

 

tclsh is a shell-like TCL interpreter, and is the backtick operator, executing the command inside and returning result. Of couse, tclsh must be in tour path. And you should consider use tclsh84 or tclsh85 instead. If I’ve written tclsh to get TCL 8.4 on Guenwhyvar, the FreeBSD Espace Win prod server and TCL 8.5 on Leviathan, my laptop.

 

We pass two arguments at our TCL script, the user id and session id of the logged user. I presume user_id is satisfactory but we’ll see in the future.

Oh, btw, our user_id is [lindex $argv 0] and session id [lindex $argv 1], tclsh putting our args in argv variable, lindex $list $n returning element $n of our list $list.

 

Inside TCL

Now, let’s see what I’ve coded in TCL :
[ www.espace-win.org/IRC/Projets | source code ]

This is a webpage viewing #Win projects. I had already the TCL output in SurfBoard so why recode it again in PHP ?

In core.tcl we’ve Pluton user profile functions and two interesting :

Core.tcl snippets (freely use them, BSD license)
  1. proc runningOnWindows {} {
  2.         regexp “.exe$” [info nameofexecutable]
  3. }
  4. proc isnumber {string} {
  5.         if {([string compare $string “”]) && (![regexp [^0-9] $string])} {return 1} {return 0}
  6. }

MySQL.tcl opens a MySQL connection :

MySQL.tcl
  1. if [runningOnWindows] {
  2.         load fbsql.dll
  3. } else {
  4.         load fbsql.so
  5. }
  6. sql connect localhost login pass
  7. sql selectdb EspaceWin

Then Projets.tcl contains functions I’ve copied from my previous Su

Projets.tcl
  1. proc projet.who {id {niveau “-1”}} {
  2.         #Liste les membres d’un projet ayant le niveau donné
  3.         #Si pas de niveau spécifié, liste 2 et 9 (manager et participants projets)
  4.         if {$niveau == -1} {
  5.                 return [sql “SELECT u.username FROM Utilisateurs u, Projets_membres pm WHERE pm.project_id LIKE ‘$id’ AND (pm.niveau = ‘2’ OR pm.niveau = ‘9’) AND u.user_id = pm.user_id ORDER BY u.username ASC”]
  6.         } else {
  7.                 return [sql “SELECT u.username FROM Utilisateurs u, Projets_membres pm WHERE pm.project_id LIKE ‘$id’ AND pm.niveau = ‘$niveau’ AND u.user_id = pm.user_id ORDER BY u.username ASC”]
  8.         }
  9. }

Finally, here the extra functions in core.tcl to get a fully functionnal code 😉

Core.tcl – the users profiles functions
  1. ################################################################################
  2. # Fonctions utilisateurs, et de gestion du profil                              #
  3. ################################################################################
  4. #Récupère l’username de $who
  5. #$who : user_id ou username
  6. proc getnom {who} {
  7.         getuserinfo [lectureID $who] username
  8. }
  9. #Récupère le champs $data du profil de $who
  10. #$who : user_id ou username
  11. #$data : nom du champs de la table Utilisateurs à récupérer
  12. proc getuserinfo {who data} {
  13.         sql “SELECT $data FROM Utilisateurs WHERE user_id = ‘[lectureID $who]'”
  14. }
  15. #Met à jour le champs $data du profil de $who sur $valeur
  16. #$who : user_id ou username
  17. #$data : nom du champs de la table Utilisateurs à mettre à jour
  18. #$valeur : nouvelle valeur de ce champs
  19. proc setuserinfo {who data valeur} {
  20.         sql “UPDATE Utilisateurs SET $data = ‘[sqlfilt $valeur]’ WHERE user_id = [lectureID $who]”
  21. }
  22. #Récupère l’user_id de $who
  23. #$who : user_id ou username
  24. proc lectureID {who} {
  25.         if ![isnumber $who] {
  26.                 sql “SELECT user_id FROM Utilisateurs WHERE username LIKE ‘$who'”
  27.         } else {
  28.                 return $who
  29.         }
  30. }

I hope you’ve catched return is not necessary in TCL, by default a function return the result returned by it last instruction (so getnom proc returns getuserinfo result). Eminently readable source code 🙂

Code highlighting is provided by GeSHi, very nice no ?
This is fully integrated in Pastebin (and our pastebin has an up to date GeSHi version with more languages than the original).

Leave a Reply

Your email address will not be published. Required fields are marked *

This site uses Akismet to reduce spam. Learn how your comment data is processed.