Files
Ruteador-NonUI/Ruteador.bas
Jose Alberto Guerra Ugalde 22f3166c3a -VERSION 5.07.31
- Se corrigió un error cuando no se mandaba el parametro "f" (final)
2025-07-31 13:17:12 -06:00

235 lines
9.1 KiB
QBasic

B4J=true
Group=Default Group
ModulesStructureVersion=1
Type=Class
Version=10
@EndOfDesignText@
'Class module
Sub Class_Globals
Private mreq As ServletRequest 'ignore
Private mresp As ServletResponse 'ignore
' Dim cmd As DBCommand
Dim theQuery As String
Dim m, m2 As Map
Dim getHash As CalculateHash
Dim js As JSONGenerator
Dim cuantosPuntos As Int = 0
End Sub
Public Sub Initialize
End Sub
'Resumable Subs (wait for / sleep) in server handlers
'Resumable subs can only work when there is a message queue.
'By default, server handlers end when the Handle sub is completed. They do not create a message loop.
'If you want to wait for an event then you need to call StartMessageLoop and later StopMessageLoop.
'https://www.b4x.com/android/forum/threads/resumable-subs-wait-for-sleep-in-server-handlers.81833/
Sub Handle(req As ServletRequest, resp As ServletResponse)
Log("##############################################################")
Log("############# Ruteador/Handle ########################")
Log("##############################################################")
' Log("q='"&req.GetParameter("q")&"'")
' Log($"REQ: ${req.FullRequestURI}"$)
Private elHash As String = getHash.CalculateTheHash(req.FullRequestURI)
' Log(elHash)
Private ruta As String = req.GetParameter("r")
Private almacen As String = req.GetParameter("a")
Private coords As String = req.GetParameter("c")
Private matriz As String = req.GetParameter("m")
Main.algoritmo = 1
If req.GetParameter("algoritmo") = "0" Or req.GetParameter("algoritmo") = "NN" Then
Main.algoritmo = 0 ' Algoritmo = Nearest Neighbor.
End If
Main.inicio = req.GetParameter("i")
Main.final = req.GetParameter("f")
If matriz <> "" And matriz <> "OSRM" Then matriz = ""
' Log($"r: ${ruta}, a: ${almacen}, Coords: ${coords}"$)
Private urlParams As Map
If ruta <> "" And almacen <> "" And coords <> "" Then
If Main.final <> "" And Main.algoritmo <> 0 Then coords = coords & ";" & Main.final
ruta = "R" & ruta
urlParams.Initialize
urlParams.Put("almacen", almacen)
urlParams.Put("coords", coords)
urlParams.Put("hash", elHash)
urlParams.Put("ruta", ruta)
Main.db.InitializeSQLite(File.DirApp, "kmt.db", True)
Log($"${ruta}A${almacen}_${elHash}_punteo"$)
' Log(checkIfTableExists($"${ruta}A${almacen}_${elHash}_punteo"$))
' Si no existe la tabla del ruteo, la creamos.
If Not(checkIfTableExists($"${ruta}A${almacen}_${elHash}_punteo"$)) Then
' Log($"Creamos tablas ruta ${ruta}, almacen ${almacen}"$)
Main.creaTablas(urlParams)
generaMatrizRuteoTiempos($"${ruta}A${almacen}_${elHash}"$, resp, ruta, almacen, matriz)
StartMessageLoop
Else 'Si ya existe, solo calculamos los tiempos y distancias.
' Log("Ya existe la tabla")
tiempos($"${ruta}A${almacen}_${elHash}"$, resp, ruta, almacen, matriz)
StartMessageLoop
' Main.verRuta(ruta)
End If
Else
resp.ContentType = "text/html"
resp.Write("Hay un error en la solicitud, son necesarios los siguientes parametros:<br>* r - La ruta<br>* a - El almacen<br>* c - Lista de puntos (id_cliente,lon,lat) separadas por punto y coma, el primer punto de la lista, se considera el punto de INICIO de la ruta.<br>* m - La matriz a usar LOCAL u OSRM (Opcional, default local<br>* f - El destino final (id_cliente,lon,lat) de donde termina la ruta (Opcional)") 'this file will be loaded from the www folder
End If
End Sub
Sub generaMatrizRuteoTiempos(r As String, resp As ServletResponse, ruta As String, almacen As String, matriz As String) As ResumableSub
Log("############################################################################")
Log("############# Ruteador/generaMatrizRuteoTiempos ####################")
Log("############################################################################")
Try
'Generamos la matriz
Private p As ResultSet = Main.db.ExecQuery($"select count(id) as cuantosPuntos from ${r}_puntos"$)
Do While p.NextRow ' Revisamos que sean MENOS de 100 puntos, si no, usamos la matriz LOCAL.
cuantosPuntos = p.GetInt("cuantosPuntos")
Loop
If cuantosPuntos > 98 Then
If matriz = "OSRM" Then Main.msg = "Mas de 100 puntos, usamos matriz LOCAL"
matriz = ""
End If
Log($"#### PUNTOS: ${cuantosPuntos}"$)
If matriz = "OSRM" Then
Wait for(Main.generaMatrizOSRM(r)) Complete (Result As Int)
Else
Main.generaMatrizLocal(r)
End If
Catch
Log(LastException)
End Try
'Generamos el ruteo
Main.ruteo($"${r}"$, matriz)
If Main.algoritmo <> 0 And Main.final <> "" Then
Private t() As String = Regex.Split(",", Main.final)
Main.db.ExecNonQuery($"insert into ${r}_punteo (pos, id, nombre, lat, lon) values (${cuantosPuntos + 1}, '${t(0)}', 'almacen', '${t(2)}', '${t(1)}')"$)
End If
Wait for(Main.tiempos($"${r}"$)) Complete (Result As Int)
Private ts As Map = Main.ts.Get($"${r}"$)
' Log(ts)
Private tempMap As Map
tempMap.Initialize
If checkIfTableExists(r&"_punteo") Then
Private p As ResultSet = Main.db.ExecQuery($"select * from ${r}_punteo"$)
Private listCoords As List
listCoords.Initialize
'Ponemos el id de la tienda y las coordenadas en una lista para regresarla en un JSON.
Do While p.NextRow
listCoords.Add(CreateMap("pos":p.GetString("pos"), "id":p.GetString("id"), "lat":p.GetString("lat"), "lon":p.GetString("lon")))
Loop
Main.db.Close
tempMap.Put("api", matriz)
If matriz = "" Then tempMap.Put("api", "Local")
'Ponemos la ruta, almacen, tiempos, distancias y la lista de las coordenadas en un mapa para regresarla en un JSON.
tempMap.Put("code", "OK")
tempMap.Put("ruta", ruta)
tempMap.Put("almacen", almacen)
tempMap.Put("duration", ts.Get("duration"))
tempMap.Put("distance", ts.Get("distance"))
tempMap.Put("puntos", ts.Get("puntos"))
tempMap.Put("coords", listCoords)
tempMap.Put("mensaje", Main.msg)
If Main.error <> "" Then tempMap.Put("mensaje", Main.error)
If tempMap.get("puntos") = 0 Then tempMap.Put("code", "KO")
' Log(tempMap)
js.Initialize(tempMap)
StopMessageLoop
Main.error = ""
Main.msg = ""
'Regresamos en un JSON la info del ruteo.
resp.ContentType = "text/html"
resp.Write(js.ToString)
Else
tempMap.Put("api", "")
tempMap.Put("code", "KO")
tempMap.Put("error", Main.error)
tempMap.Put("ruta", ruta)
tempMap.Put("almacen", almacen)
tempMap.Put("duration", 0)
tempMap.Put("distance", 0)
tempMap.Put("puntos", 0)
tempMap.Put("coords", "")
tempMap.Put("mensaje", Main.msg)
If Main.error <> "" Then tempMap.Put("mensaje", Main.error)
' Log(tempMap)
js.Initialize(tempMap)
StopMessageLoop
Main.error = ""
Main.msg = ""
resp.ContentType = "text/html"
resp.Write(js.ToString)
End If
Return 1
End Sub
Sub tiempos(r As String, resp As ServletResponse, ruta As String, almacen As String, matriz As String) As ResumableSub
Log("############################################################")
Log("############# Ruteador/tiempos ####################")
Log("############################################################")
Wait for(Main.tiempos($"${r}"$)) Complete (Result As Int)
Private ts As Map = Main.ts.Get($"${r}"$)
' Log(ts)
Private tempMap As Map
tempMap.Initialize
Private p As ResultSet = Main.db.ExecQuery($"select * from ${r}_punteo"$)
Private listCoords As List
listCoords.Initialize
Private coords2 As String = ""
Do While p.NextRow
listCoords.Add(CreateMap("pos":p.GetString("pos"), "id":p.GetString("id"), "lat":p.GetString("lat"), "lon":p.GetString("lon")))
If coords2 = "" Then
coords2 = $"${p.GetString("lon")},${p.GetString("lat")}"$
Else
coords2 = $"${coords2}:${p.GetString("lon")},${p.GetString("lat")}"$
End If
Loop
Main.db.Close
tempMap.Put("api", matriz)
If matriz = "" Then tempMap.Put("api", "Local")
tempMap.Put("code", "OK")
tempMap.Put("ruta", ruta)
tempMap.Put("almacen", almacen)
tempMap.Put("duration", ts.Get("duration"))
tempMap.Put("distance", ts.Get("distance"))
tempMap.Put("puntos", ts.Get("puntos"))
tempMap.Put("coords", listCoords)
tempMap.Put("mensaje", Main.msg)
If Main.error <> "" Then tempMap.Put("mensaje", Main.error)
If tempMap.get("puntos") = 0 Then tempMap.Put("code", "KO")
' Log(tempMap)
js.Initialize(tempMap)
StopMessageLoop
Main.error = ""
Main.msg = ""
resp.ContentType = "text/html"
resp.Write(js.ToString)
Log("###################################################################" & CRLF)
Log($"http://keymon.lat:9001/kmz.php?a=1&c=${coords2}"$)
Log("###################################################################" & CRLF)
Log("Liga para ver la ruta en mapa:" & CRLF)
Log($"https://osm.quelltextlich.at/viewer-js.html?kml_url=http://keymon.lat:9001/kmz.php?c=${coords2}"$)
Return 1
End Sub
'Convierte una lista en un arreglo (array as object).
Public Sub ListToArray(inList As List) As Object()
Dim OutArray(inList.Size) As Object
For i = 0 To inList.Size - 1
OutArray(i) = inList.Get(i)
Next
Return OutArray
End Sub
Sub checkIfTableExists(table As String) As Boolean
' B4XPages.MainPage.db.InitializeSQLite(File.DirApp, "kmt.db", True)
Private r As ResultSet = Main.db.ExecQuery($"Select name FROM sqlite_master WHERE Type='table' AND name='${table}'"$)
If r.NextRow Then
' B4XPages.MainPage.db.close
' Log($"NAME: ${r.GetString("name")}"$)
Return True
Else
' B4XPages.MainPage.db.close
Return False
End If
End Sub