2022-05-27 17:11:35 +02:00
package Mod::GBFSout ;
#
# SPDX-License-Identifier: AGPL-3.0-or-later
# Copyright (c) Rainer Gümpelein, TeilRad GmbH
#
#without login only public Stations have to be viewable:
#https://shareeapp-primary.copri-bike.de/GBFSout
#
#with login and valid autcookie:
#https://shareeapp-primary.copri-bike.de/GBFSout?sessionid=a49aba2b5440be72816db2_rafo87znqx
#
#
use warnings ;
use strict ;
use POSIX ;
use Exporter ;
our @ ISA = qw ( Exporter ) ;
use CGI::Cookie ( ) ;
use CGI ':standard' ;
use Apache2::Const - compile = > qw( OK ) ;
use Scalar::Util qw( looks_like_number ) ;
use JSON ;
use LWP::UserAgent ;
2022-10-31 08:11:53 +01:00
use Time::Piece ;
2022-05-27 17:11:35 +02:00
use Lib::Config ;
use Mod::DBtank ;
use Mod::APIfunc ;
use Mod::Basework ;
use Data::Dumper ;
my $ bw = new Basework ;
sub handler {
my $ r = shift ;
my $ q = new CGI ;
$ q - > import_names ( 'R' ) ;
my $ dbt = new DBtank ;
my $ apif = new APIfunc ;
my $ cf = new Config ;
my % varenv = $ cf - > envonline ( ) ;
my $ coo = $ q - > cookie ( 'domcookie' ) || $ R:: sessionid || "" ;
my $ users_sharee = { c_id = > 0 } ;
my $ api_return = { authcookie = > '' } ;
( $ api_return , $ users_sharee ) = $ apif - > auth_verify ( $ q , $ coo , "" ) ;
if ( $ dbt - > { website } - > { $ varenv { syshost } } - > { merchant_id } ) {
$ api_return - > { authcookie } = $ dbt - > { website } - > { $ varenv { syshost } } - > { merchant_id } if ( ! $ api_return - > { authcookie } ) ;
} elsif ( $ dbt - > { operator } - > { $ varenv { dbname } } - > { merchant_id } ) {
$ api_return - > { authcookie } = $ dbt - > { operator } - > { $ varenv { dbname } } - > { merchant_id } if ( ! $ api_return - > { authcookie } ) ;
} elsif ( $ dbt - > { primary } - > { $ varenv { dbname } } - > { merchant_id } ) {
$ api_return - > { authcookie } = $ dbt - > { primary } - > { $ varenv { dbname } } - > { merchant_id } if ( ! $ api_return - > { authcookie } ) ;
}
$ users_sharee - > { c_id } = "0" if ( ! $ users_sharee - > { c_id } ) ;
$ bw - > log ( "GBFSout handler with api_return: " , $ api_return , "" ) ;
print $ q - > header ( - type = > "application/json" , - charset = > "utf-8" , - 'Access-Control-Allow-Origin' = > "*" ) ;
#main
my $ project = "all" ;
$ project = $ dbt - > { website } - > { $ varenv { syshost } } - > { project } if ( $ dbt - > { website } - > { $ varenv { syshost } } - > { project } ) ;
$ project = $ dbt - > { operator } - > { $ varenv { dbname } } - > { project } if ( $ dbt - > { operator } - > { $ varenv { dbname } } - > { project } ) ;
#request primary will jsonclient loop_sharees
my $ uri_request = $ dbt - > { primary } - > { sharee_primary } - > { primaryApp } ;
#detect DMS, because this will do it directly without loop_sharees
2022-11-16 21:22:00 +01:00
$ uri_request = $ dbt - > { operator } - > { $ varenv { dbname } } - > { operatorApp } if ( $ varenv { dbname } ne $ dbt - > { primary } - > { sharee_primary } - > { database } - > { dbname } && $ varenv { syshost } =~ /shareedms-/ ) ;
2022-05-27 17:11:35 +02:00
if ( $ R:: request eq "stations_available" ) {
station_information ( $ api_return , \ % varenv , $ users_sharee , $ uri_request , $ project ) ;
}
if ( $ R:: request eq "bikes_available" ) {
vehicle_status ( $ api_return , \ % varenv , $ users_sharee , $ uri_request , $ project ) ;
}
return Apache2::Const:: OK ;
}
sub station_information {
my $ authcookie = shift || { authcookie = > '' } ;
my $ varenv = shift ;
my $ users_sharee = shift || { c_id = > 0 } ;
my $ uri_request = shift || "" ;
my $ project = shift || "all" ;
my $ json = JSON - > new - > allow_nonref ;
my $ rest_stations = "request=stations_available&project=$project&authcookie=$authcookie->{authcookie}" ;
my $ gbfs_resp = { } ;
2022-12-10 15:47:22 +01:00
my @ gbfs_stations = ( ) ;
2022-05-27 17:11:35 +02:00
my $ stations_json = fetch_primary_json ( "" , $ uri_request , $ rest_stations ) ;
#decode json to hash
2022-12-10 15:47:22 +01:00
eval {
my $ response_stations = { } ;
$ response_stations = decode_json ( $ stations_json ) ;
2022-05-27 17:11:35 +02:00
2022-12-10 15:47:22 +01:00
foreach my $ station ( keys ( % { $ response_stations - > { shareejson } - > { stations } } ) ) {
2022-05-27 17:11:35 +02:00
#print Dumper($response_stations->{shareejson}->{stations}->{$station});
my % gbfs_station = ( ) ;
$ gbfs_station { $ station } { station_id } = $ response_stations - > { shareejson } - > { stations } - > { $ station } - > { station } ;
$ gbfs_station { $ station } { name } = Encode:: encode ( 'utf-8' , Encode:: decode ( 'iso-8859-1' , $ response_stations - > { shareejson } - > { stations } - > { $ station } - > { description } ) ) ;
$ gbfs_station { $ station } { capacity } = $ response_stations - > { shareejson } - > { stations } - > { $ station } - > { capacity } ;
2023-03-17 13:23:04 +01:00
$ gbfs_station { $ station } { bike_count } = $ response_stations - > { shareejson } - > { stations } - > { $ station } - > { bike_count } ;
2022-05-27 17:11:35 +02:00
$ gbfs_station { $ station } { lat } = $ response_stations - > { shareejson } - > { stations } - > { $ station } - > { gps } - > { latitude } ;
$ gbfs_station { $ station } { lon } = $ response_stations - > { shareejson } - > { stations } - > { $ station } - > { gps } - > { longitude } ;
2022-07-20 06:54:17 +02:00
#$gbfs_station{$station}{is_charging_station} = 1 if(grep(/300102/, @{$response_stations->{shareejson}->{stations}->{$station}->{station_group}}));#E-L
2022-05-27 17:11:35 +02:00
push ( @ gbfs_stations , $ gbfs_station { $ station } ) ;
2022-12-10 15:47:22 +01:00
}
} ;
2022-10-31 08:11:53 +01:00
my $ last_updated = time ( ) ;
2022-12-10 15:47:22 +01:00
$ gbfs_resp = {
2022-10-31 08:11:53 +01:00
"last_updated" = > $ last_updated ,
2022-05-27 17:11:35 +02:00
"ttl" = > 10 ,
"version" = > "2.2" ,
"data" = > {
"stations" = > [ @ gbfs_stations ]
}
} ;
2022-12-10 15:47:22 +01:00
if ( $@ ) {
$ bw - > log ( "Failure, GBFSout station_information not valid" , "" , "" ) ;
warn $@ ;
}
2022-05-27 17:11:35 +02:00
my $ jrout = $ json - > pretty - > encode ( $ gbfs_resp ) ;
print $ jrout ;
return ;
} #end station_information
sub vehicle_status {
my $ authcookie = shift || { authcookie = > '' } ;
my $ varenv = shift ;
my $ users_sharee = shift || { c_id = > 0 } ;
my $ uri_request = shift || "" ;
my $ project = shift || "all" ;
my $ json = JSON - > new - > allow_nonref ;
my $ rest_bikes = "request=bikes_available&project=$project&authcookie=$authcookie->{authcookie}" ;
my $ gbfs_resp = { } ;
2022-12-10 15:47:22 +01:00
my @ gbfs_bikes = ( ) ;
2022-05-27 17:11:35 +02:00
my $ bikes_json = fetch_primary_json ( "" , $ uri_request , $ rest_bikes ) ;
#decode json to hash
2022-12-10 15:47:22 +01:00
eval {
my $ response_bikes = { } ;
$ response_bikes = decode_json ( $ bikes_json ) ;
2022-05-27 17:11:35 +02:00
2022-12-10 15:47:22 +01:00
foreach my $ bike ( keys ( % { $ response_bikes - > { shareejson } - > { bikes } } ) ) {
2022-05-27 17:11:35 +02:00
#if($response_bikes->{shareejson}->{bikes}->{$bike}->{station} eq "FR105"){
my % gbfs_bike = ( ) ;
$ gbfs_bike { $ bike } { station_id } = $ response_bikes - > { shareejson } - > { bikes } - > { $ bike } - > { station } ;
$ gbfs_bike { $ bike } { vehicle_id } = $ response_bikes - > { shareejson } - > { bikes } - > { $ bike } - > { bike } ;
$ gbfs_bike { $ bike } { vehicle_name } = Encode:: encode ( 'utf-8' , Encode:: decode ( 'iso-8859-1' , $ response_bikes - > { shareejson } - > { bikes } - > { $ bike } - > { description } ) ) ; #not part of gbfs
$ gbfs_bike { $ bike } { vehicle_type_id } = $ response_bikes - > { shareejson } - > { bikes } - > { $ bike } - > { bike_group } [ 0 ] ;
#$gbfs_bike{$bike}{is_reserved} = 0;
#$gbfs_bike{$bike}{is_disabled} = 0;
push ( @ gbfs_bikes , $ gbfs_bike { $ bike } ) ;
#}
2022-12-10 15:47:22 +01:00
}
2022-05-27 17:11:35 +02:00
#{
#"vehicle_id":"987fd100-b822-4347-86a4-b3eef8ca8b53",
#"last_reported":1609866204,
#"is_reserved":false,
#"is_disabled":false,
#"vehicle_type_id":"def456",
#"current_range_meters":6543.0,
#"station_id":"86",
#"pricing_plan_id":"plan3"
#}
2022-12-10 15:47:22 +01:00
} ;
2022-10-31 08:11:53 +01:00
my $ last_updated = time ( ) ;
2022-05-27 17:11:35 +02:00
$ gbfs_resp = {
2022-10-31 08:11:53 +01:00
"last_updated" = > $ last_updated ,
2022-05-27 17:11:35 +02:00
"ttl" = > 0 ,
"version" = > "3.0" ,
"data" = > {
"vehicles" = > [ @ gbfs_bikes ]
}
} ;
2022-12-10 15:47:22 +01:00
if ( $@ ) {
$ bw - > log ( "Failure, GBFSout vehicle_status not valid" , "" , "" ) ;
warn $@ ;
}
2022-05-27 17:11:35 +02:00
my $ jrout = $ json - > pretty - > encode ( $ gbfs_resp ) ;
print $ jrout ;
return ;
} #end vehicle_status
#requestor
sub fetch_primary_json {
my $ self = shift ;
my $ primary_server = shift || "" ;
my $ rest = shift || "" ;
my $ primary_request = "$primary_server/APIjsonserver?$rest" ;
$ bw - > log ( "GBFS primary_request: " , $ primary_request , "" ) ;
my $ ua = LWP::UserAgent - > new ;
$ ua - > agent ( "sharee GBFSout" ) ;
my $ req = HTTP::Request - > new ( GET = > "$primary_request" ) ;
$ req - > content_type ( 'application/x-www-form-urlencoded' ) ;
$ req - > content ( $ rest ) ;
#Pass request to the user agent and get a response back
my $ res = $ ua - > request ( $ req ) ;
2022-12-10 15:47:22 +01:00
#SSL certificate must be valid
#print Dumper($res);
2022-05-27 17:11:35 +02:00
# Check the outcome of the response
if ( $ res - > is_success ) {
#print $res->content;
return $ res - > content ;
#print $res->status_line, "\n";
} else {
return "" ;
#print $res->status_line, "\n";
}
}
1 ;