roko.li/sharee.bike
5
0
Fork 0
mirror of https://gitlab.com/t6353/sharee.bike.git synced 2025-05-14 15:46:28 +02:00
Code Issues Projects Releases Packages Wiki Activity

Initial commit

Browse source
This commit is contained in:
Rainer Gümpelein 2021-12-30 12:05:56 +01:00
parent b686656e88
commit 5e91fe947d
177 changed files with 41037 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

2343
copri4/main/src/Mod/APIfunc.pm Normal file
View file

File diff suppressed because it is too large Load diff

141
copri4/main/src/Mod/APIjsonclient.pm Normal file
View file

@ -0,0 +1,141 @@
package APIjsonclient;
#
# SPDX-License-Identifier: AGPL-3.0-or-later
# Copyright (c) Rainer Gümpelein, TeilRad GmbH
#
#Client for shareejson api
#
use strict;
use warnings;
use POSIX;
use CGI; # only for debugging
use JSON;
use LWP::UserAgent;
use URI::Encode;
use Config::General;
use Mod::Basework;
use Data::Dumper;
sub new {
my $class = shift;
my $self = {};
bless($self,$class);
return $self;
}
my $q = new CGI;
my $netloc = $q->url(-base=>1);
my $ua = LWP::UserAgent->new;
my $uri_encode = URI::Encode->new( { encode_reserved => 1 } );
$ua->agent("APIclient $netloc");
my $bw = new Basework;
my $json = JSON->new->allow_nonref;
sub loop_sharees {
my $self = shift;
my $q = shift || "";
my $auth = shift;
my $owner = shift || "";
my @keywords = $q->param;
my $project = "all";
#only request keys which initated by sharee primary requests to operator
my $rest = "";
foreach (@keywords){
if($_ =~ /request|authcookie|system|bike|station/g){
my $val = $q->param($_);
my $encoded_val = $uri_encode->encode($val);
$rest .= "$_=$encoded_val&";
}elsif($_ eq "project"){
my $val = $q->param($_);
$project = $val if($val eq "Bayern");#restricted map view only on lastenrad bayern iframe
}
}
$rest =~ s/\&$//;
my $response_in = {};
my $globalconf_file = "/var/www/copri4/shareeconf/global.cfg";
my $conf = Config::General->new($globalconf_file);
my %globalconf = $conf->getall;
my @uri_operator_array = ();
my @user_group = ();
my @user_tour = ();
my $fetch_hash = {};
while (my ($key, $value) = each %{ $globalconf{operator} }) {
my $ret_json = "";
#print $key;# like sharee_fr01
if($value->{operatorApp} && ($project eq $value->{project} || $project eq "all")){
$bw->log("--> LOOP-start jsonclient loop_sharees $key by operatorApp: $value->{operatorApp}, netloc: $netloc if($project eq $value->{project} || $project eq \"all\")\n","","");
$ret_json = $self->fetch_operator_json($value->{operatorApp},$rest);
if($ret_json){
push(@uri_operator_array, $value->{operatorApp});
eval {
my $response_in = decode_json($ret_json);
#collect OP user_group
if($response_in->{shareejson}->{user_group}){
push (@user_group, @{$response_in->{shareejson}->{user_group}});
}
#collect OP user_tour
if($response_in->{shareejson}->{user_tour}){
push (@user_tour, @{$response_in->{shareejson}->{user_tour}});
}
if($q->param('request') && $q->param('request') =~ /stations_all|stations_available/){
foreach my $result (keys (%{ $response_in->{shareejson}->{stations} })) {
$fetch_hash->{$result} = $response_in->{shareejson}->{stations}->{$result};
}
}
if($q->param('request') && $q->param('request') =~ /bikes_all|bikes_available/){
foreach my $result (keys (%{ $response_in->{shareejson}->{bikes} })) {
$fetch_hash->{$result} = $response_in->{shareejson}->{bikes}->{$result};
}
}
if($q->param('request') && $q->param('request') =~ /user_bikes_occupied/){
foreach my $result (keys (%{ $response_in->{shareejson}->{bikes_occupied} })) {
$fetch_hash->{$result} = $response_in->{shareejson}->{bikes_occupied}->{$result};
}
}
};
if ($@){
$bw->log("Failure, eval json from jsonclient","","");
warn $@;
}
}else{
$bw->log("NO json ","","");
}
}
$bw->log("--> LOOP-end jsonclient loop_sharees user_group:\n",\@user_group,"");
}
#print "ALL:" . Dumper($fetch_hash);
#
return ($fetch_hash,\@uri_operator_array,\@user_group,\@user_tour);
}
sub fetch_operator_json {
my $self = shift;
my $operator_server = shift || "";
my $rest = shift || "";
my $operator_request = "$operator_server/APIjsonserver?$rest";
$bw->log("fetch_operator_json >> ","$operator_request","");
my $req = HTTP::Request->new(GET => "$operator_request");
$req->content_type('application/x-www-form-urlencoded');
$req->content($rest);
my $res = $ua->request($req);
if ($res->is_success) {
#print $res->content;
return $res->content;
}else {
return "";
}
}
1;

881
copri4/main/src/Mod/APIjsonserver.pm Normal file
View file

@ -0,0 +1,881 @@
package Mod::APIjsonserver;
#
# SPDX-License-Identifier: AGPL-3.0-or-later
# Copyright (c) Rainer Gümpelein, TeilRad GmbH
#
#Server for sharee json api
#
#use lib qw(/var/www/copri4/tinkdms/src);
#
##In DB context $q->escapeHTML must always done by API
#
use warnings;
use strict;
use Exporter;
our @ISA = qw (Exporter);
use POSIX;
use CGI;
use Apache2::Const -compile => qw(OK );
use JSON;
use Scalar::Util qw(looks_like_number);
use Config::General;
use Lib::Config;
use Mod::DBtank;
use Mod::Basework;
use Mod::Shareework;
use Mod::APIfunc;
use Mod::APIjsonclient;
use Data::Dumper;
use Sys::Hostname;
my $hostname = hostname;
sub handler {
my ($r) = @_;
my $q = new CGI;
my $netloc = $q->url(-base=>1);
#$q->import_names('R');
my $json = JSON->new->allow_nonref;
my $cf = new Config;
my $dbt = new DBtank;
my $bw = new Basework;
my $tk = new Shareework;
my $apif = new APIfunc;
my $jsc = new APIjsonclient;
my %varenv = $cf->envonline();
my $oprefix = $dbt->{operator}->{$varenv{dbname}}->{oprefix};
my $now_dt = strftime "%Y-%m-%d %H:%M:%S", localtime;
my $lang="de";
my $owner=188;#default via API if authcookie doesn't match merchant_id
my @keywords = $q->param;
my $debug=1;
my $user_agent = $q->user_agent();
$bw->log("APIjsonserver request:\n--> user-agent '$user_agent'",$q,"");
print $q->header(-type => "application/json", -charset => "utf-8", -'Access-Control-Allow-Origin' => "*");
my $respreq = $q->param('request') || "";
my $apiserver = $q->url(-base=>1) || "";
my $copri_version = "4.1.8.31";
my $response = {
apiserver => "$apiserver",
user_id => "",
authcookie => "",
new_authcoo => "0",
clearing_cache => "0",
agb_checked => "0",
user_group => [],
user_tour => [],
response => "$respreq",
uri_primary => "$varenv{uri_primary}",
copri_version => "$copri_version",
response_state => "OK, nothing todo",
privacy_html => "site/privacy.html",
agb_html => "site/agb.html",
impress_html => "site/impress.html",
tariff_info_html => "site/tariff_info_1.html",
bike_info_html => "site/bike_info.html",
initMap => {
center => { latitude => "", longitude => "" },
radius => ""
},
last_used_operator => {
operator_name => "sharee.bike | TeilRad GmbH",
operator_color => "#009699",
operator_email => "hotline\@sharee.bike",
operator_phone => "+49 761 45370097",
operator_hours => "Bürozeiten: Montag, Mittwoch, Freitag 9-12 Uhr",
},
lang => "DE"
};
#user_agent => "$user_agent"
my $merchanized = 0;
my $merchant_conf = "";
#while (($merchant_conf, my $value) = each %{ $dbt->{merchant_ids}}) {
# if($merchant_conf && $value->{user_agent} && $user_agent && $user_agent =~ /$value->{user_agent}/){
# #$owner = join("", map { $_ } keys %{ $value });
# $owner = $value->{id};
# $merchanized = 1;
# $response->{initMap} = "$value->{initMap}";
# $bw->log("APIjsonserver merchant select by user_agent: if($value->{user_agent} && $user_agent && $user_agent =~ /$value->{user_agent}/){",$merchant_id,"");
# last;
# }
#}
if(!$merchanized){
while (($merchant_conf, my $value) = each %{ $dbt->{merchant_ids}}) {
if($merchant_conf && (($R::authcookie && $R::authcookie =~ /$merchant_conf$/) || ($R::merchant_id && $R::merchant_id eq $merchant_conf))){
$owner = $value->{id};
$merchanized = 1;
$value->{initMap} =~ s/\s//g;
my ($lat,$lng) = split(/,/,$value->{initMap});
$response->{initMap}->{center}->{latitude} = $lat;
$response->{initMap}->{center}->{longitude} = $lng;
$response->{initMap}->{radius} = "2.9";
#$response->{initMap} = "$value->{initMap}";
$bw->log("APIjsonserver merchant select by authcookie OR merchant_id: if($merchant_conf && (($R::authcookie && $R::authcookie =~ /$merchant_conf$/) || ($R::merchant_id && $R::merchant_id eq $merchant_conf))){",$merchant_conf,"");
last;
}
}
}
if(!$merchanized && ($R::authcookie || $R::merchant_id)){
$response->{response_state} = "Failure 9900: no authcookie or merchant_id defined";
$response->{response_text} = "Authentifizierung fehlgeschlagen.";
$bw->log("NO authcookie or merchant_id defined",$R::merchant_id,"");
my $jrout = $json->pretty->encode({shareejson => $response});
print $jrout;
return Apache2::Const::OK;
exit 0;
}
#If param>40 || value > 200 then exit
foreach(@keywords){
if(length($_) > 40 || length($q->param($_)) > 400){
$response->{response_state} = "Failure 9000: amount of characters in $_ exceeds";
my $jrout = $json->pretty->encode({shareejson => $response});
print $jrout;
return Apache2::Const::OK;
exit 0;
}
}
#RESTful bikeAPP ------------------------------------------------------------------
if($q->param('user_device_manufaturer') || $q->param('user_device_model') || $q->param('user_device_platform') || $q->param('user_device_version') || $q->param('user_device_id')){
my $user_device = $q->param('user_device_manufaturer') . ";" . $q->param('user_device_model') . ";" . $q->param('user_device_platform') . ";" . $q->param('user_device_version') . ";" . $q->param('user_device_id');
$q->param(-name=>'user_device',-value=>"$user_device");
$bw->log("user_device",$q->param('user_device'),"");
}
#just auth_verify
if($q->param('request') eq "auth_verify"){
my ($auth,$authraw) = $apif->auth_verify($q);
$response = { %$response, %$auth };
if(ref($auth) eq "HASH" && $auth->{authcookie}){
$response = { %$response, %$auth };
}else{
$response->{response_state} = "Failure: cannote match authcookie";
$response->{response_text} = "Entschuldigung, die Session wurde unterbrochen";
}
}
#authout
elsif($q->param('request') eq "authout"){
my ($auth,$authraw) = $apif->authout($q);
$response = { %$response, %$auth };
if(ref($auth) eq "HASH" && $auth->{authcookie}){
$response->{authcookie} = "$auth->{authcookie}";
$response->{response_state} = "OK, logout";
$response->{response_text} = "Auf Wiedersehen.";
}else{
$response->{response_state} = "Failure 1001: authcookie not defined";
$response->{response_text} = "Entschuldigung, die Session wurde unterbrochen";
}
}
#authorization
elsif($q->param('request') eq "authorization"){
my ($auth,$authraw) = $apif->authorization($q,"","",$owner);
if(ref($auth) eq "HASH" && $auth->{authcookie}){
$response = { %$response, %$auth };
$response->{response_text} = "Herzlich willkommen im Fahrradmietsystem";
}else{
$response->{response_state} = "Failure: cannot generate authcookie";
$response->{response_text} = "Entschuldigung, die Anmeldung schlug fehl";
}
}
#booking request
elsif($q->param('request') eq "booking_request"){
my ($auth,$authraw) = $apif->auth_verify($q);
$response = { %$response, %$auth };
if(ref($auth) eq "HASH" && $auth->{authcookie}){
if($q->param('bike')){
#check count of occcupied/requested bikes
my $record = $apif->user_bikes_occupied($q,$authraw);
my $bikes_occupied = $apif->rentals($record,$authraw,"1");
my $count=0;
foreach my $id (keys(%$bikes_occupied)){
$count++;
}
if($count >= 3){
$response->{response_state} = "Failure: booking_request declined. max count of 3 occupied bikes has been reached";
$response->{response_text} = "Die maximale Anzahl von 3 Reservierungen wurde erreicht";
}else{
my $gps = "";
my $latitude = "";
my $longitude = "";
#old
if($q->param('gps')){
my $gps_input = $q->param('gps');
$gps_input =~ s/\s//g if($gps_input);
$latitude = $q->escapeHTML($1) if($gps_input =~ /^(\d+\.\d+),\d+/);
$longitude = $q->escapeHTML($1) if($gps_input =~ /\d+,(\d+\.\d+)$/);
$gps = "$latitude,$longitude" if($latitude && $longitude);
}
#new
if($q->param('latitude') && $q->param('longitude')){
my $latitude_in = $q->param('latitude');
my $longitude_in = $q->param('longitude');
$latitude = $1 if($latitude_in =~ /(\d+\.\d+)/);
$longitude = $1 if($longitude_in =~ /(\d+\.\d+)/);
$gps = "$latitude,$longitude" if($latitude && $longitude);
}
my $response_book = $tk->net_booking($authraw,$q->param('bike'),$owner,$gps);
#just in time booking
if(ref($response_book) eq "HASH" && $response_book->{response_state} =~ /OK/ && $q->param('state') && $q->param('state') =~ /occupied/){
(my $rows, my $booking_values) = $apif->booking_update($q,$authraw,$owner);
$response = {%$response, %$booking_values};
}else{
$response = {%$response, %$response_book};
}
}
$record = $apif->user_bikes_occupied($q,$authraw);
$bikes_occupied = $apif->rentals($record,$authraw,"1");
foreach my $id (keys(%$bikes_occupied)){
if($bikes_occupied->{$id}->{bike} eq $q->param('bike')){
if($bikes_occupied->{$id}->{int10} == 2){
$response->{response_state} = "OK, bike " . $q->param('bike') . " requested";
$response->{response_text} = "Fahrrad Nr. " . $q->param('bike') . " ist reserviert";
}elsif($bikes_occupied->{$id}->{int10} == 3){
$response->{response_state} = "OK, bike " . $q->param('bike') . " requested and occupied";
$response->{response_text} = "Fahrrad Nr. " . $q->param('bike') . " ist gemietet";
}
}
}
#return list of occupied/requested bikes
$record = $apif->user_bikes_occupied($q,$authraw);
$response->{bikes_occupied} = $apif->rentals($record,$authraw,"1");#returns JSON rental values
}else{
$response->{response_state} = "Failure: no bike defined";
$response->{response_text} = "Abbruch, es wurde kein Fahrrad ausgewählt";
$response->{timeCode} = 0;#if fails
}
}else{
$response->{response_state} = "Failure 1002: authcookie not defined";
$response->{response_text} = "Entschuldigung, die Session wurde unterbrochen";
}
}
#booking cancel/update
elsif($q->param('request') eq "booking_cancel" || $q->param('request') eq "booking_update"){
if($q->param('request') eq "booking_cancel"){
$q->param(-name=>'request',-value=>"booking_update");
$q->param(-name=>'state',-value=>"canceled");
}
my ($auth,$authraw) = $apif->auth_verify($q);
my $rows = 0;
$response = { %$response, %$auth };
if(ref($auth) eq "HASH" && $auth->{authcookie}){
if($q->param('bike')){
if($q->param('request') eq "booking_update" && $q->param('state') && $q->param('state') =~ /canceled/){
($rows, my $booking_values) = $apif->booking_update($q,$authraw,$owner);
$response = {%$response, %$booking_values};
}elsif($q->param('request') eq "booking_update" && (($q->param('state') && $q->param('state') =~ /occupied|available/) || ($q->param('lock_state') && $q->param('lock_state') =~ /locking|locked|unlocked/))){
($rows, my $booking_values) = $apif->booking_update($q,$authraw,$owner);
$response = {%$response, %$booking_values};
#keep in mind, it works on operator dependency
$bw->log("user_miniquery via $varenv{dbname} exist count:",$authraw->{int23},"");
#Nur für project=Bayern und für Entwickler aktiviert
if($booking_values->{state} eq "available" && (($dbt->{operator}->{$varenv{dbname}}->{project} eq "Bayern" && $authraw->{int23} >= 1 && $authraw->{int23} < 4) || ($authraw->{c_id} == 1842 || $authraw->{c_id} == 5781 || $authraw->{c_id} == 11765 || $authraw->{c_id} == 1843))){
#TODO $ user_miniquery have to be in db table on primary
$bw->log("user_miniquery communicated to user ID",$authraw->{c_id},"");
my $user_miniquery = {
title => "Bitte unterstützen Sie unsere Begleitforschung",
subtitle => "Ihre drei Antworten werden anonym gespeichert.",
footer => "Herzlichen Dank und viel Spaß bei der nächsten Fahrt!",
questions => {
q1 => {
type => "check_one",
quest_text => "1. Was war der Hauptzweck dieser Ausleihe?",
query => {
opt1 => "a. Einkauf",
opt2 => "b. Kinderbeförderung",
opt3 => "c. Lastentransport",
opt4 => "d. Freizeit",
opt5 => "e. Ausprobieren",
opt6 => "f. Sonstiges"
}
},
q2 => {
type => "check_one",
quest_text => "2. Welches Verkehrsmittel hätten Sie ansonsten benutzt?",
query => {
opt1 => "a. Auto",
opt2 => "b. Motorrad oder Motorroller",
opt3 => "c. Bus oder Bahn",
opt4 => "d. Eigenes Fahrrad",
opt5 => "e. Zu Fuß",
opt6 => "f. Keines (ich hätte die Fahrt sonst nicht gemacht)",
opt7 => "g. Sonstige"
}
},
q3 => {
type => "text",
quest_text => "3. Haben Sie Anmerkungen oder Anregungen?",
query => {
opt1 => ""
}
}
}
};
$response->{user_miniquery} = $user_miniquery;
}#end mini_quest
#user_miniquest_count
my $user_miniquest_count = $authraw->{int23} || 0;
if($q->param('request') && $q->param('request') eq "booking_update" && $q->param('state') eq "available" && $user_miniquest_count <= 4){
$user_miniquest_count++;
my $update_op = {
table => "contentadr",
int23 => $user_miniquest_count,
atime => "now()",
owner => "198",
};
my $dbh = "";
my $rows = $dbt->update_record($dbh,$update_op,$authraw);
}
}
my $record = $apif->user_bikes_occupied($q,$authraw);
$response->{bikes_occupied} = $apif->rentals($record,$authraw,"1");
}else{
$response->{response_state} = "Failure: no bike defined";
$response->{response_text} = "Abbruch, es wurde keine Fahrrad Nummer angegeben";
$response->{timeCode} = 0;#if fails
}
}else{
$response->{response_state} = "Failure 1001: authcookie not defined";
$response->{response_text} = "Entschuldigung, die Session wurde unterbrochen";
}
}
#user_rental_history
elsif($q->param('request') eq "user_rentals_history"){
my ($auth,$authraw) = $apif->auth_verify($q);
$response = { %$response, %$auth };
if(ref($auth) eq "HASH" && $auth->{authcookie}){
my ($record,$operator_hash) = $apif->user_rentals_history($q,$authraw);
$response->{rentals} = $apif->rentals($record,$authraw,"0");
}else{
$response->{response_state} = "Failure 1001: authcookie not defined";
$response->{response_text} = "Entschuldigung, die Session wurde unterbrochen";
}
}
#user_bikes_occupied
elsif($q->param('request') eq "user_bikes_occupied"){
if($varenv{syshost} eq "shareeapp-primary"){
my ($auth,$authraw) = $apif->auth_verify($q);
if(ref($auth) eq "HASH" && $auth->{authcookie}){
$response = { %$response, %$auth };
($response->{bikes_occupied},$response->{uri_operator_array},$response->{user_group},$response->{user_tour}) = $jsc->loop_sharees($q,$auth,$owner);
}else{
$response->{response_state} = "Failure 1001: authcookie on primary not defined";
$response->{response_text} = "Entschuldigung, die Session wurde unterbrochen";
}
}else{
my ($auth,$authraw) = $apif->auth_verify($q);
if(ref($auth) eq "HASH" && $auth->{authcookie}){
$response = { %$response, %$auth };
my $record = $apif->user_bikes_occupied($q,$authraw);
$response->{bikes_occupied} = $apif->rentals($record,$authraw,"1");
}else{
$response->{response_state} = "Failure 1001: authcookie on operator not defined";
$response->{response_text} = "Entschuldigung, die Session wurde unterbrochen";
}
}
}
#bikes_available
elsif($q->param('request') eq "bikes_available"){
#use Time::HiRes qw/gettimeofday/;
if($varenv{syshost} eq "shareeapp-primary"){
my ($auth,$authraw) = $apif->auth_verify($q);
$response = { %$response, %$auth };
($response->{bikes},$response->{uri_operator_array},$response->{user_group},$response->{user_tour}) = $jsc->loop_sharees($q,$auth,$owner);
#my $stamp = gettimeofday;
#$bw->log("X bikes_available $varenv{syshost} $stamp: $response->{user_group}",$response,"");
}else{
my ($auth,$authraw) = $apif->auth_verify($q);#on operator loop select, operator adr must be select to get user_group
$response = { %$response, %$auth };
$bw->log("Y bikes_available by c_id $authraw->{c_id}, Tarif:",$authraw->{txt30},"");
$response->{bikes} = $apif->bikes_available($q,$authraw);
}
if(ref($response->{bikes}) ne "HASH"){
$response->{response_state} = "Failure 5003: cannot find any user defined bike tariff";
$response->{response_text} = "Abbruch, es konnte kein gültiger Tarif gefunden werden";
}
}
#bikes_all with service_state calculater
#cronjob for maintanance update runs at ~ 7:00
elsif($q->param('request') eq "bikes_all"){
if($varenv{syshost} eq "shareeapp-primary"){
my ($auth,$authraw) = $apif->auth_verify($q);
$response = { %$response, %$auth };
($response->{bikes},$response->{uri_operator_array},$response->{user_group},$response->{user_tour}) = $jsc->loop_sharees($q,$auth,$owner);
}else{
my ($auth,$authraw) = $apif->auth_verify($q);
$response = { %$response, %$auth };
$response->{response_text} = "Vorsicht, das ist die Liste aller Leihräder unabhängig von der Verfügbarkeit";
#on servicetool only stations on user_tour
my $stations_allraw = {};
(my $stations_not_used,$stations_allraw) = $apif->stations_all($q,"",$authraw) if($q->param('authcookie') =~ /_cleeJet3$|_34567890$/);
my ($bikes_all,$bikes_allraw,$bikes_on_station) = $apif->bikes_all($q,$authraw,$stations_allraw);
my $bike = "all";
my $interval = $q->param('interval') || "31";
my $service_state_debug = "\n";
my $pos_record = {};
my $response_work = {};
if($q->param('authcookie') =~ /cleeJet3|34567890$/){
(my $xresponse, $pos_record, my $node_template, my $crecord) = $apif->service_select($q,$authraw,"",$interval);
($response_work, my $node) = $apif->service_work($pos_record,$bikes_allraw,"",$node_template);
#Pseudocode -- Calculate service_state:
#if (state == "defekt") -> service_state=1-rot
#else if (1 harte Wartung fällig und ( mind. 1 weiche Wartung fällig -oder- Aufgabe Text eingetragen )) -> service_state=2-Blau
#else if ( mind. 1 harte Wartung fällig ) -> service_state=3-grün
#else service_state=4-grau
}
my $i=0;
foreach my $bid (sort { $bikes_allraw->{$a}->{mtime} cmp $bikes_allraw->{$b}->{mtime} } keys (%$bikes_allraw)){
my $biselect = $bikes_allraw->{$bid}->{barcode};
$i++;
#service_state Calculator
$bikes_all->{$oprefix . $bid}->{todo_info} = "0";
$bikes_all->{$oprefix . $bid}->{service_state} = "0";
$bikes_allraw->{$bid}->{service_state_blue} = 0;
$bikes_allraw->{$bid}->{service_state_green} = 0;
$bikes_allraw->{$bid}->{service_state_exist} = 0;
#print "bid:$bid|$bikes_allraw->{$bid}->{mtime}\n";
#disabled, needs also to much cpu-time
#if(ref($response_work->{$biselect}) ne "HASH" || $response_work->{$biselect}->{int01}->{c_id} !~ /\d/ && $q->param('authcookie') =~ /cleeJet3|34567890$/){
# my $pos_record_bi = $apif->service_work_select($biselect,"","");
# (my $response_work_bi, my $node) = $apif->service_work($pos_record_bi,$bikes_allraw);
# $response_work->{$biselect} = $response_work_bi->{$biselect};
#print "Rad:$biselect " . Dumper($response_work->{$biselect});
#}
#2019-02-14, fixed
if(ref($response_work->{$biselect}) eq "HASH" && $q->param('authcookie') =~ /cleeJet3|34567890$/){
#print "$biselect: $response_work->{$biselect}->{mtime}\n";
$bikes_allraw->{$bid}->{service_state_exist} = 1;
foreach my $id (keys(%{$response_work->{$biselect}})){
$bw->log("response_work:$biselect","|$id|$response_work->{$biselect}->{$id}->{mtime}|$response_work->{$biselect}->{$id}->{service_type}|$response_work->{$biselect}->{$id}->{time_over}|$response_work->{$biselect}->{$id}->{work_val}","");
#time_over && (service_type || Aufgaben)
if(($response_work->{$biselect}->{$id}->{time_over} == 1 && $response_work->{$biselect}->{$id}->{service_type} >= 1) || ($id eq "txt01" && $response_work->{$biselect}->{$id}->{work_val})){
#print $id . ":" . $response_work->{$biselect}->{$id}->{work_val} . "\n";
if($id eq "txt01" && $response_work->{$biselect}->{$id}->{work_val} && $response_work->{$biselect}->{$id}->{work_val} ne "NaN" && $response_work->{$biselect}->{$id}->{work_val} !~ /::erledigt::/){
$bikes_all->{$oprefix . $bid}->{todo_info} = "1";
}
if(($response_work->{$biselect}->{$id}->{time_over} == 1 && $response_work->{$biselect}->{$id}->{service_type} == 1) || ($id eq "txt01" && $response_work->{$biselect}->{$id}->{work_val} && $response_work->{$biselect}->{$id}->{work_val} ne "NaN" && $response_work->{$biselect}->{$id}->{work_val} !~ /::erledigt::/)){
$bikes_allraw->{$bid}->{service_state_blue}++;
}
if($response_work->{$biselect}->{$id}->{time_over} == 1 && $response_work->{$biselect}->{$id}->{service_type} == 2){
$bikes_allraw->{$bid}->{service_state_green}++;
}
}
}#end response_work service_state calc
if($bikes_allraw->{$bid}->{service_state_exist} == 1 && $bikes_all->{$oprefix . $bid}->{state} eq "defect"){
$bikes_all->{$oprefix . $bid}->{service_state} = "1";
$service_state_debug .= "$bid: service_state 1\n";
#$bw->log("defect service_state bike: $bid:",$bikes_all->{$oprefix . $bid}->{service_state},"");
}
elsif($bikes_allraw->{$bid}->{service_state_blue} >= 1 && $bikes_allraw->{$bid}->{service_state_green} >= 1){
#print "$bikes_allraw->{$bid}->{service_state_blue}|$bikes_allraw->{$bid}->{service_state_green}" if($bid eq "5");
#$bikes_all->{$oprefix . $bid}->{service_state} = "$bikes_allraw->{$bid}->{service_state_blue}";
$bikes_all->{$oprefix . $bid}->{service_state} = "2";
$bikes_all->{$oprefix . $bid}->{state} = "maintanance";
#if($bikes_allraw->{$bid}->{txt10} && $bikes_allraw->{$bid}->{txt10} !~ /defect|maintanance|requested|occupied/)
if($bikes_allraw->{$bid}->{int10} && ($bikes_allraw->{$bid}->{int10} == 1 || $bikes_allraw->{$bid}->{int10} == 6)){
$service_state_debug .= "$bid: service_state 2\n";
#$bw->log("maintanance service_state bike: $bid:",$bikes_all->{$oprefix . $bid}->{service_state},"");
#4 = "maintanance"
$apif->bikestate_update($authraw,$bikes_allraw->{$bid}->{c_id},"4");
}
}
elsif($bikes_allraw->{$bid}->{service_state_green} >= 1){
#$bikes_all->{$oprefix . $bid}->{service_state} = "$bikes_allraw->{$bid}->{service_state_green}";
$bikes_all->{$oprefix . $bid}->{service_state} = "3";
$bikes_all->{$oprefix . $bid}->{state} = "maintanance";
#if($bikes_allraw->{$bid}->{txt10} && $bikes_allraw->{$bid}->{txt10} !~ /defect|maintanance|requested|occupied/){
if($bikes_allraw->{$bid}->{int10} && ($bikes_allraw->{$bid}->{int10} == 1 || $bikes_allraw->{$bid}->{int10} == 6)){
$service_state_debug .= "$bid: service_state 3\n";
#$bw->log("maintanance service_state bike: $bid:",$bikes_all->{$oprefix . $bid}->{service_state},"");
#4 = "maintanance"
$apif->bikestate_update($authraw,$bikes_allraw->{$bid}->{c_id},"4");
}
}elsif($bikes_allraw->{$bid}->{service_state_exist} == 1){
#if($bikes_allraw->{$bid}->{txt10} && $bikes_allraw->{$bid}->{txt10} =~ /maintanance/)
if($bikes_allraw->{$bid}->{int10} && $bikes_allraw->{$bid}->{int10} == 4){
$service_state_debug .= "$bid: 0\n";
#$bw->log("maintanance TO available service_state bike: $bid:",$bikes_all->{$oprefix . $bid}->{service_state},"");
#1 = "available"
$apif->bikestate_update($authraw,$bikes_allraw->{$bid}->{c_id},"1");
}
}
#workaround to get todo_info on defect
#else NOT if(ref($response_work->{$biselect}) eq "HASH" && $response_work->{$biselect}->{int01}->{c_id}) ---> because 31 day select
}
if($bikes_all->{$oprefix . $bid}->{state} eq "defect"){
$bikes_all->{$oprefix . $bid}->{service_state} = "1";
my $search = { key => "txt01",
val => "%",
};
my $pos_record_bi = $apif->service_work_search($biselect,"","",$search);
if($pos_record_bi->{txt01} && $pos_record_bi->{txt01} ne "NaN" && $pos_record_bi->{txt01} !~ /::erledigt::/){
#$bikes_all->{$oprefix . $bid}->{todo_info} = "$pos_record_bi->{txt01}";
$bikes_all->{$oprefix . $bid}->{todo_info} = "1";
}
$service_state_debug .= "$bid: service_state 1\n";
}
}
#print "all:$i\n";
#if($q->param('authcookie') =~ /_cleeJet3$|_34567890$/){
# $bw->log("on bikes_all: kmlGenerator","","");
#require "Mod/KMLout.pm";
#my $kmlfile = Mod::KMLout::kmlGenerator("","");
#}
$bw->log("service_state_debug",$service_state_debug,"");
$response->{bikes} = $bikes_all;
}
}
#stations_all
elsif($q->param('request') eq "stations_all"){
if($varenv{syshost} eq "shareeapp-primary"){
my ($auth,$authraw) = $apif->auth_verify($q);
$response = { %$response, %$auth };
($response->{stations},$response->{uri_operator_array},$response->{user_group},$response->{user_tour}) = $jsc->loop_sharees($q,$auth,$owner);
}else{
my ($auth,$authraw) = $apif->auth_verify($q);
$response = { %$response, %$auth };
my ($bikes_all,$bikes_allraw,$bikes_on_station) = $apif->bikes_all($q,$authraw,"");
($response->{stations},my $stations_allraw) = $apif->stations_all($q,$bikes_on_station,$authraw);
}
}
#stations_available
elsif($q->param('request') eq "stations_available"){
if($varenv{syshost} eq "shareeapp-primary"){
my ($auth,$authraw) = $apif->auth_verify($q);
#Mein konrad App
#if($dbt->{merchant_ids}->{$varenv{merchant_id}}->{id} eq "176"){
if($owner && $owner eq "176"){
$response->{merchant_message} = "Herzlich Willkommen bei der neuen konrad App! Die App ist zwar schon installierbar, bis zur vollständigen Umstellung des Systems sind aber noch keine Räder ausleihbar. Das ist erst voraussichtlich Ende Januar der Fall und wird den Nutzern noch mitgeteilt. Danke für Ihr Verständnis! Ihr konrad-Team";
}
$response = { %$response, %$auth };
($response->{stations},$response->{uri_operator_array},$response->{user_group},$response->{user_tour}) = $jsc->loop_sharees($q,$auth,$owner);
}else{
my ($auth,$authraw) = $apif->auth_verify($q);
$response = { %$response, %$auth };
($response->{stations}, my $response_raw) = $apif->stations_available($q,$authraw);
}
}
#user_feedback / user_minianswer of user_miniquery
elsif($q->param('request') eq "user_feedback" || $q->param('request') eq "user_minianswer"){
my ($auth,$authraw) = $apif->auth_verify($q);
$response = { %$response, %$auth };
$response->{uri_operator} = "$varenv{wwwhost}";
if(ref($auth) eq "HASH" && $auth->{authcookie}){
my $customer = $auth->{c_id};
#print Dumper($auth);
(my $xresponse->{$customer}, my $responseraw, my $node_template, my $crecord) = $apif->service_select($q,$authraw,"","1");
$bw->log("c_id: $crecord->{c_id} |user_feedback OR user_minianswer node_template",$node_template,"");
my $back_id = "";
my $rows=0;
#if(!$back_id){#disabled because of every feedback have to be saved
if(1==1){
#INSERT just dadaset
$back_id = $apif->service_insert($q,$authraw,$node_template,$crecord,$owner);
$rows = $apif->service_update($q,$authraw,$node_template,$back_id);
if($rows && $rows > 0){
$response->{response_state} = "OK, feedback insert and update";
$response->{response_text} = "Danke für die Nachricht.";
}else{
$response->{response_state} = "Failure 3606, feedback_update";
$response->{response_text} = "Die Nachricht konnte leider nicht gespeichert werden.";
}
}
#($xresponse->{$customer}, $responseraw, $node_template, $crecord) = $apif->service_select($q,$authraw,$back_id,"") if($back_id);
#my $response_work = {};
#$response_work->{feedback} = $apif->feedback_response($responseraw,$node_template);
#$response = { %$response, %$response_work };
}
}
#service_done
#insert and/or update
elsif($q->param('request') eq "service_done"){
my ($auth,$authraw) = $apif->auth_verify($q);
my $station_id = $1 if($q->param('station') =~ /(\d+)/);
my $bike_id = $1 if($q->param('bike') =~ /(\d+)/);
$response->{uri_operator} = "$varenv{wwwhost}";
if(ref($auth) eq "HASH" && $auth->{authcookie}){
if(looks_like_number($bike_id) || looks_like_number($station_id)){
my $article = looks_like_number($bike_id) || looks_like_number($station_id);
#select services with max work_duration of 1 day and service_worker alias contentadr.c_id = contenttranspo.owner match
(my $xresponse->{$article}, my $responseraw, my $node_template, my $crecord) = $apif->service_select($q,$authraw,"","1");
$bw->log("service_done OOO: node",$node_template,"");
if(ref($xresponse->{$article}) eq "HASH"){
$bw->log("service_done xresponse",$xresponse->{$article},"");
my $service_id = "";
#select last service_id with work_duration < 1 day
foreach my $id (sort { $xresponse->{$article}->{$a}->{mtime} cmp $xresponse->{$article}->{$b}->{mtime} } keys (%{$xresponse->{$article}})){
$service_id = $id if($id > 1);
}
my $rows=0;
$service_id = $1 if($q->param('service_id') =~ /(\d+)/);
if(!$service_id){
#INSERT just dadaset (without work values)
($response->{service_id}) = $apif->service_insert($q,$authraw,$node_template,$crecord);
$bw->log("service insert ",$response,"");
#once again to get node_record template
($xresponse->{$article}, $responseraw, $node_template, $crecord) = $apif->service_select($q,$authraw,"","1");
#UPDATE
$service_id = $response->{service_id};
$rows = $apif->service_update($q,$authraw,$node_template,$response->{service_id});
$response->{response_state} = "OK" if($rows > 0);
$response->{response_text} = "OK, service_insert and update" if($rows > 0);
}else{
#UPDATE
$rows = $apif->service_update($q,$authraw,$node_template,$service_id);
$response->{response_state} = "OK" if($rows > 0);
$response->{response_text} = "OK, service_update" if($rows > 0);
}
#UPDATE bike content state
if($q->param('work_id') eq "state" && looks_like_number($bike_id) && $q->param('work_val') =~ /available|maintanance|defect/){
#once again to get node_record template
($xresponse->{$article}, $responseraw, $node_template, $crecord) = $apif->service_select($q,$authraw,"","1");
while (my ($key, $value) = each %{ $dbt->{copri_conf}->{bike_state} }) {
if($q->param('work_val') eq $value){
$rows = $apif->bikestate_update($authraw,$responseraw->{$service_id}->{cc_id},$key);
$response->{response_state} = "OK";
$response->{response_text} = "OK, bikestate_update to state=$value";
}
}
}
if(($q->param('work_id') eq "int04" || $q->param('work_id') eq "station") && looks_like_number($bike_id) && ($q->param('work_val') || looks_like_number($q->param('work_val')))){
$q->param(-name=>'work_id',-value=>"int04") if($q->param('work_id') eq "station");#station db-field is int04
my $to_station_id = $1 if($q->param('work_val') =~ /(\d+)/);
my ($bikes_all,$bikes_allraw,$bikes_on_station) = $apif->bikes_all($q,$authraw,"");
#add-on to log redistribute#TODO dedicated db-fieled
my $action = "txt10=" . $oprefix . $bikes_allraw->{$bike_id}->{int04} . " - " . $q->param('work_val');
$apif->service_update($q,$authraw,$node_template,$service_id,$action);
my ($stations_all,$stations_allraw) = $apif->stations_all($q,$bikes_on_station,$authraw);
if(looks_like_number($stations_allraw->{$to_station_id}->{int04})){
($xresponse->{$article}, $responseraw, $node_template, $crecord) = $apif->service_select($q,$authraw,"","1");
my $update_hash = { int04 => "$to_station_id" };
$rows = $apif->bikestate_update($authraw,$responseraw->{$service_id}->{cc_id},"",$update_hash);
$response->{response_state} = "OK" if($rows > 0);
$response->{response_text} = "OK, bikestate_update to_station_id $to_station_id" if($rows > 0);
}elsif($to_station_id == 0){#werkstatt
($xresponse->{$article}, $responseraw, $node_template, $crecord) = $apif->service_select($q,$authraw,"","1");
my $update_hash = { int04 => "$to_station_id" };
#5 = "defect"
$rows = $apif->bikestate_update($authraw,$responseraw->{$service_id}->{cc_id},"5",$update_hash);
$response->{response_state} = "OK" if($rows > 0);
$response->{response_text} = "OK, bikestate_update to Werkstatt $to_station_id" if($rows > 0);
}else{
$bw->log("service_update fails to_station_id: $to_station_id",$stations_allraw->{$to_station_id}->{int04},"");
$response->{response_state} = "Failure 3003: service_update fails";
}
}
if($rows != 1){
$response->{response_state} = "Failure 3004: service_update fails";
}
$response->{service_id_done} = $service_id;
}else{
$response->{response_state} = "Failure 3009: service_update fails because of can not find bike or station";
$response->{response_text} = "Fehler, angefragte Artikel konnte nicht gefunden werden!";
}
my $response_work = {};
my $node = {};
my ($bikes_all,$bikes_allraw,$bikes_on_station) = $apif->bikes_all($q,$authraw,"");
if(looks_like_number($bike_id)){
(my $xresponse, my $pos_record, my $node_template, my $crecord) = $apif->service_select($q,$authraw,"","100");#check interval
($response_work, $node) = $apif->service_work($pos_record,$bikes_allraw,"",$node_template);
}
elsif(looks_like_number($station_id)){
my ($stations_all,$stations_allraw) = $apif->stations_all($q,$bikes_on_station,$authraw);
(my $xresponse, my $pos_record, my $node_template, my $crecord) = $apif->service_select($q,$authraw,"","100");#check interval
($response_work, $node) = $apif->service_work($pos_record,$stations_allraw,"",$node_template);
}
#inject oprefix
my $op_response_work = {};
foreach my $key (keys %$response_work){
$op_response_work->{$oprefix . $key} = $response_work->{$key};
}
$response = { %$response, %$op_response_work, %$auth };
my $node_template_id = 0;
$node_template_id = $node_template->{template_id} if(ref($node_template) eq "HASH" && $node_template->{template_id});
$response->{service_template} = "$node_template_id";
}else{
$response->{response_state} = "Failure 3002: no bike OR station ID defined";
}
}else{
$response->{response_state} = "Failure 1001: authcookie not defined";
}
}#end service_done
#service_work
#service_work. select last service by bike-id
elsif($q->param('request') eq "service_work"){
my ($auth,$authraw) = $apif->auth_verify($q);
my $station_id = "";
my $bike_id = "";
$station_id = $1 if($q->param('station') =~ /(\d+)/);
$bike_id = $1 if($q->param('bike') =~ /(\d+)/);
$response->{uri_operator} = "$varenv{wwwhost}";
my $node = {};
my $history = 0;
$history = $q->param('history') if(looks_like_number($q->param('history')));
if(ref($auth) eq "HASH" && $auth->{authcookie}){
if(looks_like_number($bike_id)){
my ($bikes_all,$bikes_allraw,$bikes_on_station) = $apif->bikes_all($q,$authraw,"");
(my $xresponse, my $pos_record, my $node_template, my $crecord) = $apif->service_select($q,$authraw,"",$history);
#$bw->log("service_work bike_id $bike_id pos_record",$pos_record,"");
(my $response_work, $node) = $apif->service_work($pos_record,$bikes_allraw,$history,$node_template);
$bw->log("service_work bike_id $bike_id response_work",$response_work,"");
if(ref($response_work) ne "HASH"){#if fails
$response->{response_state} = "Failure 4010: no service found";
}
my $op_response_work = {};
foreach my $key (keys %$response_work){
$op_response_work->{$oprefix . $key} = $response_work->{$key};
}
$response = { %$response, %$op_response_work, %$auth };
}elsif($q->param('bike') && $q->param('bike') eq "all"){
my ($bikes_all,$bikes_allraw,$bikes_on_station) = $apif->bikes_all($q,$authraw,"");
my $bike = $q->param('bike');
(my $xresponse, my $pos_record, my $node_template, my $crecord) = $apif->service_select($q,$authraw,"",$history);
(my $response_work, $node) = $apif->service_work($pos_record,$bikes_allraw,$history,$node_template);
if(ref($response_work) ne "HASH"){#if fails
$response->{response_state} = "Failure 4011: no service found";
}
my $op_response_work = {};
foreach my $key (keys %$response_work){
$op_response_work->{$oprefix . $key} = $response_work->{$key};
}
$response = { %$response, %$op_response_work, %$auth };
}elsif(looks_like_number($station_id)){
my ($bikes_all,$bikes_allraw,$bikes_on_station) = $apif->bikes_all($q,$authraw,"");
my ($stations_all,$stations_allraw) = $apif->stations_all($q,$bikes_on_station,$authraw);
(my $xresponse, my $pos_record, my $node_template, my $crecord) = $apif->service_select($q,$authraw,"",$history);
(my $response_work, $node) = $apif->service_work($pos_record,$stations_allraw,$history,$node_template);
if(ref($response_work) ne "HASH"){#if fails
$response->{response_state} = "Failure 4013: no service found";
}
my $op_response_work = {};
foreach my $key (keys %$response_work){
$op_response_work->{$oprefix . $key} = $response_work->{$key};
}
$response = { %$response, %$op_response_work, %$auth };
}elsif($q->param('station') && $q->param('station') eq "all"){
my ($bikes_all,$bikes_allraw,$bikes_on_station) = $apif->bikes_all($q,$authraw,"");
my ($stations_all,$stations_allraw) = $apif->stations_all($q,$bikes_on_station,$authraw);
my $station = $q->param('station');
(my $xresponse, my $pos_record, my $node_template, my $crecord) = $apif->service_select($q,$authraw,"",$history);
(my $response_work, $node) = $apif->service_work($pos_record,$stations_allraw,$history,$node_template);
if(ref($response_work) ne "HASH"){#if fails
$response->{response_state} = "Failure 4014: no service found";
}
my $op_response_work = {};
foreach my $key (keys %$response_work){
$op_response_work->{$oprefix . $key} = $response_work->{$key};
}
$response = { %$response, %$response_work, %$auth };
}else{
$response->{response_state} = "Failure 3002: no bike OR station ID defined";
}
}else{
$response->{response_state} = "Failure 1001: authcookie not defined";
}
$response->{service_template} = "$node->{template_id}";
}#end service_work
#last if request not defined
else{
$response->{'response_state'} = "Failure: request not defined";
}
#end RESTful ------------------------------------------------------------
#FINAL JSON response OUTPUT ----------------------------------------------------------
my $jrout = $json->pretty->encode({shareejson => $response});
print $jrout;
$bw->log("APIjsonserver response by $user_agent mapped owner:$owner",$jrout,"");
#end JSON ----------------------------------------------------------------------------
return Apache2::Const::OK;
}#end handler
1;

161
copri4/main/src/Mod/APIvelo.pm Normal file
View file

@ -0,0 +1,161 @@
package Mod::APIvelo;
#
# SPDX-License-Identifier: AGPL-3.0-or-later
# Copyright (c) Rainer Gümpelein, TeilRad GmbH
#
#Server for velofaktur
#
#curl -d '{"Typ":"Statusmeldung","Station":8,"Slot":1,"Fahrzeug":{"Buchbar":false,"Id":"200008","LadezustandBatterie":"75"}}' -H "Content-Type: application/json" -X POST https://shareeapp-fr01.copri4.de/APIvelo
#
#ATTENTION
##In DB context $q->escapeHTML must always done by API
#
#use lib qw(/var/www/copri4/shareeapp-fr01/src);
use warnings;
use strict;
use POSIX;
use Exporter;
our @ISA = qw (Exporter);
#use POSIX;
use CGI;
use Apache2::Const -compile => qw(OK );
use JSON;
use Scalar::Util qw(looks_like_number);
use Config::General;
use Lib::Config;
use Mod::DBtank;
use Mod::Basework;
use Mod::APIfunc;
use Mod::APIjsonclient;
use Data::Dumper;
sub handler {
my ($r) = @_;
my $q = new CGI;
my $json = JSON->new->allow_nonref;
my $cf = new Config;
my $dbt = new DBtank;
my $bw = new Basework;
my %varenv = $cf->envonline();
my $now_dt = strftime "%Y-%m-%d %H:%M:%S", localtime;
my $lang="de";
my $owner=182;#velofactur API
my $debug=1;
my $user_agent = $q->user_agent();
my $dbh = "";
$bw->log("APIvelo POST:\n--> user-agent: '$user_agent' to syshost: $varenv{syshost}\n",$q,"");
print $q->header(-type => "application/json", -charset => "utf-8", -'Access-Control-Allow-Origin' => "*");
open(FILE,">>$varenv{logdir}/APIvelo.log") if($debug);
print FILE "\n*** $now_dt user-agent: '$user_agent' to syshost: $varenv{syshost}\n" if($debug);
print FILE "<=== veloDUMP\n " . Dumper($q) . "\n" if($debug);
print FILE "<=== DUMP postdata:\n " . Dumper($q->param('POSTDATA')) . "\n" if($debug);
my $jrout = "seems to be not valid";
eval {
my $response_in = decode_json( $q->param('POSTDATA'));
#- int19=bike charge
#- int27=velofactur bike ID
#- int28=station_lock_state (station lock velofactur)
#- int29=velofactur Buchbar (true|false)
#- int30=velofactur station ID
#- int31=velofactur slot ID
#- txt25=velofactur last station message (error or success)
my $jrout = $json->pretty->encode({ fakturjson => $response_in });
print FILE "<=== JSON POST from velofactur:\n$jrout\n" if($debug);
my $record_cc = { c_id => 0 };
if($response_in->{Typ} eq "Statusmeldung" && $response_in->{Fahrzeug}->{Id} =~ /(\d+)/){
my $velo_id = $1;
print FILE "condition: : $response_in->{Typ} && $response_in->{Fahrzeug}->{Id}\n" if($debug);
my $pref_cc = {
table => "content",
fetch => "one",
template_id => "205",
int27 => $velo_id,
};
#loop operators to get velofactur bike Id
while (my ($mandant_conf, $value) = each %{ $dbt->{operator} }) {
if($value->{database}->{dbname} && $value->{hwtype} eq "velofactur"){
my $rows = 0;
my $sharee_operator = $value->{database}->{dbname};
my $dbh_operator = $dbt->dbconnect_extern($sharee_operator);
$record_cc = $dbt->fetch_record($dbh_operator,$pref_cc);
if($record_cc->{c_id}){
my $update_cc = {
table => "content",
mtime => "now()",
owner => "$owner",
};
#$update_cc->{int28} = 0;#where is the key=value for station_lock_state? Buchbar?
$update_cc->{int19} = $response_in->{Fahrzeug}->{LadezustandBatterie} if(looks_like_number($response_in->{Fahrzeug}->{LadezustandBatterie}));
$update_cc->{int27} = $1 if($response_in->{Fahrzeug}->{Id} && $response_in->{Fahrzeug}->{Id} =~ /(\d+)/);
$update_cc->{int30} = $1 if($response_in->{Station} && $response_in->{Station} =~ /(\d+)/);
$update_cc->{int31} = $1 if($response_in->{Slot} && $response_in->{Slot} =~ /(\d+)/);
$update_cc->{txt25} = $response_in->{Status} if($response_in->{Status});
#velofactur false|true boeelan
#set bike_state to maintanance
#only if saved! velofactur Buchbar_state = true and bike_state = available
$update_cc->{int10} = 4 if($update_cc->{int29} == 1 && $update_cc->{int10} == 1);
$update_cc->{int29} = 0;
if($response_in->{Fahrzeug}->{Buchbar}){
#set bike_state to available
#only if saved! velofactur Buchbar_state = false and bike_state = maintanance
$update_cc->{int10} = 1 if($update_cc->{int29} == 0 && $update_cc->{int10} == 4);
$update_cc->{int29} = 1;
}
$rows = $dbt->update_record($dbh_operator,$update_cc,$record_cc);
$bw->log("velofactur updates dbname: $sharee_operator, c_id=$record_cc->{c_id} by fakturjson $response_in->{Typ} | rows:$rows",$update_cc,"");
print FILE "---> velofactur updates dbname: $sharee_operator, c_id=$record_cc->{c_id} by fakturjson $response_in->{Typ} | rows:$rows\n" . Dumper($update_cc) . "\n" if($debug);
}
}
}
############
#stdout printed JSON to velofactur endpoint
my %jsonout;
$jsonout{Typ} = "sharee Befehlsmeldung";
$jsonout{Status} = "DONE";
foreach my $resp (keys (%{ $response_in })) {
#print $resp . ":" . $response_in->{$resp} . "\n";
$jsonout{$resp} = $response_in->{$resp} if($resp eq "Id");
}
my $rest_json = $json->pretty->encode(\%jsonout);
print $rest_json;
############
}else{
print FILE "condition anywhere an for selftests\n" if($debug);
print $jrout;
}
};
if ($@){
print FILE "failure! can not decode POST json, POSTDATA:\n" . Dumper($q->param('POSTDATA')) . "\n" if($debug);
warn $@;
}
close(FILE) if($debug);
return Apache2::Const::OK;
}
1;

207
copri4/main/src/Mod/APIxmlserver.pm Normal file
View file

@ -0,0 +1,207 @@
package Mod::APIxmlserver;
#
# SPDX-License-Identifier: AGPL-3.0-or-later
# Copyright (c) Rainer Gümpelein, TeilRad GmbH
#
#Server for sharee xml api
#
##In DB context $q->escapeHTML must always done by API
#
#use lib qw(/var/www/copri4/shareeapp-primary/src);
use warnings;
use strict;
use Exporter;
our @ISA = qw (Exporter);
use POSIX;
use CGI;
use Apache2::Const -compile => qw(OK );
use Scalar::Util qw(looks_like_number);
use LWP::UserAgent;
use XML::Simple qw(:strict);
use Lib::Config;
use Mod::DBtank;
use Mod::Basework;
use Mod::Shareework;
use Mod::APIfunc;
use Digest::MD5 qw(md5 md5_hex);
use Data::Dumper;
use Sys::Hostname;
my $hostname = hostname;
sub handler {
my ($r) = @_;
my $q = new CGI;
my $netloc = $q->url(-base=>1);
#$q->import_names('R');
my $cf = new Config;
my $dbt = new DBtank;
my $bw = new Basework;
my $tk = new Shareework;
my $apif = new APIfunc;
my %varenv = $cf->envonline();
my $oprefix = $dbt->{operator}->{$varenv{dbname}}->{oprefix};
my $now_dt = strftime "%Y-%m-%d %H:%M:%S", localtime;
my $lang="de";
my $owner=199;#LastenVelo api (LV api)
my @keywords = $q->param;
my $debug=1;
my $user_agent = $q->user_agent();
my $dbh = "";
if(1==1){
foreach(@keywords){
if(length($_) > 20 || length($q->param($_)) > 400){
print "<text>Failure 19900: amount of characters in $_ exceeds</text>";
return Apache2::Const::OK;
exit 0;
}
}
}
$bw->log("APIxmlserver request:\n--> user-agent '$user_agent'",$q,"");
print $q->header(-type => "application/xml", -charset => "utf-8", -'Access-Control-Allow-Origin' => "*");
#print "Content-type: text/xml\n\n";
if($q->param('POSTDATA')){
my $xmlref = {};
$xmlref = XMLin($q->param('POSTDATA'), ForceArray => ['sharee_LastenVelo'], KeyAttr => [ ] );
$xmlref->{userID} =~ s/\s//g;
if(ref($xmlref) eq "HASH" && $xmlref->{todo} && looks_like_number($xmlref->{userID}) && $xmlref->{userID} =~ /^\d+$/){
#<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
# <sharee_LastenVelo>
# <todo>add_LVuser</todo>
# <userID>12345678</userID>
# <emailID>ragu@gnu-systems.de</emailID>
# <pwID>geheim123</pwID>
#</sharee_LastenVelo>
#für update:
#<todo>update_LVuser</todo>
#<userID>12345678</userID
#für delete:
#<todo>delete_LVuser</todo>
#<userID>12345678</userID
my $pref = {
table => "contentadr",
fetch => "one",
template_id => "202",
int01 => "$xmlref->{userID}",
};
my $record = $dbt->fetch_record($dbh,$pref);
my $c_id = "";
$bw->log("$xmlref->{todo}",$xmlref,"");
if($xmlref->{userID} && $xmlref->{emailID} && $xmlref->{pwID}){
if($xmlref->{todo} =~ /add_LVuser|update_LVuser/ && !$record->{c_id}){
my $teltime = time;
my $pwmd5 = md5_hex($q->escapeHTML($xmlref->{pwID}));
#$c_id = $tk->create_account($owner);
my $insert = {
table => "contentadr",
main_id => "200011",
template_id => "202",
mtime => 'now()',
atime => 'now()',
owner => "$owner",
int01 => $q->escapeHTML($xmlref->{userID}),
txt08 => $q->escapeHTML($xmlref->{emailID}),
txt11 => "$pwmd5",
txt17 => "sharee_lv",
int03 => "1",
txt22 => "DE11111111111111111111",
txt23 => "FRSPDE11111",
int04 => "1",
int13 => "1",
txt30 => "5511",
int05 => "1",
int14 => "1",
int16 => "null",
txt01 => "no name",
txt03 => "fake str. 1",
txt06 => "79999 freiburg",
txt07 => "$teltime",
ct_name => "LV-12345678",
};
$c_id = $dbt->insert_contentoid($dbh,$insert);
}elsif($xmlref->{todo} eq "update_LVuser" && $record->{c_id}){
my $pwmd5 = md5_hex($xmlref->{pwID});
my $update = {
table => "contentadr",
mtime => 'now()',
owner => "$owner",
int01 => "$xmlref->{userID}",
txt08 => "$xmlref->{emailID}",
txt11 => "$pwmd5",
};
my $rows = $dbt->update_record($dbh,$update,$record);
}elsif($xmlref->{todo} eq "delete_LVuser"){
$dbt->delete_content($dbh,"contentadr",$record->{c_id});
}
foreach my $item (keys(%$xmlref)){
print "<$item>$xmlref->{$item}</$item>\n";
}
}
}elsif(ref($xmlref) eq "HASH" && $xmlref->{todo} && $xmlref->{todo} eq "available" && $xmlref->{bikeID} =~ /\d+/){
#<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
#<sharee_LastenVelo>
#<todo>available</todo>
#<bikeID>17</bikeID>
#</sharee_LastenVelo>
my $bike_id = $1 if($xmlref->{bikeID} =~ /(\d+)/);
my $pref_cc = {
table => "content",
fetch => "one",
template_id => "205",
barcode => $bike_id,
int10 => "!=::1",#if not available
};
my $record_cc = $dbt->fetch_record($dbh,$pref_cc);
my $update_cc = {
table => "content",
int10 => "1",
mtime => "now()",
owner => "$owner",
};
$bw->log("APIxmlserver update to available",$update_cc,"");
$dbt->update_record($dbh,$update_cc,$record_cc) if($record_cc->{c_id});
}elsif(ref($xmlref) eq "HASH" && $xmlref->{todo} && $xmlref->{todo} eq "requested" && $xmlref->{bikeID} =~ /\d+/){
#<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
#<sharee_LastenVelo>
#<todo>requested</todo>
#<bikeID>17</bikeID>
#<userID>123456</userID>
#<emailID>mail@here.de</emailID>
#</sharee_LastenVelo>
}#end if(ref($xmlref)
else{
print "<text>Hossa, kein valides xml</text>";
}
}#end if($q->param('POSTDATA'))
else{
print "<text>NO DATA</text>";
}
return Apache2::Const::OK;
}
1;

61
copri4/main/src/Mod/Basework.pm Normal file
View file

@ -0,0 +1,61 @@
package Basework;
#
# SPDX-License-Identifier: AGPL-3.0-or-later
# Copyright (c) Rainer Gümpelein, TeilRad GmbH
#
use strict;
use warnings;
use POSIX;
use CGI; # only for debugging
use Lib::Config;
use Data::Dumper;
use Sys::Hostname;
my $hostname = hostname;
my $cf = new Config;
my $q = new CGI;
sub new {
my $class = shift;
my $self = {};
bless($self,$class);
return $self;
}
my $time = time;
my $now_dt = strftime "%Y-%m-%d %H:%M:%S", localtime;
my $now_date = strftime "%Y-%m-%d", localtime;
#logging
sub log {
my $self = shift;
my ($what,$message,$stdout) = @_;
#my ($package, $filename, $line) = caller;
my %varenv = $cf->envonline();
$now_dt = strftime "%Y-%m-%d %H:%M:%S", localtime;
my $logfile = "/var/log/copri4/$varenv{syshost}-process.log";
if($varenv{debug}){
warn "$what" . "\n" . Dumper($message) . "\n";#to apache2/error.log
#2021-07-21 disabled. error.log is enough
if(1==2){
open(FILE,">> $logfile");
print FILE "\n--- $now_dt $0 ---\n";
print FILE "$what" . "\n" . Dumper($message) . "\n";
close FILE;
}
#also to stdout
if($stdout){
#print "\n--- $now_dt $0 ---\n";
print "$what" . "\n" . Dumper($message) . "\n";
}
}
}
1;

781
copri4/main/src/Mod/Buttons.pm Normal file
View file

@ -0,0 +1,781 @@
package Buttons;
#
# SPDX-License-Identifier: AGPL-3.0-or-later
# Copyright (c) Rainer Gümpelein, TeilRad GmbH
#
#
use strict;
use warnings;
use Lib::Config;
use Data::Dumper;
sub new {
my $class = shift;
my $self = {};
bless($self,$class);
return $self;
}
my $cf = new Config;
my %varenv = $cf->envonline();
my $icon = "/icon";
#my standard internationalize submit buttons
sub ibuttons(){
my $self = shift;
my %ib = (
'service_done' => 'Wartungsprotokoll für ausgewähltes Rad einfügen/bearbeiten',
'post_email' => 'submit',
'barcode' => 'Barcode Label drucken',
'buchen' => 'buchen',
'send_invoice_again' => 'senden',
'order_state' => 'Auftragsstatus',
'new_contenttver' => 'Neues Arbeitsprofil',
'new_content' => 'NEUER Datensatz',
'new_content_2' => 'Add New Optical Instrument',
'new_adr' => 'Kunde anlegen',
'new_trans' => 'NEUE Transaktion',
'new_tver' => 'NEU',
'new_nel' => 'NEUE Nachricht',
'new_transdate' => 'NEUER Kalendereintrag',
'new_time' => 'NEUER Termin',
'new_dmsusers' => 'NEUER DMS Account',
'new_relation' => 'NEUES Menue anlegen',
'new_relation4sub' => 'NEUES Sub-Menue anlegen',
'save_content' => 'Speichern',
'save_tver' => 'Kurs speichern',
'save_nel' => 'Nachricht speichern',
'context_copy_content' => 'Kopie im Kontext der internen Barcode Nummer',
'copy_content' => 'Kopie fuer neuen Datensatz',
'move_relation' => 'Menue verschieben',
'move_content' => 'Datensatz in anderen Ordner verschieben',
'save_adr' => 'Kunden speichern',
'save_text' => 'Text speichern',
'save_dmsusers' => 'DMS Account speichern',
'save_relation' => 'Menue speichern',
'remove_chk4rel' => 'löschen',
'delete_content' => 'löschen',
'delete_adr' => 'Kunden löschen',
'delete_nel' => 'Nachricht löschen',
'newsletter_mailman' => 'Nachricht senden',
'delete_dmsusers' => 'DMS Account löschen',
'delete_trans' => 'löschen',
'delete_relation' => 'Menue löschen',
'save_pos' => 'Datensatz speichern',
'delete_pos' => 'Datensatz löschen',
'save_name' => 'Kunden speichern',
'search' => 'suchen',
'search_product' => 'Search',
'search_calendar' => 'anzeigen',
'search_export' => 'suchen /
auswerten',
'search_adr' => 'Kunden suchen',
'search_extrakt' => 'extrakt',
'change_login' => 'ID',
'print_pdf' => 'Print PDF',
'set_relation' => 'Formular',
'set_workflow' => 'Workflow',
'relate_content' => 'Content-Menu Relation',
'relate_dialog' => 'Relation herstellen',
'relate_dialog4menu' => 'Relation herstellen',
'save_media' => 'Foto speichern',
'delete_media' => 'Foto löschen',
'save_database' => 'Datenbank Sicherung',
'XLSout_contentadr' => 'XLS Export',
'more' => 'more',
'Login' => 'Login',
'login' => 'login'
);
return %ib;
}
my %ib = ibuttons();
#buttons for jvbasel
sub ibuttons_arch(){
my $self = shift;
my ($counter) = @_;
my %ib = (
'reload_search' => 'Reload',
'new_content_1' => 'NEU',
'new_content_2' => 'Objekt hinzufuegen',
'new_relation4sub' => 'Ordner hinzufuegen',
'new_relation4sub_collection' => 'Sammlung hinzufuegen',
'new_attrtpl_int' => 'Checkbox/Integer Datenfeld erzeugen',
'new_attrtpl_txt' => 'Text Datenfeld erzeugen',
'new_adr' => 'NEUE Adresse',
'move_dnd' => 'Objekt verschieben',
'relate_dnd' => 'Objekt verlinken',
'copy_dnd' => 'Objekt kopieren',
'remove_chk4rel' => 'Objekt löschen',
'remove_chk4rel_en' => 'Delete Content',
'save_content' => 'Objekt speichern',
'relate_dialog4menu' => 'Relation herstellen',
'save_content_en' => 'Save Content',
'save_attrtpl' => 'Eigenschaft speichern',
'remove_chk4attr' => 'Eigenschaft löschen',
'delete_content' => 'löschen',
'XLSout' => 'XLS Export',
'PDFout' => 'PDF Export',
'object' => 'Ansicht',
'list_view' => 'Ansicht',
'object_view' => 'Ansicht',
'search' => 'suchen',
'more' => 'more',
'Login' => 'Login',
'login' => 'login'
);
return %ib;
}
# Language Icons
sub langicon_pic(){
my $self = shift;
my ($script,$lang_name,$lang,$view) = @_;
if($script =~ /(\/src\/index\.pl)/){
$script = $1
}else{
$script = "/src";
}
my $icon = "$icon/$lang.gif";
my $lang_href = "$script/$lang/$view";
my $langicon = "<a title='$lang_name' href='$lang_href'><img src='$icon' border='0' width='18' height='12' alt='$lang_name' /></a>\n";
return $langicon;
}
sub langicon_txt(){
my $self = shift;
my ($script,$lang_name,$main_id,$lang,$view) = @_;
if($script =~ /(\/src\/index\.pl)/){
$script = $1
}else{
$script = "/src";
}
my $lang_href = "$script/$lang/$view";
my $langicon = "<a class='headnav' style='margin:1em 0 0 1em' title='$main_id' href='$lang_href'>$lang_name</a>\n";
return $langicon;
}
# Head Main Menue Button
sub head_button(){
my $self = shift;
my ($node_path,$node_name,$style) = @_;
my $button = "<div style='font-size:0.80em;float:left;$style'><a style='margin:0 0.5em;' class='linknav' href='$node_path'>$node_name</a></div>\n";
return $button;
}
# Top Main Menue Button
sub top_button(){
my $self = shift;
my ($node_path,$node_name,$main_id,$style) = @_;
my $txt_color;
$txt_color = "color: black;" if($style =~ /white/);
my $button = "<li><a style='$style $txt_color' title='' href='$node_path'>$node_name</a></li>\n";
return $button;
}
# a link for Top2
sub a_button(){
my $self = shift;
my ($node_path,$node_name,$main_id,$mstyle) = @_;
my $txt_color;
#$txt_color = "color: black;" if($mstyle =~ /white/);
my $button = "<a id='id_$main_id' style='$mstyle $txt_color' title='$main_id' href='$node_path'>$node_name</a>|\n";
#my $button = "<a id='id_$main_id' style='$style $txt_color' title='$main_id' href='javascript:mainbrowser(\"$node_path\")'>$node_name</a>|";
return $button;
}
#with mousevent
sub event_button(){
my $self = shift;
my ($node_path,$node_name,$main_id,$class,$style,$owner,$url,$icon,$icon_style) = @_;
my $debug = $main_id if($owner && $owner eq $varenv{superu_id});
my $image = "<img src='$icon' style='$icon_style' />" if($icon) || "";
my $button = "<li><a onmousedown='WhichButton(event,\"$url\");' class='$class' style='$style' title='$debug' href='$node_path'>$image $node_name</a></li>";
return $button;
}
sub event_button2(){
my $self = shift;
my ($node_path,$node,$class,$style,$owner,$url,$icon,$icon_style) = @_;
$node->{change} =~ s/\.\d.*//;
my $title = "($node->{change})";
$title .= " | main_id: $node->{main_id}" if($owner && $owner eq $varenv{superu_id});
my $image = "<img src='$icon' style='$icon_style' />" if($icon) || "";
my $button = "<li><a onmousedown='WhichButton(event,\"$url\");' class='$class' style='$style' title='$title' href='$node_path'>$image $node->{node_name}</a></li>";
return $button;
}
#just a without li
sub lo_button(){
my $self = shift;
my ($node_path,$node_name,$main_id,$class,$style,$owner,$script,$mtop,$mleft,$icon,$icon_style) = @_;
my $debug = $main_id if($owner && $owner eq $varenv{superu_id});
my $image = "<img src='$icon' style='$icon_style' />" if($icon) || "";
my $button;
if($script){
$button = "<a class='$class' style='$style' title='$debug' onclick='$script(\"$node_path\",\"$mtop\",\"$mleft\")'>$image $node_name</a>";
}else{
$button = "<a class='$class' style='$style' title='$debug' href='$node_path'>$image $node_name</a>";
}
return $button;
}
#with mousevent over/out
sub lo_button2(){
my $self = shift;
my ($node_path,$node_name,$node_name_int,$main_id,$class,$style,$owner) = @_;
my $debug = $main_id if($owner && $owner eq $varenv{superu_id});
my $button = "<a onmouseover=\"this.innerHTML = '$node_name_int'\" onmouseout=\"this.innerHTML = '$node_name'\" class='$class' style='$style' title='$debug' href='$node_path'>$node_name</a>";
return $button;
}
#mit li
sub lia_button(){
my $self = shift;
my ($node_path,$node_name,$main_id,$class,$style,$owner) = @_;
my $debug = $main_id if($owner && $owner eq $varenv{superu_id});
my $target = "_self";
$target = "_blank" if($node_path =~ /http/);
my $button = "<li><a class='$class' style='$style' title='$debug' href='$node_path' target='$target'>$node_name</a></li>\n";
return $button;
}
# select tag
sub selector_color() {
my $self = shift;
my $colname = shift;
my $style = shift;
my $value = shift;
my @selval = @_;
my @selopt = ();
foreach my $id (@selval) {
my $ostyle;
$ostyle = "background-color:$id" if($style =~ /background-color/);
if ($id eq $value) {
push @selopt, "<option style='$ostyle' selected value='$id'>$value</option>\n";
}
else {
push @selopt, "<option style='$ostyle' value='$id'>$id</option>\n";
}
}
my $selret;
if($style =~ /background-color/){
$selret = "<select style='$style;' onchange='this.style.backgroundColor = this.options[this.selectedIndex].style.backgroundColor;' name='$colname'>@selopt</select>\n";
}
return $selret;
}
# select tag
sub selector(){
my $self = shift;
my $tbl_columne = shift;
my $width = shift || "";
my $sel = shift || "";
my @selval = @_;
my @selopt = ();
foreach my $opt (@selval){
my $id = $opt;
my $value = $opt;
($id,$value) = split /:/,$opt if($opt =~ /\w+\:.*/);
if($sel eq $id){
push @selopt, "<option selected value=\"$id\">$value</option>\n";
}else{
push @selopt, "<option value=\"$id\">$value</option>\n";
}
}
my $selret = "<select class='eselect' style='width:$width' size=1 name='$tbl_columne' id='$tbl_columne'>@selopt</select>\n";
return $selret;
}
# select tag with class
sub selector_class(){
my $self = shift;
my ($column,$class,$style,$sel,@selval) = @_;
my @selopt = ();
foreach my $opt (@selval){
my $des_style = "";
my $id = $opt;
my $value = $opt;
($id,$value) = split /:/,$opt if($opt =~ /\:/);
$des_style = "color:grey;" if(!$id);
if("$sel" eq "$id"){
push @selopt, "<option style='$des_style' selected value='$id'>$value</option>\n";
}else{
push @selopt, "<option style='$des_style' value='$id'>$value</option>\n";
}
}
my $selret = "<select class='$class' style='$style' name='$column'>@selopt</select>\n";
return $selret;
}
# select tag by id and class onChange
sub selector_byidclass(){
my $self = shift;
my ($column,$byid,$class,$style,$sel,@selval) = @_;
my @selopt = ();
foreach my $opt (@selval){
my $id = $opt;
my $value = $opt;
($id,$value) = split /:/,$opt if($opt =~ /\w+\:.*/);
if("$sel" eq "$id"){
push @selopt, "<option selected value=\"$id\">$value</option>\n";
}else{
push @selopt, "<option value=\"$id\">$value</option>\n";
}
}
#my $selret = "<select id='$byid' class='$class' style='$style' name='$column' onChange='day_mod_save(this)'>@selopt</select>\n";
my $selret = "<select id='$byid' class='$class' style='$style' name='$column'>@selopt</select>\n";
return $selret;
}
# select onChange
sub userselector_onchange(){
my $self = shift;
my $key = shift;
my $selected = shift;
my $users_all = shift;
my $admin_name = shift || "";
my $class = shift || "";
my $style = shift || "";
my @selopt = ();
foreach my $c_id (sort { $users_all->{$a}->{txt08} cmp $users_all->{$b}->{txt08} } keys (%$users_all)){
#print $c_id . "|" . $users_all->{$c_id}->{txt08} . "\n";
$users_all->{$c_id}->{txt08} .= " (Ferien)" if($users_all->{$c_id}->{txt08} eq $admin_name);
if($selected eq $c_id){
push @selopt, "<option selected value='$c_id'>$users_all->{$c_id}->{txt08}</option>\n";
}else{
push @selopt, "<option value='$c_id'>$users_all->{$c_id}->{txt08}</option>\n";
}
}
my $selret = "<select class='$class' style='$style' name='$key' onChange='select_option(this)'>\n@selopt</select>\n";
return $selret;
}
# select2 tag
sub selector2(){
my $self = shift;
my $tbl_columne = shift;
my $width = shift;
my $height = shift;
my $sel = shift;
my @selval = @_;
my @selopt = ();
foreach my $opt (@selval){
my $id = $opt;
my $value = $opt;
($id,$value) = split /:/,$opt if($opt =~ /\d\:.*/);
#print "$sel eq $id || ($sel && $sel =~ /$id|$opt/<br>";
if($sel && $id && (("$sel" eq "$id") || ("$sel" =~ /$id|$opt/))){
push @selopt, "<option selected value=\"$id\">$value</option>\n";
}else{
push @selopt, "<option value=\"$id\">$value</option>\n";
}
}
my $selret = "<select multiple class=\"eselect_multiple\" style=\"width:$width\" size=$height name=\"$tbl_columne\" >@selopt</select>\n";
return $selret;
}
# select3 tag with id:value
sub selector3(){
my $self = shift;
my $tbl_columne = shift;
my $width = shift;
my $height = shift;
my $sel = shift;
my @selval = @_;
my @selopt = ();
foreach my $opt (@selval){
my $id = $opt;
my $value = $opt;
($id,$value) = split /:/,$opt if($opt =~ /\d\:.*/);
#print "$sel =~ /\w+/ && $sel =~ /$id|$value/)<br>";
if($sel && "$sel" =~ /$id|$value/){
push @selopt, "<option selected value=\"$id:$value,\">$value</option>\n";
}else{
push @selopt, "<option value=\"$id:$value,\">$value</option>\n";
}
}
my $multiple = "";
$multiple = "multiple" if($height > 1);
my $selret = "<select $multiple class=\"eselect_multiple\" style=\"width:$width\" size=$height name=\"$tbl_columne\" >\n@selopt</select>\n";
return $selret;
}
#with onchange event
sub selector_onchange(){
my $self = shift;
my $key = shift;
my $width = shift;
my $path = shift;
my $jscript = shift;
my $sel = shift;
my $todo = shift;
my @selval = @_;
my @selopt = ();
foreach my $opt (@selval){
my $id = $opt;
my $value = $opt;
($id,$value) = split /:/,$opt if($opt =~ /\d\:.*/);
my $rid = "$id";
$rid = "$path?change_login=$value" if($todo eq "change_login");
$rid = "$value?$path\&$key=$id" if($key =~ /set_main_id/);
if("$sel" eq "$id"){
push @selopt, "<option selected value=\"$rid\">$value</option>\n";
}else{
push @selopt, "<option value=\"$rid\">$value</option>\n";
}
}
my $selret = "<a><select class=\"eselect\" style=\"width:$width\" size=1 name=\"$key\" onChange=\"$jscript go2select(this)\">@selopt</select></a>\n";
return $selret;
}
sub checkbox_style() {
my $self = shift;
my ($sid_key,$dialog) = @_;
my $ck_style = "<style type='text/css'><!--
.sq_$dialog$sid_key {margin:auto;position: relative;width: 16px;height: 16px;}
.sq_$dialog$sid_key label {cursor: pointer;position: absolute;width: 16px;height: 16px;background-color:grey;}
.sq_$dialog$sid_key :checked + label {content: '';position: absolute;width: 16px;height: 16px;background-color: #333333;}
//--></style>\n";
return $ck_style;
}
#checkbox
sub checkbox(){
my $self = shift;
my ($val,$check_name,$checked,$title,$required) = @_;
$checked = "checked" if($checked);
$required = "required" if($required);
my $checkb = "<input type='checkbox' style='border: 1px solid silver;' name='$check_name' value='$val' title='$title' $checked $required>";
return $checkb;
}
#reverse checkbox
sub rev_checkbox(){
my $self = shift;
my ($val,$check_name,$checked,$title) = @_;
if(!$checked){
$checked = "checked";
}
my $checkb = "<input type='checkbox' style='border: 1px solid;' name='$check_name' value='$val' title='$title' $checked>";
return $checkb;
}
#radio (seems not working!!)
sub radiobox(){
my $self = shift;
my ($val,$check_name,$checked) = @_;
$checked = "checked" if($checked);
my $checkb = "<input type='radio' class='ebutton' name='$check_name' value='$val' $checked>";
return $checkb;
}
#radio
#$but->radiobox2("$key","$ctrel->{$key}","$a","$b","$c")
sub radiobox2(){
my $self = shift;
my ($key,$val,$a_name,$b_name,$c_name) = @_;
my $a_checked;
my $b_checked;
my $c_checked;
$a_checked = "checked" if(!$val);
$b_checked = "checked" if($val==1);
$c_checked = "checked" if($val==2);
my $checkb = "$a_name <input type='radio' name='$key' value='0' $a_checked> $b_name <input type='radio' name='$key' value='1' $b_checked>";
$checkb .= " $c_name <input type='radio' name='$key' value='2' $c_checked>" if($c_name);
return $checkb;
}
#radio reverse
sub radiobox2reverse(){
my $self = shift;
my ($key,$val,$a_name,$b_name) = @_;
my $a_checked;
my $b_checked;
$a_checked = "checked" if($val);
$b_checked = "checked" if(!$val);
my $checkb = "$a_name <input type='radio' name='$key' value='1' $a_checked> $b_name <input type='radio' name='$key' value='0' $b_checked>";
return $checkb;
}
#Returns one radiobox ... you need min two to get a radioboxe
sub radiobox_vertical(){
my $self = shift;
my ($key,$val,$checked,$boxname) = @_;
$checked = "checked" if($checked);
my $radiobox = "<label><input type='radio' name='$key' value='$val' $checked>$boxname</label>";
return $radiobox;
}
# Submit Buttons
sub singlesubmit(){
my $self = shift;
my ($function,$b_name,$jscript) = @_;
my $button;
if($jscript){
$button = "<input type='submit' onClick='javascript:$jscript' class='ebutton' name='$function' value='$b_name'>";
}else{
$button = "<input type='submit' class='ebutton' name='$function' value='$b_name'>";
}
return $button;
}
# Submit Buttons with db based button
sub singlesubmit10(){
my $self = shift;
my ($function,$b_val,$b_name) = @_;
my $button = "<button type='submit' class='ebutton' name='$function' value='$b_val'>$b_name</button>";
return $button;
}
# international hack. Vorsicht, aendert Parameter
sub singlesubmit1(){
my $self = shift;
my ($function,$b_name,$class,$style,$title) = @_;
$class = "ebutton" if(!$class);
my ($key,$val,$ibv);
while (($key,$val) = each(%ib)) {
$ibv = $val if($b_name eq $key);
}
my $button = "<input type='submit' class='$class' style='$style' name='$function' value='$ibv' title='$title'>";
return $button;
}
# with counter field
sub singlesubmit6(){
my $self = shift;
my ($function,$b_name,$counter) = @_;
%ib = &ibuttons("","$counter");
my ($key,$val,$ibv);
while (($key,$val) = each(%ib)) {
#print "$val if($b_name eq $key) <br>";
$ibv = $val if($b_name eq $key);
}
my $button = "<input type='submit' class='ebutton' name='$function' value='$ibv'>";
return $button;
}
# international hack
sub singlesubmit3(){
my $self = shift;
my ($function,$b_name,$b_img,$style,$title) = @_;
my ($key,$val,$ib_key,$ib_value);
#my %ib = ibuttons_arch();
my %ib = ibuttons();
while (($key,$val) = each(%ib)) {
if($b_name eq $key){
$ib_key = $key;
$ib_value = $val;
}
}
my $button = "<button class='ebutton2' style='cursor:default;height:17px;'></button>";
if("$b_name" =~ /delete/){
$button = "<button type='submit' onClick=\"return confirm('Wirklich löschen?')\" class='ebutton2' style='$style' name='$function' value='$ib_key'>$ib_value</button>";
}elsif($b_img){
$button = "<button type='submit' class='ebutton2' name='$function' value='$ib_key' title='$title' ><img src='$b_img' style='$style' /></button>";
}elsif($b_name){
$button = "<button type='submit' class='ebutton2' style='$style' name='$function' value='$ib_key'>$ib_value</button>";
}
return $button;
}
# without grafic
sub singlesubmit7(){
my $self = shift;
my ($function,$b_name,$title,$set_style,$jscript,$ebutton) = @_;
$ebutton = "ebutton" if(!$ebutton);
my ($b_img,$a_key);
$b_img = "Barcode" if("$b_name" =~ /barcode/);
$b_img = "Copy" if("$b_name" =~ /copy/);
$b_img = "Relate" if("$b_name" =~ /relate/);
$b_img = "Move" if("$b_name" =~ /move_/);
$b_img = "Delete" if("$b_name" =~ /delete|remove/);
$b_img = "Delete" if("$b_name" =~ /delete_media/);
$b_img = "Save" if("$b_name" =~ /save|service_done|_contenttverpos/);
$a_key = "y" if("$b_name" =~ /save/);
$b_img = "Save Texts" if("$b_name" =~ /save_text/);
$b_img = "Delete All" if("$b_name" =~ /delete_all/);
$b_img = "Search" if("$b_name" =~ /search/);
$b_img = "New" if("$b_name" =~ /^new/);
$b_img = "Open" if("$b_name" eq "open");
$b_img = "Close" if("$b_name" eq "close");
$b_img = "Print" if("$b_name" eq "print_sheet");
$b_img = "Change Login" if("$b_name" eq "change_login");
$b_img = "Senden" if("$b_name" =~ /send_newsletter/);
$b_img = "XLS Export" if("$b_name" =~ /XLSout/);
$b_img = "Save & Close" if("$b_name" =~ /_and_close/);
$b_img = "Save & Close & Print " if("$b_name" =~ /_print_and_close/);
$b_img = "Print" if("$b_name" =~ /_print_only/);
$b_img = "Kunde" if("$b_name" =~ /client/);
$b_img = "Artikel" if("$b_name" =~ /part/);
$b_img = "speichern & schließen" if("$b_name" =~ /save_tver_close/);
my $button = "<span style='width:25px;height=15px;'>&nbsp;</span>";
if($b_name){
if("$b_name" =~ /delete/){
$button = "<button type='submit' onClick=\"return confirm('Wirklich löschen?')\" class='$ebutton' style='$set_style' name='$function' value='$b_name' title='$title'>$b_img</button>";
}elsif($jscript){
$button = "<button type='submit' onClick='javascript:$jscript' class='$ebutton' style='$set_style' name='$function' value='$b_name' title='$title'>$b_img</button>";
}else{
$button = "<button type='submit' class='$ebutton' style='$set_style' name='$function' value='$b_name' title='$title' accesskey='$a_key'>$b_img</button>";
}
}
return $button;
}
#without submit
sub singlesubmit17(){
my $self = shift;
my ($function,$b_name,$title,$set_style,$jscript,$ebutton) = @_;
$ebutton = "ebutton" if(!$ebutton);
my ($b_img,$a_key);
$b_img = "Barcode" if("$b_name" =~ /barcode/);
$b_img = "Copy" if("$b_name" =~ /copy/);
$b_img = "Relate" if("$b_name" =~ /relate/);
$b_img = "Move" if("$b_name" =~ /move_/);
$b_img = "Delete" if("$b_name" =~ /delete|remove/);
$b_img = "Delete" if("$b_name" =~ /delete_media/);
$b_img = "Save" if("$b_name" =~ /save/);
$a_key = "y" if("$b_name" =~ /save/);
$b_img = "Save Texts" if("$b_name" =~ /save_text/);
$b_img = "Delete All" if("$b_name" =~ /delete_all/);
$b_img = "Search" if("$b_name" =~ /search/);
$b_img = "New" if("$b_name" =~ /^new/);
$b_img = "Open" if("$b_name" eq "open");
$b_img = "Close" if("$b_name" eq "close");
$b_img = "Print" if("$b_name" eq "print_sheet");
$b_img = "Change Login" if("$b_name" eq "change_login");
$b_img = "Senden" if("$b_name" =~ /send_newsletter/);
$b_img = "XLS Export" if("$b_name" =~ /XLSout/);
$b_img = "Save & Close" if("$b_name" =~ /_and_close/);
$b_img = "Save & Close & Print " if("$b_name" =~ /_print_and_close/);
$b_img = "Print" if("$b_name" =~ /_print_only/);
$b_img = "Kunde" if("$b_name" =~ /client/);
$b_img = "Artikel" if("$b_name" =~ /part/);
my $button = "<span style='width:25px;height=15px;'>&nbsp;</span>";
if($b_name){
$button = "<div onClick='javascript:$jscript' class='$ebutton' style='$set_style' name='$function' value='$b_name' title='$title'>$b_img</div>";
}
return $button;
}
# Grafic Submit Buttons
sub singlesubmit2glyph(){
my $self = shift;
my ($function,$b_name,$title,$set_style,$jscript) = @_;
my $b_img; my $a_key;
$b_img = "submit.png" if("$b_name" =~ /post_email/);
$b_img = "actions/view-barcode.png" if("$b_name" =~ /barcode/);
$b_img = "actions/edit-copy.png" if("$b_name" =~ /copy|relate/);
$b_img = "actions/edit-paste.png" if("$b_name" =~ /move_/);
$b_img = "glyphicons/glyphicons-151-edit.png" if("$b_name" =~ /delete|remove/);
$b_img = "actions/edit-delete.png" if("$b_name" =~ /delete_media/);
$b_img = "actions/document-save.png" if("$b_name" =~ /save/);
$a_key = "y" if("$b_name" =~ /save/);
$b_img = "edittrash.png" if("$b_name" =~ /delete_all/);
$b_img = "search.png" if("$b_name" =~ /search/);
$b_img = "glyphicons/glyphicons-151-edit.png" if("$b_name" =~ /_done|_contenttverpos/);
$b_img = "glyphicons/glyphicons-703-file-plus.png" if("$b_name" =~ /new/);
$b_img = "glyphicons/glyphicons-151-edit.png" if("$b_name" =~ /open|client/);
$b_img = "fileclose.png" if("$b_name" eq "close");
$b_img = "actions/view-media-artist.png" if("$b_name" eq "change_login");
my $button = "<span style='width:25px;height=15px;'>&nbsp;</span>";
if($b_name){
if("$b_name" =~ /delete/ && "$b_name" !~ /delete_verposdate/){
if($jscript){
$button = "<button type='submit' onClick=\"javascript:$jscript; return confirm('Wirklich löschen?')\" style='width:25px;height=15px; border: 0px solid;$set_style' name='$function' value='$b_name' title='$title'><img src='$varenv{metahost}/$b_img' style='height:18px;' /></button>";
}else{
$button = "<button type='submit' onClick=\"return confirm('Wirklich löschen?')\" style='width:25px;height=15px; border: 0px solid;$set_style' name='$function' value='$b_name' title='$title'><img src='$varenv{metahost}/$b_img' style='height:18px;' /></button>";
}
}else{
$button = "<button type='submit' style='border: 0px solid;$set_style' name='$function' value='$b_name' title='$title' accesskey='$a_key'><img src='$varenv{metahost}/$b_img' style='height:18px;' /></button>";
}
}
return $button;
}
# Grafic Submit Buttons
sub singlesubmit2(){
my $self = shift;
my ($function,$b_name,$title,$set_style,$jscript) = @_;
my $b_img; my $a_key;
$b_img = "submit.png" if("$b_name" =~ /post_email/);
$b_img = "actions/view-barcode.png" if("$b_name" =~ /barcode/);
$b_img = "actions/edit-copy.png" if("$b_name" =~ /copy|relate/);
$b_img = "actions/edit-paste.png" if("$b_name" =~ /move_/);
$b_img = "actions/archive-remove.png" if("$b_name" =~ /delete|remove/);
$b_img = "actions/edit-delete.png" if("$b_name" =~ /delete_media/);
$b_img = "actions/document-save.png" if("$b_name" =~ /save/);
$a_key = "y" if("$b_name" =~ /save/);
$b_img = "edittrash.png" if("$b_name" =~ /delete_all/);
$b_img = "search.png" if("$b_name" =~ /search/);
$b_img = "actions/document-new.png" if("$b_name" =~ /new/);
$b_img = "actions/document-properties.png" if("$b_name" =~ /open|client/);
$b_img = "fileclose.png" if("$b_name" eq "close");
$b_img = "actions/view-media-artist.png" if("$b_name" eq "change_login");
my $button = "<span style='width:25px;height=15px;'>&nbsp;</span>";
if($b_name){
if("$b_name" =~ /delete/ && "$b_name" !~ /delete_verposdate/){
if($jscript){
$button = "<button type='submit' onClick=\"javascript:$jscript; return confirm('Wirklich löschen?')\" style='width:25px;height=15px; border: 0px solid;$set_style' name='$function' value='$b_name' title='$title'><img src='$varenv{metahost}/img/$b_img' style='height:18px;' /></button>";
}else{
$button = "<button type='submit' onClick=\"return confirm('Wirklich löschen?')\" style='width:25px;height=15px; border: 0px solid;$set_style' name='$function' value='$b_name' title='$title'><img src='$varenv{metahost}/img/$b_img' style='height:18px;' /></button>";
}
}else{
$button = "<button type='submit' style='width:25px;height=15px; border: 0px solid;$set_style' name='$function' value='$b_name' title='$title' accesskey='$a_key'><img src='$varenv{metahost}/img/$b_img' style='height:18px;' /></button>";
}
}
return $button;
}
#with onclick
sub singlesubmit4(){
my $self = shift;
my ($function,$b_name,$title,$jscript,$url) = @_;
my $b_img;
$b_img = "search.png";# if("$title" =~ /suchen/);
my $button = "<input type='image' src='/img/$b_img' class='ebutton2' name='$function' value='$b_name' onClick='javascript:$jscript()' title='$title'>";
return $button;
}
#with onclick
sub singlesubmit5(){
my $self = shift;
my ($function,$b_name,$jscript,$url) = @_;
my ($key,$val,$ibv);
while (($key,$val) = each(%ib)) {
$ibv = $val if($b_name eq $key);
}
my $button = "<input type='submit' class='ebutton' name='$function' value='$ibv' onClick='javascript:$jscript(this.form,\"$url\")'>";
return $button;
}
#with onclick script
sub singlesubmit9(){
my $self = shift;
my ($function,$b_name,$main_id,$class,$style,$owner) = @_;
my $debug = $main_id if($owner && $owner eq $varenv{superu_id});
my $button = "<input type='button' class='$class' style='$style' name='$function' value='$b_name' title='$debug' onclick='javascript:history.back()'>\n";
return $button;
}
sub singlesubmit8(){
my $self = shift;
my ($function,$b_name,$jscript,$url) = @_;
my $button = "<button type='submit' onClick='javascript:$jscript' class='ebutton' name='$function' value='$b_name'>$b_name</button>";
return $button;
}
1;

217
copri4/main/src/Mod/Callib.pm Normal file
View file

@ -0,0 +1,217 @@
package Callib;
#
# SPDX-License-Identifier: AGPL-3.0-or-later
# Copyright (c) Rainer Gümpelein, TeilRad GmbH
#
use strict;
use warnings;
use POSIX;
use DBI;
use CGI; # only for debugging
#Deb libcalendar-simple-perl
use Calendar::Simple;
use Date::Calc qw(:all);
use Scalar::Util qw(looks_like_number);
use Mod::Buttons;
use Lib::Config;
use Mod::Basework;
my $cf = new Config;
my $but = new Buttons;
my $bw = new Basework;
my $q = new CGI;
$q->import_names('R');
sub new {
my $class = shift;
my $self = {};
bless( $self, $class );
return $self;
}
my %varenv = $cf->envonline();
my $now_time = strftime "%Y-%m-%d %H:%M", localtime;
my $day = strftime "%d", localtime;
my $mon = strftime "%m", localtime;
my $year = strftime "%Y", localtime;
#start- end- date time
sub datetime_defaults(){
my $self = shift;
my ($in_date,$in_time,$lang) = @_;
my $now_date_time = strftime "%Y-%m-%d %H:%M", localtime;
my $now_date = strftime "%Y-%m-%d", localtime;
my $now_time = strftime "%H:%M", localtime;
if($in_date =~ /(\d{4})-(\d+)-(\d+)/){
$now_date = "$1-$2-$3";
}elsif($in_date =~ /(\d+)\.(\d+)\.(\d+)/){
$now_date = "$3-$2-$1";
}
my ( $year, $month, $day ) = split( /-/, $now_date );
my ($nyear,$nmonth,$nday) = Add_Delta_YMD($year,$month,$day, 0,0,1);
$nday = "0" . $nday if ( $nday < 10 );
$nmonth = "0" . $nmonth if ( $nmonth < 10 );
my $start_datetime = "$year-$month-$day";
my $end_datetime = "$nyear-$nmonth-$nday";
$start_datetime = "$day.$month.$year" if(lc($lang) eq "de");
$end_datetime = "$nday.$nmonth.$nyear" if(lc($lang) eq "de");
$start_datetime .= " $now_time" if(!$in_time);
$end_datetime .= " $now_time" if(!$in_time);
return ($start_datetime,$end_datetime);
}
#month map
sub monthmap(){
my @_months = ("Januar","Februar","März","April","Mai","Juni","Juli","August","September","Oktober","November","Dezember");
return @_months;
}
#day map
sub daymap(){
my @_days = ("So","Mo","Di","Mi","Do","Fr","Sa");
return @_days;
}
#hour map
sub hourmap(){
my @_hours = (
"00:00", "01:00", "02:00", "03:00", "04:00", "05:00",
"06:00", "07:00", "08:00", "09:00", "10:00", "11:00",
"12:00", "13:00", "14:00", "15:00", "16:00", "17:00",
"18:00", "19:00", "20:00", "21:00", "22:00", "23:00"
);
return @_hours;
}
#english input date_time check
sub checkdate_time() {
my $self = shift;
my $date_time = shift;
$date_time =~ s/:\d{2}\..*$//;
my $date = $date_time;
my $time = "00:00:00";
($date, $time) = split(/ /, $date_time) if($date_time =~ /\d+\s\d+/);
my ( $y, $m, $d ) = split( /-/, $date );
my ( $hour, $min, $sec ) = split( /\:/, $time );
my $check_time = 1;
$check_time = 0 if(looks_like_number($hour) && $hour > 24);
$check_time = 0 if(looks_like_number($min) && $min > 60);
$check_time = 0 if(looks_like_number($sec) && $sec > 60);
#print "$y, $m, $d && $check_time";
if ( check_date( $y, $m, $d ) && $check_time) {
return $date_time;
}else{
return 0;
}
}
# input date check
sub checkdate() {
my $self = shift;
my ( $date, $time ) = @_;
my $d_chck = 1;
$date =~ s/,/-/g;
$date =~ s/\./-/g;
my ( $y, $m, $d ) = split( /-/, $date );
if ( check_date( $y, $m, $d ) ) {
return "$y-$m-$d";
}
else {
return "$year-$mon-$day";
}
}
#split date
sub split_date(){
my $self = shift;
my ($time_db) = @_;
$time_db =~ s/:\d{2}\..*$// if($time_db);
my ($date,$time) = split(/ /,$time_db);
my ($yy,$mo,$dd) = split(/-/,$date) if($date =~ /-/);
my ($hh,$mi) = split(/\:/,$time);
return ($yy,$mo,$dd,$hh,$mi);
}
#time and date format for DE
sub time4de(){
my $self = shift;
my ($time_db,$hhmi,$decode) = @_;
$time_db =~ s/:\d{2}\..*$// if($time_db);
my ($date,$time) = split(/ /,$time_db);
my ($yy,$mo,$dd) = split(/-/,$date);
my ($hh,$mi) = split(/\:/,$time);
my $date_de = "&nbsp;";
$date_de = "$dd.$mo.$yy";
$date_de = "$dd.$mo.$yy $hh:$mi" if($hhmi);
#Deutsch (German) ==> 3
$date_de = Date_to_Text_Long($yy,$mo,$dd,3) if($decode eq "Date_to_Text_Long");
$date_de =~ s/M.*rz/März/;
return $date_de;
}
#Prepares contenttranspos start_time, end_time and count/Menge
sub contenttranspos_dating() {
my $self = shift;
my ($pos_id,$pos_start_time,$pos_end_time,$today4db,$hours,$ctt_start,$ctt_end,$owner) = @_;
my $menge = 0;
my $s_up;
my $e_up;
$bw->log("sub contenttranspos_dating call from Callib:",\@_,"");
my $start_datetime = $today4db;
my $end_datetime = $today4db;
$start_datetime = "$1-$2-$3 $4:$5" if($pos_start_time =~ /(\d{4})-(\d{2})-(\d{2})\s(\d{2}):(\d{2})/);
$start_datetime = "$3-$2-$1 $4:$5" if($pos_start_time =~ /(\d{2})\.(\d{2})\.(\d{4})\s(\d{2}):(\d{2})/);
$end_datetime = "$1-$2-$3 $4:$5" if($pos_end_time =~ /(\d{4})-(\d{2})-(\d{2})\s(\d{2}):(\d{2})/);
$end_datetime = "$3-$2-$1 $4:$5" if($pos_end_time =~ /(\d{2})\.(\d{2})\.(\d{4})\s(\d{2}):(\d{2})/);
if($start_datetime && $end_datetime){
my ($s_yy,$s_mo,$s_dd,$s_hh,$s_mi) = &split_date("",$start_datetime);
my $s_time = Mktime($s_yy,$s_mo,$s_dd,$s_hh,$s_mi,0);
my ($e_yy,$e_mo,$e_dd,$e_hh,$e_mi) = &split_date("",$end_datetime);
#Add 1hour and rebuild end_datetime
my $sec=0;
($e_yy,$e_mo,$e_dd,$e_hh,$e_mi,$sec) = Add_Delta_DHMS($e_yy,$e_mo,$e_dd,$e_hh,$e_mi,0, 0,$hours,0,0) if($hours =~ /^\d+$/);
my $e_time = Mktime($e_yy,$e_mo,$e_dd,$e_hh,$e_mi,0);
$end_datetime = "$e_yy-$e_mo-$e_dd $e_hh:$e_mi";
#$menge not used via Transposition and at last Prelogic.pm,
#we believe setting by manually insert of int03=$menge
if(1==1){
#Count Menge in hours
my $diff_time = $e_time - $s_time;
$menge = $diff_time / 3600;#to get hours
#$menge = $lb->round($menge);
my $s_cttime;
my $e_cttime;
if($ctt_start && $ctt_end){
my ($s_yy,$s_mo,$s_dd,$s_hh,$s_mi) = &split_date("",$ctt_start);
my ($e_yy,$e_mo,$e_dd,$e_hh,$e_mi) = &split_date("",$ctt_end);
$s_cttime = Mktime($s_yy,$s_mo,$s_dd,$s_hh,$s_mi,0);
$e_cttime = Mktime($e_yy,$e_mo,$e_dd,$e_hh,$e_mi,0);
}
#Never used calc of min max time
$s_up = 1 if(!$s_cttime || $s_time < $s_cttime);
$e_up = 1 if(!$e_cttime || $e_time > $e_cttime);
}
}
my @return_array = ($pos_id,$start_datetime,$end_datetime,$s_up,$e_up,$menge);
$bw->log("sub contenttranspos_dating return from Callib:",\@return_array,"");
return ($start_datetime,$end_datetime,$s_up,$e_up,$menge);
}
1;

1298
copri4/main/src/Mod/DBtank.pm Normal file
View file

File diff suppressed because it is too large Load diff

96
copri4/main/src/Mod/Failure.pm Normal file
View file

@ -0,0 +1,96 @@
package Failure;
#
#
# SPDX-License-Identifier: AGPL-3.0-or-later
# Copyright (c) Rainer Gümpelein, TeilRad GmbH
#
use strict;
use warnings;
use CGI::Carp qw(fatalsToBrowser);
use CGI ':standard';
use Lib::Config;
use Mod::Buttons;
use Mod::Libenz;
use Mod::Libenzdb;
sub new {
my $class = shift;
my $self = {};
bless($self,$class);
return $self;
}
#Template
sub tpl(){
my ($main_id,$u_id,$lang,$bg_color1,$bg_color2,$level,$failure) = @_;
my $q = new CGI;
my $cf = new Config;
my $lb = new Libenz;
my $db = new Libenzdb;
my $but = new Buttons;
my %varenv = $cf->envonline();
my $path = $q->path_info();
$path =~ s/\/user|\/manager|\/admin//;
my $script = $q->script_name();
my %ib = $but->ibuttons();
$failure =~ s/failure:://g;
my ($link,$lname,$link2,$lname2);
($failure,$link,$lname,$link2,$lname2) = split(/::/,$failure);
my $width="600";
my $height="300";
#my $bg_color = $varenv{background_color} || "white";
#my $bg_color2 = $varenv{background_color2} || "";
if($failure =~ /Newsletter Versandt/){
$width="600";
$height="700";
}
print<<EOF
<style>
.ui-dialog .ui-dialog-content {
background: $bg_color1;
}
.ui-dialog > .ui-widget-header {
color:red;
font-weight:normal;
border:1px solid $bg_color2;
background: $bg_color2;
}
</style>
<script>
\$(function() {
\$( "#dialog-failure" )
.css("background-color","$bg_color1")
.dialog({
height: $height,
width: $width,
closeOnEscape: true,
modal: true
});
});
</script>
EOF
;
my $title = "Achtung";
my $back = "zurück";
my $font_size = "";
print "<div id='dialog-failure' style='$font_size;text-align:left;margin:auto;max-width:600px;' title='$title'>";
print "<div style='padding:1em;background-color:white;'>\n";
print $q->div("$failure");
print "<style>.linknav2 { margin:3px; padding:1px 20px; border: 1px solid $bg_color2; background-color: $bg_color2; font-size:13px; text-decoration: none; } .linknav2:hover { color:#464433;}</style>\n";
print $q->div({-style=>'float:left;padding:1em;'}, $q->a({-class=>"linknav2",-href=>"$link",-title=>''}, " $lname ")) if($lname);
print $q->div({-style=>'float:left;padding:1em;'}, $q->a({-class=>"linknav2",-href=>"$link2",-title=>''}, " $lname2 ")) if($lname2);
print $q->div({-style=>'float:left;padding:1em;'},$q->a({-class=>"linknav2",-href=>'javascript:history.back()'}, " $back "));
print "</div>\n";
print "</div>";
}
1;

44
copri4/main/src/Mod/FileOut.pm Normal file
View file

@ -0,0 +1,44 @@
package Mod::FileOut;
#
# SPDX-License-Identifier: AGPL-3.0-or-later
# Copyright (c) Rainer Gümpelein, TeilRad GmbH
#
use strict;
use warnings FATAL => 'all';
use CGI::Cookie ();
use CGI ':standard';
use Apache2::RequestUtil ();
use Apache2::RequestIO ();
use Apache2::Const -compile => qw(OK);
use File::Path qw(make_path remove_tree);
use File::Copy;
use File::Copy::Recursive qw(fcopy rcopy dircopy fmove rmove dirmove);
use Lib::Config;
sub handler {
my $r = shift;
my $q = new CGI();
my $coo = $q->cookie(-name=>'domcookie') || $q->param('sessionid') || 'zvzfcxd578';
my $cf = new Config;
my %varenv = $cf->envonline();
my $filesuff = $q->param('file');
my $dir = $varenv{data};
$dir = $varenv{pdfinvoice} if($varenv{pdfinvoice});
rcopy("$dir/$filesuff","$varenv{basedir}/cache/$coo/$filesuff");
print $q->redirect(-uri=>"$varenv{metahost}/cache/$coo/$filesuff", -type=>"application/octet-stream");
#remove_tree("$varenv{basedir}/cache/$coo");
#
#my $file = $varenv{data} . "/" . $filesuff;
#my $status = $r->sendfile($file);
return Apache2::Const::OK;
}
1;

812
copri4/main/src/Mod/Indexsharee.pm Normal file
View file

@ -0,0 +1,812 @@
package Mod::Indexsharee;
#
# SPDX-License-Identifier: AGPL-3.0-or-later
# Copyright (c) Rainer Gümpelein, TeilRad GmbH
#
#
use strict;
use warnings;
use POSIX;
use CGI::Cookie ();
use CGI ':standard';
use DateTime;
use DateTime::Format::Pg;
use DBI;
use Apache2::RequestUtil ();
use Apache2::RequestIO ();
use Apache2::Const -compile => qw(OK);
use LWP::UserAgent;
use Digest::MD5 qw(md5 md5_hex);
#use Encode;
#use URI::Encode qw(uri_encode uri_decode);
use Lib::Config;
use Mod::Buttons;
use Mod::Prelogic;
use Lib::Mlogic;
use Mod::Basework;
use Mod::Premain;
use Mod::DBtank;
use Mod::Libenzdb;
use Mod::APIfunc;
use Mod::Shareework;
use Mod::Prelib;
use Mod::Payment;
use Mod::Modalbox;
use Mod::Modalbox3;
use Data::Dumper;
sub handler {
my $re = shift;
my $q = new CGI();
$q->import_names('R');
my $cf = new Config;
my $ml = new Mlogic;
my $bw = new Basework;
my $pre = new Prelogic;
my $pm = new Premain;
my $tk = new Shareework;
my $dbt = new DBtank;
my $db = new Libenzdb;
my $apif = new APIfunc;
my $but = new Buttons;
my $pl = new Prelib;
my $payone = new Payment;
my %varenv = $cf->envonline();
my $netloc = $q->url(-base=>1);
#main datadir is main config directive like "shareeapp-kn" and catched by syshost name
if($netloc =~ /:\/\/(sharee\w+-\w+)\.copri/){
#$bw->log("Indexsharee merchant select by netloc:",$netloc,"");
$varenv{syshost} = $1 if( -d "/var/www/copri4/$1");
}
die "no configuration available" if(!$varenv{syshost});
my $dbh = "";
my $script = $q->script_name();
my $path = $q->path_info();
$path = "$script" . "$path";
my $refer = $ENV{HTTP_REFERER};
my $now_dt = strftime "%Y-%m-%d %H:%M:%S", localtime;
my $return = "";
my $returnwww = "";
my $html_charset = "utf-8";
my $user_agent = $q->user_agent();
$path =~ s/\.html//;
#$mode is used to set GUI features like "maintainer" contextmenue
my $modes = $dbt->{shareedms_conf}->{modes};
my $mode = "";
if($R::mode && length($R::mode) >= 5 && $R::mode =~ /($modes)/){
$mode = "$R::mode";
}elsif($path && $path =~ /\/($modes)$/){
$mode = $1;
}elsif($path && $path =~ /\/($modes)\?\w/){
$mode = $1;
}
my $aowner = 197;#user agent access_owner --> Web Formular
$varenv{merchant_id} = "niejeiC7iu";#2021-12-08 merchant fallback
if($varenv{syshost} =~ /shareedms-/){
$aowner = 196;
$varenv{merchant_id} = "Ohmeew0gie";
$mode = "manager" if(!$mode);
}
if($varenv{orga} ne "dms" && $path =~ /DMS|Waren|Kunden\/|Einstellung|journal|Faktur/i){
print redirect("$varenv{wwwhost}");
exit 0;
}
my $lang = "de";
my $dyn_js = "";
my $users_dms = {};
my $users_sharee = {};
my $api_return = {};
print $q->header(-charset=>"$html_charset");
my $coo = $q->cookie('domcookie') || $R::sessionid || "";
#Prio sessionid if also domcookie is set ... and s.u.
if($R::sessionid && $R::sessionid ne $q->cookie('domcookie')){
$coo = $q->param('sessionid');
my $cookie = CGI::Cookie->new(-name => 'domcookie',-value => $coo);
print $q->header(-charset=>"$html_charset", -cookie=>$cookie);
}
($api_return,$users_sharee) = $apif->auth_verify($q,$coo,"");
my $merchanized = 0;
my $merchant_conf = "";
#merchant select by user_agent -> disabled
#while (($merchant_conf, my $value) = each %{ $dbt->{merchant_ids}}) {
# if($merchant_conf && $value->{user_agent} && $user_agent && $user_agent =~ /$value->{user_agent}/){
# $aowner = $value->{id};
# $varenv{merchant_id} = $merchant_conf;
# $merchanized = 1;
# $bw->log("Indexsharee merchant select by user_agent: if($merchant_conf && $value->{user_agent} && $user_agent && $user_agent =~ /$value->{user_agent}/){",$varenv{merchant_id},"");
# last;
# }
#}
if(!$merchanized){
while (($merchant_conf, my $value) = each %{ $dbt->{merchant_ids}}) {
if($merchant_conf && (($coo && $coo =~ /$merchant_conf$/) || ($R::sessionid && $R::sessionid =~ /$merchant_conf$/) || ($R::authcookie && $R::authcookie =~ /$merchant_conf$/) || ($R::merchant_id && $R::merchant_id eq $merchant_conf))){
$aowner = $value->{id};
$varenv{merchant_id} = $merchant_conf;
$merchanized = 1;
$bw->log("Indexsharee merchant select by authcookie OR merchant_id: if($merchant_conf && (($R::sessionid && $R::sessionid =~ /$merchant_conf$/) || ($R::authcookie && $R::authcookie =~ /$merchant_conf$/) || ($R::merchant_id && $R::merchant_id eq $merchant_conf))){",$merchant_conf,"");
last;
}
}
}
if(!$merchanized){
if($varenv{syshost} eq "shareeapp-primary"){
$aowner = $dbt->{primary}->{sharee_primary}->{owner};
$varenv{merchant_id} = $dbt->{primary}->{sharee_primary}->{merchant_id};
$merchanized = 1;
$bw->log("Indexsharee merchant select by $varenv{syshost} eq 'shareeapp-primary':",$varenv{merchant_id},"");
}
if($varenv{syshost} =~ /shareeweb-/){
$aowner = $dbt->{website}->{$varenv{syshost}}->{owner};
$varenv{merchant_id} = $dbt->{website}->{$varenv{syshost}}->{merchant_id};
$merchanized = 1;
$bw->log("Indexsharee merchant select by syshost=$varenv{syshost}:",$varenv{merchant_id},"");
}
}
$bw->log("Indexsharee merchant select used with access_owner $aowner",$varenv{merchant_id},"");
#login-screen should only be available if auth_verify fails
if($R::login_sharee || $R::login_dms){
#1. logout
$apif->authout($q,$coo);
my $hw_id = unpack ('H*', pack('Nc', time, $$ % 0xff));#old $co
#3. authorize
my $author = $apif->authorization($q,$varenv{merchant_id},$hw_id,$aowner);#$co like browser hw_id
#4. verify and get user values
($api_return,$users_sharee) = $apif->auth_verify($q,$author->{authcookie},"",$author->{new_authcoo});
#5. domcookie by authcookie substr (cut first 15 chars), AND also sessionid
if($author->{authcookie} && length($author->{authcookie}) > 30){
# take last 21 chars
$coo = substr $author->{authcookie}, 15;
my $cookie = CGI::Cookie->new(-name => 'domcookie',-value => $coo);
print $q->header(-charset=>"$html_charset", -cookie=>$cookie);
#DMS login
if($users_sharee->{c_id} && $varenv{orga} eq "dms" && $R::login_dms eq "Login" && $coo && length($coo) > 20){
$users_dms = $dbt->select_users($dbh,$users_sharee->{c_id});
my $update_users = {
table => "users",
owner => $aowner,
u_id => $users_dms->{u_id}
};
$dbt->update_one($dbh,$update_users,"cookie='$coo'") if($users_dms->{u_id});
print redirect("$varenv{wwwhost}$path");
exit 0;
}
}
}
my $session="";
my $session_and="";
if(length($coo) > 20 && !$q->cookie(-name=>'domcookie')){
$session = "?sessionid=$coo";
$session_and = "&sessionid=$coo";
}
#DMS
if($users_sharee->{c_id} && $varenv{orga} eq "dms" && $coo && length($coo) > 20){
$users_dms = $dbt->select_users($dbh,$users_sharee->{c_id},"and cookie='$coo'");
}
#Save anyway on create ... and hopefully delete it later
if($R::sharee_edit && $R::sharee_edit =~ /create_account/ && $R::txt04 && $R::txt04 =~ /\w+/ && $R::txt08 && $R::txt08 =~ /\w+\@\w+/){
#1. logout
$apif->authout($q,$coo);
#create_account. 2. inserts contentadr
my $tinkc_id = $tk->create_account($aowner);
($returnwww,$return) = $tk->save_account($tinkc_id,"",$aowner);
#Like login_sharee, redundant
my $hw_id = unpack ('H*', pack('Nc', time, $$ % 0xff));#old $co
#3. authorize
my $author = $apif->authorization($q,$varenv{merchant_id},$hw_id,$aowner);#$co like browser hw_id
#print "3. authorize: " . $author->{authcookie} . " -- " . $q->param('authcookie') . " ++ " . $coo . "<br>";
#4. verify and get user values
($api_return,$users_sharee) = $apif->auth_verify($q,$author->{authcookie},"",$author->{new_authcoo});
#print "4. verifyize: " . $author->{authcookie} . " -- c_id: " . $users_sharee->{c_id} . " ++ " . $coo . "<br>";
#5. domcookie by authcookie substr (cut first 15 chars), AND also sessionid
if($author->{authcookie} && length($author->{authcookie}) > 30){
# take last 21 chars
$coo = substr $author->{authcookie}, 15;
my $cookie = CGI::Cookie->new(-name => 'domcookie',-value => $coo);
print $q->header(-charset=>"$html_charset", -cookie=>$cookie);
#print "5. set cookie: " . $author->{authcookie} . " -- " . $q->param('authcookie') . " ++ " . $coo . "<br>";
#2020-07-09 if user-pw authorized, then ignore conflict_ because it matches exist user-data
if($tinkc_id && $returnwww && $returnwww =~ /conflict_txt07|conflict_txt08/){
#delete user-pw conflict registration and going on with existing data
$db->delete_content("contentadr",$tinkc_id);
$apif->authout($q,$coo) if($coo);
print redirect("$varenv{wwwhost}/$varenv{mandant}/Anmelden?conflict_failure=1");
exit 0;
}
elsif(length($coo) > 20){
#we need this to get $R::sessionid to FormEdit
#if(length($coo) > 20 && !$q->cookie(-name=>'domcookie')){
($api_return,$users_sharee) = $apif->auth_verify($q,$author->{authcookie},"");
if($R::failure =~ /\w+/ || ($users_sharee->{txt31} && $users_sharee->{txt31} =~ /\w/)){
print redirect("$varenv{wwwhost}/$varenv{mandant}/Account/$varenv{accounting_1}?sessionid=$coo");
exit 0;
}else{
print redirect("$varenv{wwwhost}/$varenv{mandant}/Account/$varenv{accounting_1_5}?sessionid=$coo");
exit 0;
}
}
}
}
my $payable_check=0;
if($users_sharee->{int03} && $users_sharee->{ct_name} && ($users_sharee->{int03} == 1 && $users_sharee->{ct_name} =~ /\w{2}-\d+/) || ($users_sharee->{int03} == 2 && length($users_sharee->{ct_name}) >= 19)){
$payable_check=1;
}
# Logout
if($mode =~ /logout/){
if($mode =~ /logout_sharee/){
$apif->authout($q,$coo);
}else{
$db->cook_out($coo);
}
print redirect("$varenv{wwwhost}");
exit 0;
}
my $tpl = $dbt->get_tpl($dbh,"302001");#Kundendaten template
$tpl->{tpl_order} .= ",txt04,txt08";
if($R::login_sharee){
if($users_sharee->{c_id} && (($users_sharee->{int03} != 1 && $users_sharee->{int03} != 2)|| ($users_sharee->{txt31} && $tpl->{tpl_order} =~ /$users_sharee->{txt31}/))){
my $row = $db->updater("contentadr","c_id","$users_sharee->{c_id}","int12","1");#Vde
print redirect("$varenv{wwwhost}/$varenv{mandant}/Account/$varenv{accounting_1}$session");
exit 0;
}elsif($users_sharee->{c_id} && !$payable_check){
#print redirect("$varenv{wwwhost}/$varenv{mandant}/$varenv{profile}");
#print redirect("$varenv{wwwhost}/$varenv{mandant}/$varenv{start}");
print redirect("$varenv{wwwhost}/$varenv{mandant}/Account/$varenv{accounting_2}$session");
exit 0;
}elsif(!$users_sharee->{c_id} || ($users_sharee->{c_id} && $users_sharee->{c_id} !~ /^\d+$/)){
print redirect("$varenv{wwwhost}/$varenv{mandant}/Anmelden?failure=1$session_and");
exit 0;
}else{
print redirect("$varenv{wwwhost}/$varenv{mandant}/$varenv{profile}$session");
exit 0;
}
}
my $oncontextmenu="";
$oncontextmenu="return false;";# if($mode =~ /maintainer/);
$oncontextmenu="" if(!$users_dms->{u_id});
#Menu & node_path handling
my ($view,$view_post);
my @viewsel = ("shareestart");
if($path =~ /^\/(.*)/){
@viewsel = split /\//,$1;
if("$path" =~ /\/($modes)$/){
pop @viewsel;
}
$view_post = $viewsel[-1] || "root";
#$view_post = encode('iso-8859-1',decode('utf-8', $view_post));
$view = $viewsel[0];
}
my $depth = scalar(@viewsel);
$view = "root" if(!$view);
my $node_meta = $dbt->get_node_meta($dbh,\@viewsel);
#DMS & Tools
if($varenv{orga} eq "dms" && $users_dms->{u_id}){
if($R::cal_delta_start){
use Date::Calc qw(Add_Delta_YMD);
my $day = strftime "%d", localtime;
my $mon = strftime "%m", localtime;
my $year = strftime "%Y", localtime;
$users_dms->{cal_start} =~ s/\s.*//;
($year,$mon,$day) = split(/-/,$users_dms->{cal_start}) if($users_dms->{cal_start});
my ($year1,$mon1,$day1) = split(/:/,$R::cal_delta_start);
my ($Dy,$Dm,$Dd) = Add_Delta_YMD($year,$mon,$day, $year1,$mon1,$day1);
$db->users_up("cal_start","$Dy-$Dm-$Dd",$users_dms->{u_id});
}
if($R::cal_today){
my $today4db = strftime("%Y-%m-%d %H:%M",localtime(time));
$db->users_up("cal_start","$today4db",$users_dms->{u_id});
}
if($R::col_sort){
$db->users_up("col_sort",$R::col_sort,$users_dms->{u_id});
}
if($R::sort_updown){
$db->users_up("sort_updown",$R::sort_updown,$users_dms->{u_id});
}
if($R::cal_sort_updown){
$db->users_up("cal_sort_updown",$R::cal_sort_updown,$users_dms->{u_id});
}
#base_edit implements new DMS methodes without Pre* things
#permissions
#DMS Kunden rw
if($R::base_edit && $node_meta->{ct_table} eq "contentadr"){
if($R::c_id && $R::base_edit eq "remove_chk4rel"){
my $delete_key = "delete_content";
$delete_key = "delete_adr";
$return = "failure::Datensatz wirklich löschen. ::?base_edit=$delete_key\&exit_box2=1\&c_id=$R::c_id ::löschen";
}elsif($users_dms->{int02} == 2 && $R::c_id && $R::base_edit eq "save_adr"){
($returnwww,$return) = $tk->save_account($R::c_id,$coo,$users_dms->{u_id});
}elsif($users_dms->{int02} == 2 && $R::c_id && $R::base_edit eq "delete_adr"){
$return = $tk->delete_account($R::c_id,$users_dms->{u_id});
}else{
$return = "failure::Abbruch. Schreibender Zugriff \"Kunden Stammdaten\" verweigert.";
}
}
#DMS users accounts
if($R::base_edit && $node_meta->{ct_table} eq "users"){#DMS-Account rw
if($R::u_id && $R::base_edit eq "remove_chk4rel"){#users
my $delete_key = "delete_dmsusers";
$return = "failure::Datensatz wirklich löschen. ::?base_edit=$delete_key\&exit_box2=1\&u_id=$R::u_id ::löschen";
}elsif($users_dms->{int07} == 2 && ($R::u_id || $R::c_idadr) && $R::base_edit =~ /_dmsusers/){
my $u_id = $1 if($R::u_id && $R::u_id =~ /(\d+)/);
$u_id = $1 if($R::c_idadr && $R::c_idadr =~ /(\d+)/ && $R::base_edit eq "new_dmsusers");
$return = $tk->manage_dmsusers($R::base_edit,$u_id,$users_dms);
}else{
$return = "failure::Abbruch. Schreibender Zugriff \"DMS-Account\" verweigert.";
}
}
#DMS Waren || Einstellung/Service* rw
if($node_meta->{ct_table} eq "content" || $node_meta->{ct_table} eq "contentuser"){
if(($node_meta->{ct_table} eq "content" && $users_dms->{int01} == 2) || ($node_meta->{ct_table} eq "contentuser" && $users_dms->{int08} == 2)){
if($R::rel_edit eq "save_relation" && $R::main_id && $R::main_id >= 200000){
$return = $pl->save_relation($R::main_id,$users_dms->{u_id});
}elsif($R::rel_edit eq "delete_relation" && $R::main_id && $R::main_id >= 200000){
$return = $pl->delete_relation($R::main_id,$users_dms->{u_id});
}elsif($R::rel_edit eq "new_relation" && $R::main_id && $R::main_id >= 200000){
$return = $pl->new_relation($R::main_id,$users_dms->{u_id});
}else{
$return = $pm->maininit($users_dms);
}
}elsif($R::rel_edit){
$return = "failure::Abbruch. Schreibender Zugriff \"Waren Stammdaten\" verweigert.";
}
}
#DMS Faktura
if($node_meta->{ct_table} eq "contenttrans"){
if($users_dms->{int03} == 1 && $R::ct_trans eq "open"){#DMS Faktura read
$db->update_users4trans($R::c_id4trans,$R::tpl_id4trans,$R::kind_of_trans,$users_dms->{u_id});
}elsif($users_dms->{int03} == 2){#DMS Faktura rw
$return .= "|";
$return .= $pre->preinit($users_dms,$lang);#transactions logic
}elsif($R::ct_trans){
$return = "failure::Abbruch. Schreibender Zugriff \"Faktura\" verweigert.";
}
}
#none DMS hosts ----------------------------------------------------
}elsif($varenv{orga} ne "dms"){
#save_account. 3. updates contentadr
if($users_sharee->{c_id} && $R::sharee_edit && $R::sharee_edit =~ /save_account/){
($returnwww,$return) = $tk->save_account($users_sharee->{c_id},$coo,$aowner);
}
if($users_sharee->{c_id} && $R::sharee_edit && $R::sharee_edit =~ /save_transact/){
$returnwww = $tk->save_transact($users_sharee->{c_id},$coo,$aowner);
}
if($returnwww && $returnwww =~ /failure::(.*)/){
$returnwww =~ s/::/=/g;
($api_return,$users_sharee) = $apif->auth_verify($q,$coo,"");
if($returnwww =~ /txt22|txt23/){
print redirect("$varenv{wwwhost}/$varenv{mandant}/Account/$varenv{accounting_2}?cum=1$session_and\&$returnwww");
}elsif($returnwww =~ /int03/){
print redirect("$varenv{wwwhost}/$varenv{mandant}/Account/$varenv{accounting_1_5}?cum=1$session_and\&$returnwww");
}elsif($returnwww =~ /txt09|txt16/){
print redirect("$varenv{wwwhost}/$varenv{mandant}/Account/$varenv{accounting_3}?cum=1$session_and\&$returnwww");
}elsif($returnwww =~ /int01/ && $R::radID){
print redirect("$varenv{wwwhost}/?ask_radID=$R::radID\&failure=not-synced$session_and");
}else{
print redirect("$varenv{wwwhost}/$varenv{mandant}/Account/$varenv{accounting_1}?cum=1$session_and\&$returnwww");
}
exit 0;
}else{
($api_return,$users_sharee) = $apif->auth_verify($q,$coo,"");
#Payone Response POST (TransactionStatus)
#payone response ($R::pseudocardpan || $R::status)
if($users_sharee->{c_id} && ($R::pseudocardpan || $R::status)){
my $payone_return;
open(FILE,">>$varenv{logdir}/payone-return-post.log");
print FILE "<--- $now_dt from Indextink.pm \nPayone return-way by ajaxCall: $R::status\n";
my @keywords = $q->param;
foreach(@keywords){
my $val = $q->param($_);
print FILE "$_=$val\n";
#TODO, check errormessages. At first we have do indicate what comes from payone!
$payone_return .= "$_=$val\n";# if($_ =~ /error|message/i);
}
close(FILE);
my $update_adr = {
table => "contentadr",
mtime => "now()",
owner => $aowner,
c_id => $users_sharee->{c_id}
};
my $vde_on_fail = $users_sharee->{int12} || 3;#keep last or set 3
#SEPA, done in payone Payment
#CC
if($R::pseudocardpan && length($R::pseudocardpan) >= 19){#done by payone AJAX return
#if($R::status eq "APPROVED")
$update_adr->{txt22} = "";
$update_adr->{txt23} = "";
$update_adr->{ct_name} = $q->escapeHTML($R::pseudocardpan);
$update_adr->{txt27} = $q->escapeHTML($R::status);
$update_adr->{txt28} = "";
$update_adr->{int12} = 0;
$update_adr->{int03} = 2;
$dbt->update_record($dbh,$update_adr,$users_sharee) if($users_sharee->{c_id} > 0);
($api_return,$users_sharee) = $apif->auth_verify($q,$coo,"");
#define fictiv invoice to get 1 € test
my $epoche = time();
my $ctt = {
c_id => 1,
int01 => 0,#capture amount
int15 => 1,#preauth amount
txt16 => "",
reference => "$users_sharee->{c_id}_$epoche",
renewed => ''
};
my $payone_txid = "";
$payone_txid = $payone->preauthorizationCC_main(\%varenv,$users_sharee,$ctt,$aowner);
if($payone_txid){
$ctt->{txt16} = "$payone_txid";
$payone_txid = $payone->captureCC_main(\%varenv,$users_sharee,$ctt,$aowner);
}else{
$dbt->update_one($dbh,$update_adr,"int12=$vde_on_fail");#Vde
}
$tk->emailack($users_sharee->{c_id}) if($users_sharee->{int04} != 1);
$dbt->update_operatorsloop($varenv{dbname},$users_sharee->{c_id},"update");
print redirect("$varenv{wwwhost}/$varenv{mandant}/$varenv{profile}?$returnwww$session_and");
exit 0;
}else{
$update_adr->{txt28} = $q->escapeHTML($payone_return);
$update_adr->{int12} = $vde_on_fail;
$dbt->update_record($dbh,$update_adr,$users_sharee) if($users_sharee->{c_id} > 0);
$dbt->update_operatorsloop($varenv{dbname},$users_sharee->{c_id},"update");
}
}
}
my $debug=0;
$debug=1;
#send confirm codes
if($users_sharee->{c_id} && $users_sharee->{txt34} && length($users_sharee->{txt34}) > 20 && $payable_check && $R::sharee_edit && $R::sharee_edit =~ /save_account|send_email|send_sms/){
if(($users_sharee->{int04} != 1 || $R::sharee_edit =~ /send_email/) && ($users_sharee->{txt08} =~ /\w\@\w/)){
$tk->emailack($users_sharee->{c_id});
}
if(($users_sharee->{int13} != 1 || $R::sharee_edit =~ /send_sms/) && ($users_sharee->{txt07} =~ /\d{9}/ && length($users_sharee->{txt07}) <= 16 && $users_sharee->{txt07} =~ /\+[1-9]{3}/)){
$tk->smsack($users_sharee);
}
}#send confirm code
#email and sms acknowledgments, check and save confirm states
if($R::confirm_userid && $R::confirm_userid =~ /^\d+$/ && ($R::confirm_code && length($R::confirm_code) >= 5 || $R::confirm_smscode && length($R::confirm_smscode) >= 5)){
#keep in mind, for now and just for testing confirm codes are just c_id
open(FILE,">>$varenv{logdir}/confirm.log") if($debug);
print FILE "\n\n*--> $now_dt done by $0\n" if($debug);
print FILE "confirm_userid:$R::confirm_userid\nconfirm_code:$R::confirm_code\nconfirm_smscode:$R::confirm_smscode\n" if($debug);
$R::confirm_code =~ s/\s//g;
$R::confirm_smscode =~ s/\s//g;
my $confirm_code = $q->escapeHTML($R::confirm_code);
my $confirm_smscode = $q->escapeHTML($R::confirm_smscode);
#confirm email
if($confirm_code){
my $authref = {
table => "contentadr",
fetch => "one",
template_id => "202",
c_id => $R::confirm_userid,
txt34 => "ilike::$confirm_code%",
};
my $confirmed_email = $dbt->fetch_record($dbh,$authref);
#($api_return,$users_sharee) = $apif->auth_verify($q,"",$R::confirm_code);
if($confirmed_email->{c_id}){
$db->updater("contentadr","c_id","$confirmed_email->{c_id}","int04","1");
#save verified email
$db->updater("contentadr","c_id","$confirmed_email->{c_id}","txt32","$confirmed_email->{txt08}");
print FILE "confirmed_email: $confirmed_email->{c_id} update because confirm_code:$confirm_code\n" if($debug);
#after mailAck, delete all douple adr with no mailAck and no invoices
my $ctadr = $db->collect_ct4rel3("contentadr","","","ilike","txt08","$confirmed_email->{txt08}","","","");
foreach my $aid (keys(%$ctadr)){
if(!$ctadr->{$aid}->{int04}){
my $ctctt = $db->get_content6("contenttrans","int10",$ctadr->{$aid}->{c_id});
$db->delete_content("contentadr",$ctadr->{$aid}->{c_id}) if(!$ctctt->{c_id});
print FILE "c_id $ctadr->{$aid}->{c_id} $confirmed_email->{txt08} delete because of dopplel\n" if($debug);
}
}
}
}
#confirm sms
if($confirm_smscode){
my $authref = {
table => "contentadr",
fetch => "one",
template_id => "202",
c_id => $R::confirm_userid,
txt34 => "ilike::%$confirm_smscode",
};
my $confirmed_sms = $dbt->fetch_record($dbh,$authref);
#($api_return,$users_sharee) = $apif->auth_verify($q,"",$R::confirm_smscode);
if($confirmed_sms->{c_id}){
$db->updater("contentadr","c_id","$confirmed_sms->{c_id}","int13","1");
#save verified telnr
$db->updater("contentadr","c_id","$confirmed_sms->{c_id}","txt33","$confirmed_sms->{txt07}");
print FILE "confirmed_sms: $confirmed_sms->{c_id} update because confirm_smscode:$confirm_smscode\n" if($debug);
}
}
($api_return,$users_sharee) = $apif->auth_verify($q,"",$users_sharee->{c_id}) if($users_sharee->{c_id});
if($users_sharee->{int12} != 2 && $users_sharee->{int04} && $users_sharee->{int13}){
my $row = $db->updater("contentadr","c_id","$users_sharee->{c_id}","int12","0");#Vde
$dbt->update_operatorsloop($varenv{dbname},$users_sharee->{c_id},"update");
}else{
my $field = "int13";
$field = "int04" if(!$users_sharee->{int04});
print redirect("$varenv{wwwhost}/$varenv{mandant}/Account/$varenv{accounting_3}?cum=3$session_and\&failure=$field#top");
exit 0;
}
if(!$coo){
print FILE "c_id: $users_sharee->{c_id} empty auth because of no cookie\n" if($debug);
$users_sharee = { c_id => 0 };
}
close(FILE) if($debug);
if($users_sharee->{c_id} && $users_sharee->{int04} && $users_sharee->{int13}){
print redirect("$varenv{wwwhost}/$varenv{mandant}/Account/$varenv{accounting_3}?confirm_success=1");
exit 0;
}
}#end confirm
if($R::email && $R::sharee_edit =~ /password_forgotten/){
my $hw_id = unpack ('H*', pack('Nc', time, $$ % 0xff));#old $co
$tk->send_password($R::email,$hw_id,$aowner);
}
#redirections
if($users_sharee->{c_id} && ($path =~ /$varenv{mandant}\/$varenv{profile}/ || $path =~ /$varenv{mandant}\/Account/)){
if($R::sharee_edit =~ /save_account/){
$returnwww =~ s/::/=/g if($returnwww && $returnwww =~ /success::\w+/);
if((!$users_sharee->{int14}) || ($users_sharee->{txt31} && $tpl->{tpl_order} =~ /$users_sharee->{txt31}/)){
#failure redirect should do the delete job
print redirect("$varenv{wwwhost}/$varenv{mandant}/Account/$varenv{accounting_1}?failure=$users_sharee->{txt31}$session_and#top");
exit 0;
}
elsif(!$users_sharee->{int03}){
print redirect("$varenv{wwwhost}/$varenv{mandant}/Account/$varenv{accounting_1_5}$session");
exit 0;
}
elsif($payable_check && (!$users_sharee->{int04} || !$users_sharee->{int13})){
print redirect("$varenv{wwwhost}/$varenv{mandant}/Account/$varenv{accounting_3}?cum=2$session_and\&$returnwww");
exit 0;
}
elsif($users_sharee->{int03} && (($users_sharee->{int03} == 1 && $users_sharee->{ct_name} !~ /\w{2}-\d+/) || ($users_sharee->{int03} == 2 && length($users_sharee->{ct_name}) < 19))){
print redirect("$varenv{wwwhost}/$varenv{mandant}/Account/$varenv{accounting_2}$session");
exit 0;
}
elsif($payable_check){
print redirect("$varenv{wwwhost}/$varenv{mandant}/Account/$varenv{accounting_3}?cum=2$session_and\&$returnwww");
exit 0;
}
}elsif($path =~ /$varenv{mandant}\/$varenv{profile}/){
if((!$users_sharee->{int14}) || ($users_sharee->{txt31} && $tpl->{tpl_order} =~ /$users_sharee->{txt31}/)){
print redirect("$varenv{wwwhost}/$varenv{mandant}/Account/$varenv{accounting_1}?failure=$users_sharee->{txt31}$session_and#top");
exit 0;
}elsif(!$payable_check){
print redirect("$varenv{wwwhost}/$varenv{mandant}/Account/$varenv{accounting_1_5}$session");
exit 0;
}else{
print redirect("$varenv{wwwhost}/$varenv{mandant}/Account/$varenv{accounting_3}?cum=2$session_and\&$returnwww");
exit 0;
}
}
}elsif($users_sharee->{c_id} && ($path =~ /$varenv{mandant}\/Anmelden|$varenv{mandant}\/$varenv{profile}/)){
print redirect("$varenv{wwwhost}/$varenv{mandant}/Account/$varenv{accounting_3}?cum=2$session_and\&$returnwww");
exit 0;
}
###
}
my $nodev = $db->get_node("$view_post","$lang");
#Printpreview
if($view =~ /Printpreview/){
require "Lib/Printpreview.pm";
&Printpreview::printpre();
exit 0;
}
elsif($view =~ /PDFGenerator/){
require "Lib/PDFGenerator.pm";
&PDFGenerator::printpre();
exit 0;
}
#else global REDIRECT. Availability check for redirect
#elsif(!$nodev->{main_id} || ($nodev->{main_id} == 100 && $R::rel_edit eq "save_content")){
#print redirect("$varenv{wwwhost}$session");
#exit 0;
#}
#CSVout
if($R::rel_edit && $R::rel_edit =~ /XLSout/){
$users_dms = $dbt->select_users($dbh,$users_dms->{u_id});
if(-f "$dbt->{copri_conf}->{basedir}/pdf/$users_dms->{owner}-$users_dms->{time4csv}.xls"){
print $q->redirect(-uri=>"$varenv{metahost}/pdf/$users_dms->{owner}-$users_dms->{time4csv}.xls", -type=>"application/octet-stream", -target=>'_blank');
exit 0;
}
}
my $dyn_css = "";
if(1==1){
my $background = "";
$background = "$varenv{metahost}/img/$varenv{background_image}" if($varenv{background_image});
$dyn_css = "
html,body {
background-image:url('$background');
background-repeat: $varenv{background_repeat};
background-position: right bottom;
background-attachment:fixed;
background-size:$varenv{background_size};
font-family: $varenv{font_family};
font-size: $varenv{font_size};
line-height: $varenv{line_height};
margin: 0; padding: 0;
text-align:$varenv{background_align};
}\n";
}
my $url = "$varenv{wwwhost}/$path";
#my $onload="onLoad();";
my $onload="";
my $local_style = "$varenv{metahost}/$dbt->{shareeapp_conf}->{local_style}";
my $jquery = "$varenv{metahost}/$dbt->{shareeapp_conf}->{jquery}";
my $js_bootstrap = "$varenv{metahost}/$dbt->{shareeapp_conf}->{js_bootstrap}";
my $style_bootstrap = "$varenv{metahost}/$dbt->{shareeapp_conf}->{style_bootstrap}";
if($varenv{wwwhost} =~ /shareedms/){
$local_style = "$varenv{metahost}/$dbt->{shareedms_conf}->{local_style}";
$jquery = "$varenv{metahost}/$dbt->{shareedms_conf}->{jquery}";
$js_bootstrap = "$varenv{metahost}/$dbt->{shareedms_conf}->{js_bootstrap}";
$style_bootstrap = "$varenv{metahost}/$dbt->{shareedms_conf}->{style_bootstrap}";
}
my $base_uri = "true";
my $title = "";
$title .= $dbt->{primary}->{$varenv{dbname}}->{pprefix} if($dbt->{primary}->{$varenv{dbname}}->{pprefix});
$title .= $dbt->{operator}->{$varenv{dbname}}->{project} if($dbt->{operator}->{$varenv{dbname}}->{project});
$title .= " " . $dbt->{operator}->{$varenv{dbname}}->{oprefix} if($dbt->{operator}->{$varenv{dbname}}->{oprefix});
$title .= $dbt->{website}->{$varenv{syshost}}->{project} if($dbt->{website}->{$varenv{syshost}}->{project});
$title .= " DEVEL $varenv{dbname}" if($dbt->{copri_conf}->{stage} eq "test");
my $html5 = $q->start_html(-title=>"$title",
-lang=>'de',
-onload=>"$onload",
-oncontextmenu=>"$oncontextmenu",
#-id=>"page-top",
#'-data-spy'=>"scroll",
#'-data-target'=>".navbar-fixed-top",
-encoding=>"$html_charset",
-base=>"$base_uri",
-target=>"",
-head=>[
Link({
-rel=>'shortcut icon',
-type=>'image/x-icon',
-href=>"$varenv{metahost}/css/favicon.ico"
})
],
-meta=>{
'viewport'=>"width=device-width,initial-scale=1,user-scalable=yes",
'author'=>"Rainer Gümpelein",
'publisher'=>"TeilRad GmbH",
'copyright'=>"TeilRad GmbH",
'keywords'=>"",
'description'=>"sharee.bike Mietradmanagementsystem"
},
-script=>[
{-language=>'JAVASCRIPT',
-src=>"$jquery"},
{-language=>'JAVASCRIPT',
-src=>"$varenv{metahost}/$dbt->{copri_conf}->{jquery_ui}"},
{-language=>'JAVASCRIPT',
-src=>"$varenv{metahost}/$dbt->{copri_conf}->{jquery_resize}"},
{-language=>'JAVASCRIPT',
-src=>"$varenv{metahost}/$dbt->{copri_conf}->{jsscript}"},
{-language=>'JAVASCRIPT',
-code=>"$dyn_js"}
],
-STYLE=>{
-code=>"$dyn_css",
-src=>[
"$local_style",
"$style_bootstrap",
"$varenv{metahost}/$dbt->{copri_conf}->{style_bootstrap_icons}",
"$varenv{metahost}/$dbt->{copri_conf}->{style_jquery_ui}"
],
-verbatim=>"\@import url(\"$local_style\");",
-media=>'screen'
}
);
# CGI.pm doesn't support HTML5 DTD; replace the one it puts in.
$html5 =~ s{<!DOCTYPE.*?>}{<!DOCTYPE html>}s;
$html5 =~ s{<html.*?>}{<html lang='de'>}s;
print $html5;
print $q->div({-style=>'background-color:black;color:white;'},"<noscript>JavaScript is off. Please enable to view full site.</noscript>"),"\n";
$ml->tpl($node_meta,$users_dms,$mode,\%varenv,$users_sharee,$return);
if(ref($api_return) eq "HASH" && $api_return->{response_text}){
print<<EOF
<style>div#retm_konrad {position:fixed;right:40%;top:0;padding:5px;text-align:center;color:black;background-color:white;z-index:110;}</style>
<script>
\$(document).ready(function(){
\$( "#retm_konrad" ).fadeOut(7000);
})
</script>
EOF
;
print $q->div({-id=>'retm_konrad'},"$api_return->{response_text}"),"\n";
}
print "<script src='$js_bootstrap'></script>\n";
print $q->end_html;
return Apache2::Const::OK;
}
1;

258
copri4/main/src/Mod/KMLout.pm Normal file
View file

@ -0,0 +1,258 @@
package Mod::KMLout;
#
# 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/KMLout
#
#with login and valid autcookie:
#https://shareeapp-primary.copri-bike.de/KMLout?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;
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;
my $apif = new APIfunc;
my $cf = new Config;
my %varenv = $cf->envonline();
my $coo = $q->cookie('domcookie') || $q->param('sessionid') || "rafo87znqx";
my $users_sharee = { c_id => 0 };
my $api_return = { authcookie => 'rafo87znqx' };
($api_return,$users_sharee) = $apif->auth_verify($q,$coo,"");
my $kmlfile = kmlGenerator($api_return,\%varenv,$users_sharee);
#print out test with kml file
if(1==2){
print $q->header(-type => "application/vnd.google-earth.kml+xml", -charset=>"utf-8");
if (open(my $fh, '<', "$varenv{basedir}/xml/$kmlfile")) {
while (my $row = <$fh>) {
print "$row";
}
}
}
return Apache2::Const::OK;
}
sub kmlGenerator {
my $authcookie = shift || { authcookie => '' };
my $varenv = shift;
my $users_sharee = shift || { c_id => 0 };
my $q = new CGI;
my $dbt = new DBtank;
my $json = JSON->new->allow_nonref;
my $cf = new Config;
#my $now_dt = strftime "%Y-%m-%d %H:%M:%S", localtime;
my $lang="de";
my $dbh = "";
#my $netloc = $q->url(-base=>1);
#print "kmlGenerator accessed by netlocation: " . $netloc;
my $project = "all";
$project = "Bayern" if($varenv->{syshost} eq "shareeweb-bayern");
$project = "Konstanz" if($varenv->{syshost} eq "shareeweb-konstanz");
my $timestamp = strftime "%Y%m%d%H%M%S", localtime;
my $kmlfile = "sharee-$timestamp-$users_sharee->{c_id}.kml";
$bw->log("kmlGenerator with: ",$kmlfile,"");
my $uri_primary = $dbt->{primary}->{sharee_primary}->{primaryApp};
my $rest_stations = "request=stations_available&project=$project&authcookie=$authcookie->{authcookie}";
my $rest_bikes = "request=bikes_available&project=$project&authcookie=$authcookie->{authcookie}";
my $station_hash = {};
my $bike_hash = {};
my $lastenrad = 300101;
my $e_lastenrad = 300102;
my $stadtrad = 300103;
my %place_name;
my %place_desc;
my %place_pin;
my %place_longitude;
my %place_latitude;
#reading shareejson
my $stations_json = fetch_primary_json("",$uri_primary,$rest_stations);
my $bikes_json = fetch_primary_json("",$uri_primary,$rest_bikes);
open(XML,">$varenv->{basedir}/xml/$kmlfile") || die "$0 can not write $!";
print XML "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
print XML "<kml xmlns=\"http://www.opengis.net/kml/2.2\">\n";
print XML "<Document>\n";
print XML "<name>sharee.bike</name>\n";
print XML "<description>bike stations for $users_sharee->{c_id}</description>\n";
if($stations_json && $bikes_json){
#decode json to hash
my $response_stations = decode_json($stations_json);
my $response_bikes = decode_json($bikes_json);
#BIG LOOP
#loop stations hash
foreach my $station (keys (%{ $response_stations->{shareejson}->{stations} })) {
$station_hash->{$station} = $response_stations->{shareejson}->{stations}->{$station};
$place_pin{$station} = "Open_Red.png";
my $station_desc = "Mietradstation $station";
if($response_stations->{shareejson}->{stations}->{$station}->{description}){
$station_desc = "Mietradstation: $response_stations->{shareejson}->{stations}->{$station}->{description} $station";
#$bw->log("KMLout station_desc: ",$station_desc,"");
}
$place_name{$station} = "$station_desc";
if($response_stations->{shareejson}->{stations}->{$station}->{state} eq "available" && $response_stations->{shareejson}->{stations}->{$station}->{gps}->{latitude} =~ /\d{1,2}\.\d+/ && $response_stations->{shareejson}->{stations}->{$station}->{gps}->{longitude} =~ /\d{1,2}\.\d+/){
$place_latitude{$station} = $response_stations->{shareejson}->{stations}->{$station}->{gps}->{latitude};
$place_longitude{$station} = $response_stations->{shareejson}->{stations}->{$station}->{gps}->{longitude};
$place_desc{$station} = "";
#print "\n--- Station $station hat folgende Räder ---\n";
#loop station_group array
foreach my $station_group (@{ $response_stations->{shareejson}->{stations}->{$station}->{station_group} }){
#print "station_group ($station): " . $station_group . "\n";
my $station_groupID = 0;
#loop bikes hash
foreach my $bike (keys (%{ $response_bikes->{shareejson}->{bikes} })) {
$bike_hash->{$bike} = $response_bikes->{shareejson}->{bikes}->{$bike};
#loop bike_group array
foreach my $bike_group (@{ $response_bikes->{shareejson}->{bikes}->{$bike}->{bike_group} }){
#print "bike_group ($bike): " . $bike_group . "\n";
my $bike_groupID = 0;
$station_groupID = $1 if($station_group =~ /(\d+)/);
$bike_groupID = $1 if($bike_group =~ /(\d+)/);
#if Lastenrad
if($station_groupID == $lastenrad && $station_groupID == $bike_groupID && $station eq $response_bikes->{shareejson}->{bikes}->{$bike}->{station}){
$place_pin{$station} = "Open_Green.png";
$place_desc{$station} .= "<p align='left'>&bull; Lastenrad vorrätig: $response_bikes->{shareejson}->{bikes}->{$bike}->{description} $bike</p>";
#print "($station) Lastenrad $bike\n";
}
#if E-Lastenrad
if($station_groupID == $e_lastenrad && $station_groupID == $bike_groupID && $station eq $response_bikes->{shareejson}->{bikes}->{$bike}->{station}){
$place_pin{$station} = "Open_Green.png";
$place_desc{$station} .= "<p align='left'>&bull; E-Lastenrad vorrätig: $response_bikes->{shareejson}->{bikes}->{$bike}->{description} $bike</p>";
#print "($station) E-Lastenrad $bike\n";
}
#if Stadtrad
if($station_groupID == $stadtrad && $station_groupID == $bike_groupID && $station eq $response_bikes->{shareejson}->{bikes}->{$bike}->{station}){
$place_pin{$station} = "Open_Green.png";
$place_desc{$station} .= "<p align='left'>&bull; Stadtrad vorrätig: $response_bikes->{shareejson}->{bikes}->{$bike}->{description} $bike</p>";
#print "($station) Stadtrad $bike\n";
}
}
}
}
print XML " <Style id=\"$place_pin{$station}\">\n";
print XML " <IconStyle>\n";
print XML " <Icon>\n";
print XML " <href>$varenv->{metahost}/img/$place_pin{$station}</href>\n";
print XML " </Icon>\n";
print XML " </IconStyle>\n";
print XML " </Style>\n";
print XML " <Placemark>\n";
print XML " <name>$place_name{$station}</name>\n";
print XML " <description><![CDATA[ $place_desc{$station} ]]></description>\n";
print XML " <styleUrl>#$place_pin{$station}</styleUrl>\n";
print XML " <Point>\n";
print XML " <coordinates>$place_longitude{$station}, $place_latitude{$station}</coordinates>\n";
print XML " </Point>\n";
print XML " </Placemark>\n";
}
}#end BIG LOOP
}#end if json
print XML "</Document>\n";
print XML "</kml>\n";
close(XML);
chmod 0666, "$varenv->{basedir}/xml/$kmlfile";
#my $update_kml = {};
#if($users_sharee->{c_id} > 0){
# $update_kml = {
# table => "contentadr",
# atime => "now()",
# c_id => $users_sharee->{c_id},
# };
#}else{
# $update_kml = {
# table => "content",
# mtime => "now()",
# c_id => "3",
# };
#}
#my $dbh_primary = $dbt->dbconnect_extern("sharee_primary");
#$dbt->update_one($dbh_primary,$update_kml,"txt20='$kmlfile'");
#print "station_hash ALL:" . Dumper($station_hash);
#print "bike_hash ALL:" . Dumper($bike_hash);
#
return $kmlfile;
}#end kmlGenerator
#requestor
sub fetch_primary_json {
my $self = shift;
my $primary_server = shift || "";
my $rest = shift || "";
my $primary_request = "$primary_server/APIjsonserver?$rest";
$bw->log("kmlGenerator primary_request: ",$primary_request,"");
#print "GET_json >> " . $primary_request . "\n";
my $ua = LWP::UserAgent->new;
$ua->agent("sharee KMLout");
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);
# 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;

756
copri4/main/src/Mod/Libenz.pm Normal file
View file

@ -0,0 +1,756 @@
package Libenz;
#
#Deprecated module, better use Prelib.pm or Basework.pm
#
# SPDX-License-Identifier: AGPL-3.0-or-later
# Copyright (c) Rainer Gümpelein, TeilRad GmbH
#
use strict;
use warnings;
use POSIX;
use File::Path qw(make_path remove_tree);
use File::Copy;
use File::Copy::Recursive qw(fcopy rcopy dircopy fmove rmove dirmove);
use Getopt::Long;
use CGI; # only for debugging
use CGI::Carp qw(fatalsToBrowser);
use Calendar::Simple;
use Date::Calc qw(:all);
use Mod::Callib;
use Mod::Libenzdb;
use Mod::Buttons;
use Lib::Config;
use Digest::MD5 qw(md5 md5_hex);
use Scalar::Util qw(looks_like_number);
my $cf = new Config;
my $cb = new Callib;
my $but = new Buttons;
my $db = new Libenzdb;
my $q = new CGI;
#my $pi = new Image::Magick;
$q->import_names('R');
sub new {
my $class = shift;
my $self = {};
bless($self,$class);
return $self;
}
my %varenv = $cf->envonline();
my $lang="de";
my $now_time = strftime "%Y-%m-%d %H:%M", localtime;
my @months = $cb->monthmap();
my @days = $cb->daymap();
my $i_rows=0;
my $u_rows=0;
my $d_rows=0;
my $nall;
sub grep_filecontent(){
my $self = shift;
my ($filename,$content,$pattern) = @_;
my $match = "";
if (open(my $fh, '<:encoding(UTF-8)', $filename)) {
while (my $row = <$fh>) {
$row =~ s/\n//;
$row =~ s/\r//;
if($content && $row eq $content){
$match = $content;
}elsif($pattern && $row =~ /$pattern/){
$match = $row;
}
}
}
return $match;
}
# calculates the distance between two latitude, longitude points
sub geo_fencing {
my $self = shift;
my ($lat1, $lon1, $lat2, $lon2) = @_;
my $pi = atan2(1,1) * 4;
if (($lat1 == $lat2) && ($lon1 == $lon2)) {
return 0;
}
else {
my $theta = $lon1 - $lon2;
my $dist = sin($lat1 * $pi / 180) * sin($lat2 * $pi / 180) + cos($lat1 * $pi / 180) * cos($lat2 * $pi / 180) * cos($theta * $pi / 180);
$dist = atan2(sqrt(1 - $dist**2), $dist);
$dist = $dist * 180 / $pi;
$dist = $dist * 60 * 1.1515;#Miles
$dist = $dist * 1.609344 * 1000;#Meters
$dist = sprintf('%.0f',$dist);
return ($dist);
}
}
sub country_code(){
my $self = shift;
my $country = {
'DE' => 'Deutschland',
'BE' => 'Belgien',
'BG' => 'Bulgarien',
'CH' => 'Schweiz',
'CZ' => 'Tschechische Republik',
'DK' => 'Dänemark',
'EE' => 'Estland',
'IE' => 'Irland',
'EL' => 'Griechenland',
'ES' => 'Spanien',
'FR' => 'Frankreich',
'HR' => 'Kroatien',
'IT' => 'Italien',
'CY' => 'Zypern',
'LV' => 'Lettland',
'LT' => 'Litauen',
'LU' => 'Luxemburg',
'HU' => 'Ungarn',
'MT' => 'Malta',
'NL' => 'Niederlande',
'AT' => 'Österreich',
'PL' => 'Polen',
'PT' => 'Portugal',
'RO' => 'Rumänien',
'SI' => 'Slowenien',
'SK' => 'Slowakei',
'FI' => 'Finnland',
'SE' => 'Schweden',
'GB' => 'Vereinigtes Königreich'
};
return $country;
}
#read directory
sub read_dirfiles(){
my $self = shift;
my ($dir,$extensions,$dirOfile,$not) = @_;
my @dirfiles;
if( -d "$dir" || -l "$dir"){
opendir(DIR, "$dir") or die "could not open $dir $!";
foreach(sort(readdir(DIR))){
if($dir =~ /INBOX/){
if($_ =~ /^$extensions/){
push(@dirfiles,$_) if(-f "$dir/$_" && $dirOfile eq "file");
push(@dirfiles,$_) if(-d "$dir/$_" && $dirOfile eq "dir");
}
}
elsif($not){
if(uc($_) !~ /$extensions/){
push(@dirfiles,$_) if(-f "$dir/$_" && $dirOfile eq "file");
push(@dirfiles,$_) if(-d "$dir/$_" && $dirOfile eq "dir");
}
}else{
if(uc($_) =~ /$extensions/ || $_ =~ /$extensions/){
push(@dirfiles,$_) if(-f "$dir/$_" && $dirOfile eq "file");
push(@dirfiles,$_) if(-d "$dir/$_" && $dirOfile eq "dir");
}
}
}
closedir DIR;
}else{
print "\ndirectory: $dir does not exist\n $!\n";
}
return @dirfiles;
}
#return message
sub return_feedback(){
my $self = shift;
my ($return,$kind_of_trans,$owner,$terminal) = @_;
if($owner > 0){
print<<EOF
<script>
\$(document).ready(function(){
\$( "#retm" ).fadeOut(7000);
})
</script>
EOF
;
$return = $R::return if($R::return);
my ($ret_pm,$ret_pl,$ret_er) = split(/\|/,$return);
my ($i_pm,$s_pm,$d_pm) = split(/-/,$ret_pm);
my ($i_pl,$s_pl,$d_pl) = split(/-/,$ret_pl);
my $pre = "";
$kind_of_trans = "Transaktions" if(!$kind_of_trans);
my $feedb = "";
$feedb = "neue $pre Daten eingefuegt" if($i_pm);
$feedb = "insert successfully " if($i_pm && $varenv{html_lang} eq "en");
$feedb = "$pre Daten gespeichert" if($s_pm);
$feedb = "saved successfully" if($s_pm && $varenv{html_lang} eq "en");
$feedb = "$pre Daten geloescht" if($d_pm);
$feedb = "deleted successfully" if($d_pm && $varenv{html_lang} eq "en");
$feedb = "neue $kind_of_trans Daten eingefuegt" if($i_pl);
$feedb = "$kind_of_trans Daten gespeichert" if($s_pl);
$feedb = "$kind_of_trans Daten geloescht" if($d_pl);
$feedb = "Artikel eingefügt" if($i_pl =~ /ctpos_id=\d+/);
my $debug;
$debug = "($ret_pm|$ret_pl)" if($owner eq "101");
if($return !~ /failure/ && $feedb){
print $q->div({-id=>'retm'},"$feedb $debug"),"\n";
}
}
$return = $1 if($return =~ /(failure.*)/);
return $return;
}
#Quersumme
sub quersum(){
my $self = shift;
my ($kecks) = @_;
my $laenge = length($kecks);
my $quersum = 0;
for(my $i=0; $i<$laenge; $i++) {
my $signs = substr($kecks, $i, 1);
$quersum = $quersum + int(ord($signs));
}
return $quersum;
}
#Calfkt to get a scalable line of days per month
sub month_line(){
my $self = shift;
my ($users) = @_;
#my $users = $db->select_users($u_id);
my $hh;my $mm;
my $day = strftime "%d", localtime;
my $mon = strftime "%m", localtime;
my $year = strftime "%Y", localtime;
my $day_today = $day;
my $mon_today = $mon;
my $year_today = $year;
($year,$mon,$day,$hh,$mm) = &split_date("",$users->{cal_start}) if($users->{cal_start});
#print "$year,$mon,$day,$hh,$mm";
my $month_days = Days_in_Month($year,$mon);
my $factor = 100 / $month_days;
my @month = calendar($mon, $year);
my $raster_mmpx = $factor . "%"; #bsp.: 100% / 31days
my $day4month;
my $bg;
my @week;
my $i=0;
my $j=0;
#month, week loop
foreach (@month) {
$i=0;
$j++;
#print map { $_ ? sprintf "%2d ", $_ : '&nbsp; x &nbsp;' } @$_;
#day-of-week loop
foreach(@$_){
if($_){
$_ = "0$_" if($_ < "10");
$week[$j] .= "$_,";
#print $q->th({-nowrap=>1},"$days[$i] $_");
if("$_" eq "$day_today" && "$mon" eq "$mon_today"){
$bg="#86cb00";
}else{
$bg="silver";
}
$day4month .= "<div style='float:left;min-width:$raster_mmpx;border-bottom: solid thin gray;background-color:$bg;height:1.5em;padding:0.3em 0em;' nowrap>|$days[$i] $_</div>\n";
}
$i++;
}
}
my $daycounter = $day_today - 1;
my $daymarker = $raster_mmpx * $daycounter;
$daymarker .= "%";
return ($daymarker,$raster_mmpx,$day4month);
}
#rent scale
sub rent_scale(){
my $self = shift;
my ($users,$year_st,$mon_st,$day_st,$hh_st,$mm_st,$year_en,$mon_en,$day_en,$hh_en,$mm_en) = @_;
#print "<br />($u_id,$year_st,$mon_st,$day_st,$hh_st,$mm_st,$year_en,$mon_en,$day_en,$hh_en,$mm_en)<br />";
#my $users = $db->select_users($u_id);
my $hh;my $mm;
my $day = strftime "%d", localtime;
my $mon = strftime "%m", localtime;
my $year = strftime "%Y", localtime;
($year,$mon,$day,$hh,$mm) = &split_date("",$users->{cal_start}) if($users->{cal_start});
my $month_days = Days_in_Month($year,$mon);
my $factor = 100 / $month_days;
my @month = calendar($mon, $year);
my $doy_mon_st=0;my $doy_mon_en=0;my $doy_st=0;my $doy_en=0;
my $day_stpx = 0;
my $rent_day_px = 0;
if(looks_like_number($year_st) && looks_like_number($mon_st) && looks_like_number($day_st) && looks_like_number($year_en) && looks_like_number($mon_en) && looks_like_number($day_en)){
#print "if(($year == $year_st) && ($mon == $mon_st)){<br>";
if(($year == $year_st) && ($mon == $mon_st)){
$doy_mon_st = Day_of_Year($year_st,$mon_st,1);#JahresTage bis Monatsanfang
$doy_st = Day_of_Year($year_st,$mon_st,$day_st);
}else{
$doy_mon_st = Day_of_Year($year,$mon,1);
$doy_st = Day_of_Year($year,$mon,1);
}
if(($year == $year_en) && ($mon == $mon_en)){
$doy_en = Day_of_Year($year_en,$mon_en,$day_en);
}elsif($year_en && $mon_en){
my $month_days_en = Days_in_Month($year_en,$mon_en);
$doy_en = Day_of_Year($year_en,$mon_en,$month_days_en);# wenn ausserhalb --> cal_start
}
if(($mon != $mon_en) && ($mon != $mon_st)){
$doy_mon_st=0;$doy_mon_en=0;$doy_st=0;$doy_en=0;
}
my $day_st_new = $doy_st - $doy_mon_st;
#print "<br />$day_st_new = $doy_st - $doy_mon_st|";
#day rent-duration
my $rent_day = ($doy_en - $doy_st + 1);
#print "$rent_day = ($doy_en - $doy_st + 1)<br>";
#$rent_day_px = $rent_day * $multi if($doy_en && $doy_st);
#$rent_day_px .= "px";
$rent_day_px = $rent_day * $factor if($doy_en && $doy_st);
$rent_day_px .= "%";
#debug
#print "$ct_n --- start: $day_st_new = $doy_st - $doy_mon_st | länge: $rent_day = $doy_en - $doy_st |<br>";
#start day align left
#$day_stpx = ($day_st_new + 0) * $multi if($day_st_new);
#$day_stpx .= "px";
$day_stpx = $day_st_new * $factor;
$day_stpx .= "%";
}
#print "$day_stpx,$rent_day_px<br />";
return ($day_stpx,$rent_day_px);
}
#check if barcodeable
sub barcodeable(){
my $self = shift;
my ($table,$number) = @_;
my $oGdBar = GD::Barcode->new("Code39", "$number");
my $ct_name = $oGdBar->{text};
my $barcode = $oGdBar->{text};
return ($ct_name,$barcode);
}
#FIXME or change to barcode=c_id
#get free barcode
sub get_freenr(){
my $self = shift;
my ($table,$barcode_last) = @_;
my $freenr = $db->collect_content3($table);
my $s_id = $barcode_last;
my $e_id = "100000";
$freenr->{$s_id}->{barcode} = "1000" if(!$freenr->{$s_id}->{barcode} || $freenr->{$s_id}->{barcode} == 0);
for (; $s_id < $e_id; $s_id++){
if($freenr->{$s_id}->{barcode} != $s_id){
return $s_id;
}
}
}
#get free Rechnungs Nummer
sub get_freeReNr(){
my $self = shift;
my ($table,$barcode_start,$barcode_end,$column,$content) = @_;
my $now_time = strftime "%Y-%m-%d %H:%M:%S", localtime;
my $freenr = $db->collect_content3("$table","$column","$content");
my $s_id = $barcode_start;
my $e_id = $barcode_end || 100000;
$freenr->{$s_id}->{barcode} = "1000" if(!$freenr->{$s_id}->{barcode});
for (; $s_id < $e_id; $s_id++){
#if($freenr->{$s_id}->{barcode} != $s_id){
if($freenr->{$s_id}->{ct_name} && $freenr->{$s_id}->{ct_name} !~ /^$s_id/){
open(RENR, ">> $varenv{logdir}/get_freeReNr.log");
print RENR "* $now_time --------------- \n";
print RENR "$table,$barcode_start,$barcode_end,$column,$content\n";
print RENR "for (; $s_id < $e_id; $s_id++){\n";
print RENR "if($freenr->{$s_id}->{ct_name} && $freenr->{$s_id}->{ct_name} !~ /^$s_id/){\n";
print RENR "return $s_id;\n";
close RENR;
return $s_id;
}
}
return 0;
}
#CAsh
sub cashme(){
my $self = shift;
my ($cash,$comma) = @_;
$cash = "0\.00" if($cash !~ /\d/);
$cash = "$cash\.00" if($cash !~ /\./);
$cash = $cash . 0 if($cash =~ /\.\d{1}$/);
$cash =~ s/\./$comma/ if($comma);
return $cash;
}
#umst breaking date 16 19 %
sub umst_breaking(){
my $self = shift;
my $ctt = shift;
my $now_dt = shift || "";#used by payone_cron.pl, because there is no mtime-update on start
#invoice_time will be set by Printpreview.pm invoice generation!
my $i_datetime = $now_dt || $ctt->{invoice_time} || $ctt->{mtime};
my $umst1619 = 19;
my ($i_date,$i_time) = split(/ /,$i_datetime);
my ($yy,$mo,$dd) = split(/-/,$i_date);
my $breaking_date = $yy . $mo . $dd;
$umst1619 = 16 if($breaking_date >= 20200701 && $breaking_date < 20210101);
return $umst1619;
}
#integer check
sub checkint(){
my $self = shift;
my ($int) = @_;
$int =~ s/,/./;
if($int =~ /([-\d]+)\.(\d+)/){
$int = "$1" . "." . "$2";
}elsif($int =~ /([-\d]+)/){
$int = "$1";
}
return $int;
}
# input character check
sub checkinput(){
my $self = shift;
my $node_name = shift;
if($node_name =~ /^[a-zA-Z0-9äöüÄÖÜ_\-\.\ ]+$/){
return 0;
}else{
return "failure::Für die Menue- Ordner Benennung sind nur alphanumerische Zeichen und - . erlaubt ($node_name).";
}
}
# input date check. returns english date and 1 if true
sub true_date(){
my $self = shift;
my ($date,$time) = @_;
$date =~ s/,/./g;
my $d_chck = 0;
if($date =~ /(\d{4})-(\d{2})-(\d{2})/){
$d_chck = 1 if(check_date($1,$2,$3));
$date = "$1-$2-$3";
}elsif($date =~ /(\d{2})\.(\d{2})\.(\d{4})/){
$d_chck = 1 if(check_date($3,$2,$1));
$date = "$3-$2-$1";
}
return ($date,$d_chck);
}
# input date check
sub checkdate(){
my $self = shift;
my ($date,$time) = @_;
$date =~ s/,/./g;
my $d_chck = 1;
my ($c_dd,$c_mm,$c_yy);
if($date =~ /(\d{4})-(\d+)-(\d+)/){
$d_chck = 0 if(check_date($1,$2,$3));
$date = "$1-$2-$3";
}elsif($date =~ /(\d+)\.(\d+)\.(\d+)/){
$d_chck = 0 if(check_date($3,$2,$1));
$date = "$1.$2.$3";
}
return ($date,$d_chck);
}
#collect node_name and builds path
sub make_uri2(){
my $self = shift;
my ($main_id,$lang,$mandantsub_id,$start_id) = @_;
my $gpath;
my $m_id;
my @genpath;
my $i=$1 if($main_id =~ /^(\d)/);
foreach my $id (sort {$nall->{$b}->{main_id} <=> $nall->{$a}->{main_id}} keys (%$nall)){
#print "xxxx ($main_id =~ /^($i\d+)/) && ($start_id && $main_id >= $start_id) && ($main_id == $nall->{$id}->{main_id})<br>";
if(($main_id =~ /^($i\d+)/) && ($start_id && $main_id >= $start_id) && ($main_id == $nall->{$id}->{main_id})){
## wegen multible mandanten sub-sub-level, bsp. Waren/[300] Sonstiges
if($mandantsub_id && $i==3){
if($mandantsub_id == $nall->{$id}->{parent_id}){
$i--;
$main_id = $nall->{$id}->{parent_id};
$m_id = $nall->{$id}->{main_id} if(!$m_id);
$genpath[$i] = "/$nall->{$id}->{node_name}";
#print "$i x/$nall->{$id}->{node_name} ($nall->{$id}->{main_id})<br />";
}
##
}else{
$i--;
$main_id = $nall->{$id}->{parent_id};
$main_id = $start_id if($start_id && $i==1);
$m_id = $nall->{$id}->{main_id} if(!$m_id);
$genpath[$i] = "/$nall->{$id}->{node_name}";
#print "$i /$nall->{$id}->{node_name} ($nall->{$id}->{main_id})<br />";
}
}
}
foreach (@genpath){
#print "$_|";
$_ =~ s/\/root//;
$gpath .= "$_";
}
return ("$m_id","$gpath");
}
#new init for make_uri3 with returning nall object
sub init_nodes5uri(){
my $self = shift;
$nall = $db->collect_node4all();
return $nall;
}
#5. collect node_name and builds path without mandant-logic
sub make_uri5(){
my $self = shift;
my ($main_id,$nall,$depth_start) = @_;
$depth_start = 0 if(!$depth_start);
my $gpath;
my $m_id;
my @genpath;
my $depth=$1 if($main_id =~ /^(\d)/ && $main_id >= 100000);
foreach my $id (sort {$nall->{$b}->{main_id} <=> $nall->{$a}->{main_id}} keys (%$nall)){
if(($main_id =~ /^($depth\d+)/) && ($main_id == $nall->{$id}->{main_id})){
$depth--;
$main_id = $nall->{$id}->{parent_id};
$m_id = $nall->{$id}->{main_id} if(!$m_id);
$genpath[$depth] = "/$nall->{$id}->{node_name}" if($depth > $depth_start);
#print "$depth|$main_id /$nall->{$id}->{node_name} ($nall->{$id}->{main_id})<br />";
}
}
foreach (@genpath){
#print "$_|";
$_ =~ s/\/root//;
$gpath .= "$_";
}
return ("$m_id","$gpath");
}
sub sub4txt(){
my $self = shift;
my ($txt,$index,$length,$cut,$cut_last) = @_;
my $substrtxt = substr($txt, $index, $length);
#$substrtxt =~ s/<br \/>/\n/g;
#$substrtxt =~ s/<b.?//g;
#$substrtxt =~ s/\/>//g;
#$substrtxt =~ s/^[<|\\|\/|>|:|,|\.|\\n]+//g;
#$substrtxt =~ s/^\w+\s// if($index > 20);
#entferne das erste teil-wort ...
if($cut){
$substrtxt =~ s/^[äöü]+//;
$substrtxt =~ s/^\w+//;
$substrtxt =~ s/^\,//;
$substrtxt =~ s/^\.//;
}
#entferne das letzte teil-wort ...
if($cut_last){
$substrtxt =~ s/[äöü]+$//;
$substrtxt =~ s/\w+$//;
$substrtxt =~ s/\,$//;
$substrtxt =~ s/\.$//;
}
#entferne das letzte teil-wort ...
if($index && ($index > $length)){
$substrtxt =~ s/\w+$//;
}
#$substrtxt =~ s/\s\w+$//;
return $substrtxt;
}
sub newline(){
my $self = shift;
my $txtxx = shift;
my $not_used = shift || "";#old
my $editor = shift || "";
$txtxx =~ s/\r\n/<br \/>/g if(!$editor);
return $txtxx;
}
#der tiny_mce editor init
sub wyedit(){
my $self = shift;
my ($users_tiny_mce) = @_;
my $wy="";
if($varenv{js4tiny_mce} && $users_tiny_mce){
$wy = "<script type='text/javascript'>
tinyMCE.init({
theme : \"advanced\",
mode : \"textareas\",
});
</script>";
}
return $wy;
}
#Komplettset compset logic
sub compsum(){
my $self = shift;
my ($main_id,$lang,$owner) = @_;
my $ct4rel = $db->collect_ct4rel("content",$main_id,$lang);#hash
my $ctpers4rel = $db->collect_ctpers4rel($main_id,$lang,$owner);#hash
%$ct4rel = (%$ctpers4rel, %$ct4rel);#hash slice
return $ct4rel;
}
# Rounding like "Kaufmannsrunden"
# Descr. http://de.wikipedia.org/wiki/Rundung
# Inspired by
# http://www.perl.com/doc/FAQs/FAQ/oldfaq-html/Q4.13.html
sub round(){
my $self = shift;
my ($amount) = @_;
$amount = $amount * (10**(2));
my $rounded = int($amount + .5 * ($amount<=> 0)) / (10**(2));
return $rounded;
}
#rounding to half or integer
sub round_half(){
my $self = shift;
my $amount = shift;
$amount = $amount * (10**(2));
my $rounded = int($amount + .5 * ($amount<=> 0)) / (10**(2));
if($rounded =~ /\.\d+/){
$rounded = sprintf('%.2f',$rounded);
my $int = 0;
($int, my $dez) = split(/\./,$rounded) if($rounded =~ /\.\d/);
if($dez > 0 && $dez <= 50){
$dez = 50;
}
elsif($dez > 50 && $dez <= 99){
$dez = 00;
$int++;
}
$rounded = $int . "." . $dez;
}
return $rounded;
}
#split date (moved partly to Callib)
sub split_date(){
my $self = shift;
my ($time_db) = @_;
$time_db =~ s/:\d{2}\..*$// if($time_db);
my ($date,$time) = split(/ /,$time_db);
my ($yy,$mo,$dd);
($yy,$mo,$dd) = split(/-/,$date) if($date =~ /\d{4}-/);
($dd,$mo,$yy) = split(/\./,$date) if($date =~ /\d{2}\./);
my ($hh,$mi) = split(/\:/,$time);
return ($yy,$mo,$dd,$hh,$mi);
}
#time and date format for DE (moved partly to Callib)
sub time4de(){
my $self = shift;
my ($time_db,$hhmi,$decode) = @_;
$time_db =~ s/:\d{2}\..*$// if($time_db);
my ($date,$time) = split(/ /,$time_db);
my ($yy,$mo,$dd) = split(/-/,$date);
my ($hh,$mi) = split(/\:/,$time);
my $date_de = "&nbsp;";
$date_de = "$dd.$mo.$yy";
$date_de = "$dd.$mo.$yy $hh:$mi" if($hhmi);
#Deutsch (German) ==> 3
$date_de = Date_to_Text_Long($yy,$mo,$dd,3) if($decode eq "Date_to_Text_Long");
$date_de =~ s/M.*rz/März/;
return $date_de;
}
#error window
sub failure(){
my $self = shift;
my ($failure,$back) = @_;
print "<div id='Inhalt3'>\n";
print $q->div("$failure");
print $q->div($q->a({-class=>"linknav3",-href=>'javascript:history.back()'}, "[ $back ]")) if($back);
print "</div>\n";
exit 0;
}
sub failure2(){
my $self = shift;
my ($failure,$back) = @_;
print "<div style='background-color:white;'>\n";
print $q->div("$failure");
print $q->div($q->a({-class=>"linknav3",-href=>'javascript:history.back()'}, "[ $back ]")) if($back);
print "</div>\n";
#exit 0;
}
sub failure3(){
my $self = shift;
my ($failure,$back) = @_;
print "<div style='padding:0 1em;background-color:red;color:white;'>\n";
print $q->div("$failure");
print $q->div($q->a({-class=>"linknav3",-href=>'javascript:history.back()'}, "[ $back ]")) if($back);
print "</div>\n";
}
#for site-head navigation with breadcrumb and close button
sub pathrun(){
my $self = shift;
my $path = shift;
my @menu = ("");
if($path =~ /^\/(.*)/){
@menu = split /\//,$1;
}
my $node_active;
my $crumb;
my $h=0;
my $backlink;
foreach(@menu){
$node_active=$_;
$crumb = "<a style='text-decoration:none;' href='/$menu[0]'>$menu[0]</a>" if($h==0);
$backlink = "/" if($h==0);
$crumb .= " | <a style='text-decoration:none;' href='/$menu[0]/$menu[1]'>$menu[1]</a>" if($h==1);
$backlink = "/$menu[0]#$menu[1]" if($h==1);
#cut long link-name
my $length=length($menu[2]);
my $cut_last;
$cut_last = 1 if($length >= 30);
my $menu2 = &sub4txt("",$menu[2],0,30,"","$cut_last");
$crumb .= " | <a style='text-decoration:none;' href='/$menu[0]/$menu[1]/$menu[2]'>$menu2</a>" if($h==2);
$backlink = "/$menu[0]/$menu[1]#$menu[2]" if($h==2);
$h++;
}
return ("$node_active","$crumb","$backlink");
}
1;

2274
copri4/main/src/Mod/Libenzdb.pm Normal file
View file

File diff suppressed because it is too large Load diff

163
copri4/main/src/Mod/MailTransport.pm Normal file
View file

@ -0,0 +1,163 @@
package Mod::MailTransport;
#
# SPDX-License-Identifier: AGPL-3.0-or-later
# Copyright (c) Rainer Gümpelein, TeilRad GmbH
#
# new emailing module
#
#perl -cw src/Mod/MailTransport.pm
#use lib "/var/www/copri4/shareeapp-operator/src";
#
use strict;
use warnings;
use POSIX;
use CGI ':standard';
use Email::MIME;
use IO::All;
use Email::Sender::Simple qw(sendmail);
use Net::SMTP;
use Try::Tiny;
use Config::General;
use Sys::Hostname;
my $hostname = hostname;
use Lib::Config;
use Mod::Basework;
use Mod::DBtank;
use Data::Dumper;
sub new {
my $class = shift;
my $self = {};
bless($self,$class);
return $self;
}
my $q = new CGI;
my $cf = new Config;
my $bw = new Basework;
my $dbt = new DBtank;
my $mailx_file = "/var/www/copri4/shareeconf/mailx.cfg";
my $conf = Config::General->new($mailx_file);
my %mailxconf = $conf->getall;
sub send_mail(){
my $self = shift;
my $sendref = shift;
my $now_dt = strftime "%Y-%m-%d %H:%M:%S", localtime;
my $mail_from = $sendref->{mail_from} || $mailxconf{mailx}->{mail_from};
my $mail_to = $sendref->{mail_to} || $mailxconf{mailx}->{mail_to};
my $subject = $sendref->{subject} || "subject fails";
my $filename = $sendref->{filename} || "";
my $message = $sendref->{message} || "Failure, no message\n";
#If caller use utf8, message is encoded as utf-8
#$message = Encode::encode('utf-8', Encode::decode('iso-8859-1', $message));
#Special tink statisk, readdir with filename
#$filename like "2018-12"
my @files = ($filename);
#disabled because of zipping
#TODO, check what happens about Statistik-occubike_station_2019-1-konrad.csv
#Okay, send_mail breaks on verylong Statistik lines. CSV zipping is the solution
#@files = $lb->read_dirfiles("$dbt->{copri_conf}->{basedir}/csv",$filename,"file","") if($filename =~ /\d+-\d+/);
if($dbt->{copri_conf}->{stage} eq "test"){
$mail_to = $mailxconf{mailx}->{mail_to};
$subject .= " * offline Test *";
}
$bw->log("Trying send_mail:$0",$sendref,"");
if(ref($sendref) eq "HASH"){
$mailxconf{mailx}->{sasl_password} = Encode::encode('iso-8859-1', Encode::decode('utf-8', $mailxconf{mailx}->{sasl_password}));
my $transport = Email::Sender::Transport::SMTPS->new(
host => "$mailxconf{mailx}->{mail_gateway}",
ssl => 'ssl',
port => 465,
sasl_username => "$mailxconf{mailx}->{sasl_username}",
sasl_password => "$mailxconf{mailx}->{sasl_password}",
helo => "$dbt->{primary}->{sharee_primary}->{live_hostname}",
debug => 0,
);
#multipart message
#Email::MIME !!!
if(1==1){
my @parts = ();
my $parts_1 = (
Email::MIME->create(
attributes => {
content_type => "text/plain",
#disposition => "attachment",
encoding => "quoted-printable",
charset => "UTF-8",
},
body_str => "$sendref->{message}",
),
);
push(@parts,$parts_1);
foreach $filename (@files){
if($filename){
my $parts_0 = (
Email::MIME->create(
attributes => {
filename => "$filename",
#content_type => "application/pdf",
#content_type => "text/csv",
content_type => "application/octet-stream",
disposition => "attachment",
encoding => "quoted-printable",
name => "$filename",
},
body => io( "$dbt->{copri_conf}->{basedir}/csv/$filename" )->binary->all,
),
);
$bw->log("Attachment:$dbt->{copri_conf}->{basedir}/csv/$filename","","");
push(@parts,$parts_0);
}
}
$message = Email::MIME->create(
header_str => [ From => "$mail_from",
To => "$mail_to",
Subject => "$subject", ],
parts => [ @parts ],
);
#$message->charset_set( 'UTF-8' );
print $message->as_string;
}#if not Email::Mime
else{
$message = Email::Simple->create(
header => [
From => "$mail_from",
To => "$mail_to",
Subject => "$subject",
],
body => "$sendref->{message}",
);
}
try {
sendmail($message, { transport => $transport });
} catch {
$bw->log("FAILURE send_mail:$0",$sendref,"");
warn "Error sending mail: $_";
};
}
$bw->log("Success send_mail","","");
}#end mail_send
1;

123
copri4/main/src/Mod/Modalbox.pm Normal file
View file

@ -0,0 +1,123 @@
package Modalbox;
#
# SPDX-License-Identifier: AGPL-3.0-or-later
# Copyright (c) Rainer Gümpelein, TeilRad GmbH
#
use strict;
use warnings;
use CGI::Cookie ();
use CGI ':standard';
use CGI::Carp qw(fatalsToBrowser);
use Scalar::Util qw(looks_like_number);
use Lib::Config;
use Mod::Buttons;
use Mod::Libenzdb;
use Mod::DBtank;
sub new {
my $class = shift;
my $self = {};
bless($self,$class);
return $self;
}
sub mobox(){
my ($node_meta,$users_dms,$mode,$return) = @_;
my $q = new CGI;
my $cf = new Config;
my $but = new Buttons;
my $db = new Libenzdb;
my $dbt = new DBtank;
$q->import_names('R');
my @keywords = $q->param;
my %varenv = $cf->envonline();
my $script = $q->script_name();
my $path = $q->path_info();
my $lang = "de";
my $dbh = "";
#TODO do it BrowserTab save
#my $kind_of_trans = $R::kind_of_trans || $users->{kind_of_trans} || "";
#my $c_id4trans = $R::c_id4trans || $users->{c_id4trans} || "";
#my $tpl_id4trans = $R::tpl_id4trans || $users->{tpl_id4trans} || "";
#my $kind_of_trans = $users_dms->{kind_of_trans} || "";
#my $c_id4trans = $users_dms->{c_id4trans} || "";
#my $tpl_id4trans = $users_dms->{tpl_id4trans} || "";
if($users_dms->{kind_of_trans} && looks_like_number($users_dms->{c_id4trans}) && looks_like_number($users_dms->{tpl_id4trans})){
my $width = $node_meta->{tpl_width} || "990";
my $bg_color = "white";
my $bg_color2 = $varenv{term_active_color} || "";
my $table = "contenttrans";
my $ctt = $db->get_content1($table,$users_dms->{c_id4trans});
my ($address_wc,$table_wc) = split(/\./,$ctt->{int04});
my $rows = $address_wc + $table_wc;
my $height = "600";
if($varenv{orga} eq "dms"){
$rows = $rows - 0;
}else{
$rows = $rows - 10;
}
$height += $rows * 15 if($rows > 0);
my $debug;
$debug = "(c_id: $users_dms->{c_id4trans} | tpl_id: $users_dms->{tpl_id4trans})" if($users_dms->{u_id} == $dbt->{copri_conf}->{superu_id});
print<<EOF
<style>
.ui-dialog .ui-dialog-content {
background: $bg_color;
}
.ui-dialog > .ui-widget-header {
color:$varenv{color};
font-weight:normal;
border:1px solid $bg_color2;
background: $bg_color2;
}
.ui-widget-overlay {
background: #666 url("$varenv{metahost}/js/jquery-ui/images/ui-bg_diagonals-thick_20_666666_40x40.png") 50% 50% repeat;
opacity: .5;
filter: Alpha(Opacity=50);
}
</style>
<script>
\$(function() {
\$( "#dialog-form" )
.css("background-color","$bg_color")
.dialog({
height: $height,
width: $width,
//show: { effect: 'drop', direction: "up" } ,
closeOnEscape: true,
zIndex: 1010000000000,
modal: true
});
\$('.ui-widget-overlay').click(function() {
\$(".ui-dialog-titlebar-close").trigger('click');
});
\$('.ui-dialog').css('z-index',9999);
});
</script>
EOF
;
print "<div id='dialog-form' style='text-align:center;margin:0;padding:2px;max-width:1200px;' title='Terminal – $users_dms->{kind_of_trans} $debug'>";
if($users_dms->{kind_of_trans} && looks_like_number($users_dms->{c_id4trans}) && looks_like_number($users_dms->{tpl_id4trans})){
if($table eq "contenttrans" && $varenv{orga} eq "dms"){
require "Tpl/Address3.pm";
&Address3::tpl($node_meta,$users_dms,$return);
}
}else{
print $q->div({-style=>"padding:0.1em;margin:0em;background-color:white;font-size:0.81em;"}, "Ein neues Formular kann im COPRI Hauptfenster geöffnet werden (Code: $users_dms->{kind_of_trans} && $users_dms->{c_id4trans} && $users_dms->{tpl_id4trans})",
"\n");
}
print "</div>\n";
}
}
1;

140
copri4/main/src/Mod/Modalbox3.pm Normal file
View file

@ -0,0 +1,140 @@
package Modalbox3;
# SPDX-License-Identifier: AGPL-3.0-or-later
# Copyright (c) Rainer Gümpelein, TeilRad GmbH
use strict;
use warnings;
use CGI::Cookie ();
use CGI ':standard';
use CGI::Carp qw(fatalsToBrowser);
use Lib::Config;
use Mod::Buttons;
use Mod::DBtank;
sub new {
my $class = shift;
my $self = {};
bless($self,$class);
return $self;
}
sub mobox3(){
my ($node_meta,$users_dms,$mode,$return) = @_;
#my ($return) = @_;
my $q = new CGI;
my $cf = new Config;
my $dbt = new DBtank;
my $but = new Buttons;
$q->import_names('R');
my @keywords = $q->param;
my %varenv = $cf->envonline();
my $script = $q->script_name();
my $path = $q->path_info();
my $coo = $q->cookie(-name=>'domcookie');
my $dbh = "";
if($node_meta->{main_id} > 100){
my $bg_color = "white";
my $bg_color2 = $node_meta->{bg_color} || "grey";
my $title = "Content Editor \"$node_meta->{tpl_name}\"";
$title = "Artikel Editor" if($node_meta->{ct_table} eq "content");
$title = "Kunden Editor" if($node_meta->{ct_table} eq "contentadr");
$title = "DMS-Account Zugriffsberechtigung" if($node_meta->{ct_table} eq "users");
$title = "Service Editor" if($node_meta->{ct_table} eq "contentpos");
my $height = $node_meta->{tpl_height} || "990";
my $width = $node_meta->{tpl_width} || "990";
if($mode eq "maintainer"){
$title = "Node Editor";
$height = "300";
$width = "600";
}elsif($mode eq "supervisor"){
$title = "Datenfeld Eigenschaft bearbeiten";
$height = "450";
$width = "500";
}elsif($R::rel_edit =~ /dialog4menu|dialog4content/){
$title = "Relation Editor";
$height = "300";
$width = "550";
}
print<<EOF
<style>
.ui-dialog .ui-dialog-content {
background: $bg_color;
}
.ui-dialog > .ui-widget-header {
color:black;
font-weight:normal;
border:1px solid $bg_color2;
background: $bg_color2;
}
.ui-widget-overlay {
background: #666 url("$varenv{metahost}/js/jquery-ui/images/ui-bg_diagonals-thick_20_666666_40x40.png") 50% 50% repeat;
opacity: .5;
filter: Alpha(Opacity=50);
}
</style>
<script>
\$(function() {
\$( "#dialog-form3" )
.css("background-color","$bg_color")
.dialog({
height: $height,
width: $width,
closeOnEscape: true,
modal: true
});
\$('.ui-widget-overlay').click(function() {
\$(".ui-dialog-titlebar-close").trigger('click');});
\$('.ui-dialog').css('z-index',9999);
});
</script>
EOF
;
print "<div id='dialog-form3' style='text-align:left;margin:auto;max-width:1400px;' title='$title'>\n";
print $q->start_multipart_form(-name=>"editform");
if($R::node2edit && $R::node2edit =~ /new_relation|edit_relation/){
if($node_meta->{ct_table} eq "content" && $node_meta->{template_id} eq "205"){
require "Mod/NodeEdit.pm";
&NodeEdit::admin_tpl($node_meta,$users_dms,$mode,$return);
}elsif($users_dms->{u_id} == $dbt->{copri_conf}->{superu_id}){
require "Mod/NodeEdit.pm";
&NodeEdit::admin_tpl($node_meta,$users_dms,$mode,$return,"only superu_id");
}else{
print $q->div("Dieses Menue ist zur Bearbeitung nicht freigegeben.");
}
}
#elsif($node_meta->{ct_table} eq "contentpos"){
# require "Tpl/APIdialog.pm";
# &APIdialog::tpl($node_meta,$users_dms,$mode,$return);
#}
elsif($R::relate_dialog || $R::rel_edit =~ /dialog4menu|dialog4content/){
require "Mod/RelationEdit.pm";
&RelationEdit::tpl($node_meta,$users_dms,$mode,$return);
}
elsif($mode eq "supervisor"){
require "Tpl/AttributEdit.pm";
&AttributEdit::tpl($node_meta,$users_dms,$mode,$return);
}
elsif(($R::node2edit && $R::node2edit =~ /editpart/) || ($R::base_edit && $R::base_edit !~ /delete/)){
require "Tpl/BaseEdit.pm";
&BaseEdit::tpl($node_meta,$users_dms,$mode,$return);
}
else{
print $q->div("Zugriff verweigert.");
}
print $q->end_form;
print "</div>\n";
}
}
1;

199
copri4/main/src/Mod/NodeEdit.pm Normal file
View file

@ -0,0 +1,199 @@
package NodeEdit;
#
# SPDX-License-Identifier: AGPL-3.0-or-later
# Copyright (c) Rainer Gümpelein, TeilRad GmbH
#
#
use strict;
use warnings;
use CGI::Carp qw(fatalsToBrowser);
use CGI ':standard';
use Lib::Config;
use Mod::Buttons;
use Mod::Libenz;
use Mod::Libenzdb;
use Mod::Basework;
use Mod::DBtank;
use Mod::Relation;
use Data::Dumper;
sub new {
my $class = shift;
my $self = {};
bless($self,$class);
return $self;
}
#Template
sub admin_tpl(){
my $node_meta = shift;
my $users_dms = shift;
my $u_group = shift;
my $return = shift;
my $superu_id = shift || "";
#print Dumper($node_meta);exit;
my $q = new CGI;
my @keywords = $q->param;
my $cf = new Config;
my $lb = new Libenz;
my $db = new Libenzdb;
my $bw = new Basework;
my $dbt = new DBtank;
my $but = new Buttons;
my $relform = new Relation;
my %varenv = $cf->envonline();
my $script = $q->script_name();
my $path = $q->path_info();
$path = "$script" . "$path";
my $lang = "de";
#$path =~ s/\/login|\/user|\/manager|\/admin//;
my $coo = $q->cookie(-name=>'domcookie');
my %ib = $but->ibuttons();
my $dbh = "";
my $u_name = $node_meta->{owner};
$u_name = $dbt->sys_username($dbh,$node_meta->{owner});
my $change = $lb->time4de($node_meta->{change},"1") if($node_meta->{change});
my $subid = $1 if($node_meta->{main_id} =~ /^(\d)/);
my $ctf = $db->get_content1("contentuser",$dbt->{shareedms_conf}->{parent_id});
#Node templates
my $tpl_id = 97;#Standard for CMS
#Selektierbare Tabellen Layout templates
my $tpl_lists4selection;
#if($node_meta->{ct_table} eq "content" || $node_meta->{ct_table} eq "contentpos"){
if($node_meta->{ct_table} eq "content"){
$tpl_id = 100;
if($node_meta->{template_id} eq "205"){
#$tpl_id = 102;
$tpl_lists4selection = 205;
}elsif($node_meta->{template_id} eq "225"){
$tpl_lists4selection = 225;
}elsif($node_meta->{template_id} eq "210"){
$tpl_lists4selection = 210;
}else{
$tpl_lists4selection = "224,226,227,228,229";
#$tpl_lists4selection .= "," . $ctf->{txt35} if($ctf->{txt35});#pos tpl-id's
}
}elsif($node_meta->{ct_table} eq "contenttrans"){
$tpl_id = "101";
$tpl_lists4selection = "218";
}elsif($node_meta->{ct_table} eq "contenttranspos"){
$tpl_id = "101";
$tpl_lists4selection = "221,222";
}elsif($node_meta->{ct_table} eq "contentadr" || $node_meta->{ct_table} eq "contentadrpos"){
$tpl_id = "101";
$tpl_lists4selection = $ctf->{txt38};
$tpl_lists4selection .= "," . $ctf->{txt31} if($ctf->{txt31});#pos tpl-id's
}
#Defaults to tpl_id=97
my $tpl = $db->get_tpl($tpl_id);
my @tpl_order = ("");
@tpl_order = split /,/,$tpl->{tpl_order};
my @_templates;
my $tpl_all = $db->collect_tpl($tpl_lists4selection);
foreach my $id (sort {$tpl_all->{$a}->{tpl_name} cmp $tpl_all->{$b}->{tpl_name}} keys (%$tpl_all)){
push (@_templates, "$id:$tpl_all->{$id}->{tpl_name}") if($tpl_all->{$id}->{tpl_name} !~ /dummy/);
}
#reading mounted project data-dir
#Test: mount /dev/sda2 data/Projekte
my @_projectdir;
#my $dir = "$varenv{data}/Projekte";
my $dir = "$varenv{data}/fileserver";
if( -d "$dir"){
opendir(DIR, "$dir");
foreach(sort(readdir(DIR))){
push (@_projectdir, "$_");
}
closedir DIR;
}
#content container
print "<div id='Container_cms'>$superu_id";
print $q->start_table({-style=>'margin-top:6px;', -border=>'0', -width=>'100%', -align=>'left', -cellpadding=>'3', -cellspacing=>'3'});
print $q->Tr();
if(1==1){
if(($users_dms->{u_id} > 0) || ($u_group eq "admin")){
print "<td style='background:$varenv{background_color2};margin:1px 0;padding:2px;' colspan='2' nowrap>\n";
#print "<td style='margin:1px 0;padding:0px;' colspan='2' nowrap>\n";
print $but->singlesubmit7("rel_edit","save_relation","$ib{save_relation}","","modal_position(xpos,ypos)");
#look at dialog4menu, it seems better. vise a verse
print $q->span({-style=>'margin:0 0.2em;'}," ");
print $but->singlesubmit7("rel_edit","delete_relation","$ib{delete_relation}","","modal_position(xpos,ypos)");
print $q->span({-style=>'margin:0 0.2em;'}," ");
print $but->singlesubmit7("rel_edit","new_relation","$ib{new_relation}","","modal_position(xpos,ypos)");
#$R::new_submenu = 1 if($subid < 4);
print $q->span({ -style=>'margin:4px 0 0 4px;'},$but->checkbox("1","new_submenu","$R::new_submenu"),"Submenu") if($subid < 3 && $node_meta->{template_id} !~ /205/);#no submenue if bikes);
print $q->span({-style=>'margin-left:5em; font-size:0.91em;'}, "$u_name / $change") if($u_name);
print "</td>\n";
print $q->hidden(-name=>'last_node_name', -value=>"$node_meta->{node_name}");
print $q->hidden(-name=>'owner', -value=>"$users_dms->{u_id}");
print $q->hidden(-name=>'parent_id', -value=>"$node_meta->{parent_id}");
print $q->hidden(-name=>'main_id', -value=>"$node_meta->{main_id}");
print $q->hidden(-name=>'mode', -value=>"admin");
print $q->Tr();
print $q->td({-colspan=>'2',-style=>'padding:5px;font-style:italic;'},"Path: $path");
foreach (@tpl_order){
my ($key,$des,$isize) = split /=/,$_;
$des .= " ($key)" if($users_dms->{u_id} eq $varenv{superu_id});
#print "$key, $des, $isize|";
$isize = "20" if(!$isize);
if($key =~ /node_public|footer/){
print $q->Tr();
print $q->td({-class=>'left_italic_cms'},"$des"),"\n";
print $q->td({-class=>'content1_cms'},$but->checkbox("1","$key","$node_meta->{$key}")),"\n";
}elsif($key =~ /txt01/ && $isize =~ /select/){
print $q->Tr();
print $q->td({-class=>'left_italic_cms'},"$des"),"\n";
print $q->td({-class=>'content1_cms'},$but->selector("$key","250px","$node_meta->{$key}",@_projectdir)),"\n";
}elsif($key =~ /tpl_name/){
print $q->Tr();
print $q->td({-class=>'left_italic_cms'},"$des"),"\n";
print $q->td({-class=>'content1_cms'},$but->selector("template_id","200px",$node_meta->{template_id},@_templates)),"\n";
}elsif($key eq "txt01" && $isize eq "select"){
my @_valxx = ("");
#TODO
#foreach my $rid (sort { $bike_nodes->{$a}->{node_name} cmp $bike_nodes->{$b}->{node_name} } keys (%$bike_nodes)){
# push (@_valxx, "$bike_nodes->{$rid}->{main_id}:$bike_nodes->{$rid}->{node_name} - $bike_nodes->{$rid}->{main_id}");
#}
print $q->Tr();
print $q->td({-class=>'left_italic_cms',-colspan=>'1'},"$des");
print $q->td({-class=>'content1_cms',-colspan=>'1'},$but->selector_class("$key","eselect","width:250px;",$node_meta->{$key},@_valxx));
}elsif($key =~ /node_name/){
print $q->Tr();
print $q->td({-class=>'left_italic_cms'},"$des");
print $q->td({-class=>'content1_cms'},$q->textfield(-class=>'etxt',-name=>"$key",-default=>"$node_meta->{$key}",-override=>'1',-size=>"$isize",-maxlength=>120)),"\n";
}elsif($key =~ /n_sort/){
print $q->Tr();
print $q->td({-class=>'left_italic_cms'},"$des");
print $q->td({-class=>'content1_cms'},$q->textfield(-class=>'etxt',-name=>"$key",-default=>"$node_meta->{$key}",-override=>'1',-size=>"$isize",-maxlength=>120)),"\n";
}
}
}
}else{
print $q->div({-style=>'text-align:left;margin:0.5em;padding:1em;background-color:white;'},"Im \"admin\" Modus können die Gruppen-Ordner verwaltet werden.<br />--> Dazu erst einen Gruppen-Ordner öffnen!");
}
print $q->end_table;
my $debug;
$debug = "(ct_table: $node_meta->{ct_table} | main_id: $node_meta->{main_id} | tpl_id: $node_meta->{template_id} " if($users_dms->{u_id} == $dbt->{copri_conf}->{superu_id});
print $q->div({-style=>'position:absolute;bottom:2%;right:2%;z-index:10;font-size:13px;'},"$debug"),"\n";
print "</div>";
}
1;

700
copri4/main/src/Mod/Payment.pm Normal file
View file

@ -0,0 +1,700 @@
package Payment;
#
# SPDX-License-Identifier: AGPL-3.0-or-later
# Copyright (c) Rainer Gümpelein, TeilRad GmbH
#
#Adapted from Prelogic Rechnung "buchen" and "print_pdf"
#Adapted from payone_post.pl
#
#enable for syntax check
#use lib "/var/www/copri4/shareedms-primary/src";
use strict;
use warnings;
use POSIX;
use CGI; # only for debugging
use LWP::UserAgent;
use URI::Encode;
my $uri_encode = URI::Encode->new( { encode_reserved => 1 } );
use Scalar::Util qw(looks_like_number);
use Lib::Config;
use Mod::Libenz;
use Mod::Libenzdb;
use Mod::Callib;
use Mod::DBtank;
use Mod::Basework;
use Data::Dumper;
my $q = new CGI;
my $cf = new Config;
my $lb = new Libenz;
my $db = new Libenzdb;
my $cal = new Callib;
my $dbt = new DBtank;
my $bw = new Basework;
sub new {
my $class = shift;
my $self = {};
bless($self,$class);
return $self;
}
my $ua = LWP::UserAgent->new(
ssl_opts => {
SSL_version => 'TLSv12:!SSLv2:!SSLv3:!TLSv1:!TLSv11',
}
);
$ua->agent("sharee payone POST API");
my $now_dt = strftime "%Y-%m-%d %H:%M:%S", localtime;
#ported from payone_post.pl
#SEPA
#Request "managemandate"
sub managemandate_main {
my $self = shift;
my $varenv = shift;
my $ctadr = shift;
my $ctt = shift || "";
my $owner = shift || 0;
my $payoneret = "";
my $payone_conf = $dbt->{operator}->{$varenv->{dbname}}->{payone_conf} || $dbt->{payone_conf};
if($ctadr->{c_id}){
my $lastname = $ctadr->{txt01};
(my $firstname,$lastname) = split(/\s+/,$ctadr->{txt01}) if($ctadr->{txt01} =~ /\w\s+\w/i);
chomp($firstname);
chomp($lastname);
my $city = $ctadr->{txt06};
(my $zip, $city) = split(/\s+/,$ctadr->{txt06}) if($ctadr->{txt06} =~ /[\w\d]\s+[\w\d]/i);
chomp($zip);
chomp($city);
$ctadr->{txt06} =~ s/[\d\s]+//g;
$ctadr->{txt22} =~ s/\s//g;
my $bcountry = uc($1) if($ctadr->{txt22} && $ctadr->{txt22} =~ /^(\w{2})/);
my $currency = "EUR";
$currency = "CHF" if($bcountry eq "CH");
$ctadr->{txt23} =~ s/\s//g;
my $preauth_request = {
request => 'managemandate',
clearingtype => 'elv',
salution => "$ctadr->{txt02}",
firstname => "$firstname",
lastname => "$lastname",
street => "$ctadr->{txt03}",
zip => "$zip",
city => "$city",
country => "$ctadr->{txt10}",
email => "$ctadr->{txt08}",
telephonenumber => "$ctadr->{txt07}",
currency => "$currency",
iban => uc($ctadr->{txt22}),
bic => uc($ctadr->{txt23})
};
my $request = { %$payone_conf, %$preauth_request};
$payoneret = $self->rpc("managemandate",$varenv,$request,$ctadr,$ctt,$owner) if($request);
}
return $payoneret;
}
#Request "preauthorizationSEPA"
sub preauthorizationSEPA_main {
my $self = shift;
my $varenv = shift;
my $ctadr = shift;
my $ctt = shift;
my $owner = shift || 0;
my $payoneret = "";
my $payone_conf = $dbt->{operator}->{$varenv->{dbname}}->{payone_conf} || $dbt->{payone_conf};
my $dbh = "";
#to get actual data
my $pref = {
table => "contenttrans",
fetch => "one",
template_id => 205,
c_id => $ctt->{c_id},
};
my $ctt_up = $dbt->fetch_record($dbh,$pref);
$ctt->{ct_name} = $ctt_up->{ct_name};
if($ctt->{renewed}){
$ctt->{ct_name} = $ctt_up->{ct_name};
if($ctt_up->{ct_name} =~ /\d+-\d+/){
my ($ct_name,$subname) = split(/-/,$ctt_up->{ct_name});
$subname++;
$ctt->{ct_name} = "$ct_name-$subname";
}else{
$ctt->{ct_name} = "$ctt_up->{ct_name}-1";
}
}
if(!$ctt->{reference}){
$ctt->{reference} = $dbt->{operator}->{$varenv->{dbname}}->{oprefix} . "-" . $ctt->{ct_name};
}
#2019-05-18, makes only sense if int15 alias $sum_preauth > 0
if($ctadr->{c_id} && $ctt->{c_id} && $ctt->{int15} > 0){
my $lastname = $ctadr->{txt01};
(my $firstname,$lastname) = split(/\s+/,$ctadr->{txt01}) if($ctadr->{txt01} =~ /\w\s+\w/i);
chomp($firstname);
chomp($lastname);
my $city = $ctadr->{txt06};
(my $zip, $city) = split(/\s+/,$ctadr->{txt06}) if($ctadr->{txt06} =~ /[\w\d]\s+[\w\d]/i);
chomp($zip);
chomp($city);
$ctadr->{txt22} =~ s/\s//g;
#my $bcountry = uc($1) if($ctadr->{txt22} && $ctadr->{txt22} =~ /^(\w{2})/);
my $currency = "EUR";
#$currency = "CHF" if($bcountry eq "CH");
$ctadr->{txt23} =~ s/\s//g;
my $amount = 0;
$amount = $ctt->{int15} * 100 if($ctt->{int15});
my $preauth_request = {
request => 'preauthorization',
clearingtype => 'elv',
salution => "$ctadr->{txt02}",
firstname => "$firstname",
lastname => "$lastname",
street => "$ctadr->{txt03}",
zip => "$zip",
city => "$city",
country => "$ctadr->{txt10}",
email => "$ctadr->{txt08}",
telephonenumber => "$ctadr->{txt07}",
#sequencenumber => "0",
amount => "$amount",
currency => "$currency",
iban => uc($ctadr->{txt22}),
bic => uc($ctadr->{txt23}),
reference => "$ctt->{reference}"
};
$preauth_request->{ip} = "$ctadr->{txt25}" if($ctadr->{txt25} && $ctadr->{txt25} =~ /\d+\.\d+\.\d+\.\d+/);
my $request = { %$payone_conf, %$preauth_request};
$payoneret = $self->rpc("preauthorizationSEPA",$varenv,$request,$ctadr,$ctt,$owner) if($request);
}
return $payoneret;
}
#Request "captureSEPA"
sub captureSEPA_main {
my $self = shift;
my $varenv = shift;
my $ctadr = shift;
my $ctt = shift;
my $owner = shift || 0;
my $payoneret = "";
my $payone_conf = $dbt->{operator}->{$varenv->{dbname}}->{payone_conf} || $dbt->{payone_conf};
if($ctt->{c_id} && (!$ctt->{state} || $ctt->{int14})){
my $amount = 0;
$amount = $ctt->{int01} * 100 if($ctt->{int01});
my $currency = "EUR";
my $preauth_request = {
request => 'capture',
amount => "$amount",
currency => "$currency",
txid => "$ctt->{txt16}"
};
my $request = { %$payone_conf, %$preauth_request};
$payoneret = $self->rpc("captureSEPA",$varenv,$request,$ctadr,$ctt,$owner) if($request);
}
return $payoneret;
}
#CC
#Request "preauthorizationCC"
sub preauthorizationCC_main {
my $self = shift;
my $varenv = shift;
my $ctadr = shift;
my $ctt = shift;
my $owner = shift || 0;
my $payoneret = "";
my $payone_conf = $dbt->{operator}->{$varenv->{dbname}}->{payone_conf} || $dbt->{payone_conf};
my $dbh = "";
#to get actual data
my $pref = {
table => "contenttrans",
fetch => "one",
template_id => 218,
c_id => $ctt->{c_id},
};
my $ctt_up = $dbt->fetch_record($dbh,$pref);
$ctt->{ct_name} = $ctt_up->{ct_name};
if($ctt->{renewed}){
$ctt->{ct_name} = $ctt_up->{ct_name};
if($ctt_up->{ct_name} =~ /\d+-\d+/){
my ($ct_name,$subname) = split(/-/,$ctt_up->{ct_name});
$subname++;
$ctt->{ct_name} = "$ct_name-$subname";
}else{
$ctt->{ct_name} = "$ctt_up->{ct_name}-1";
}
}
if(!$ctt->{reference}){
$ctt->{reference} = $dbt->{operator}->{$varenv->{dbname}}->{oprefix} . "-" . $ctt->{ct_name};
}
#2019-05-18, makes only sense if int15 alias $sum_preauth > 0
if($ctadr->{c_id} && $ctt->{c_id} && $ctt->{int15} > 0){
my $lastname = $ctadr->{txt01};
(my $firstname,$lastname) = split(/\s+/,$ctadr->{txt01}) if($ctadr->{txt01} =~ /\w\s+\w/);
chomp($firstname);
chomp($lastname);
my $city = $ctadr->{txt06};
(my $zip, $city) = split(/\s+/,$ctadr->{txt06}) if($ctadr->{txt06} =~ /[\w\d]\s+[\w\d]/);
chomp($zip);
chomp($city);
my $amount = 0;
$amount = $ctt->{int15} * 100 if($ctt->{int15});
my $preauth_request = {
request => 'preauthorization',
clearingtype => 'cc',
salution => "$ctadr->{txt02}",
firstname => "$firstname",
lastname => "$lastname",
street => "$ctadr->{txt03}",
zip => "$zip",
city => "$city",
country => "$ctadr->{txt10}",
email => "$ctadr->{txt08}",
telephonenumber => "$ctadr->{txt07}",
#sequencenumber => '0',
amount => "$amount",
currency => 'EUR',
#Parameter ( personal data )
lastname => "$ctadr->{txt01}",
country => "$ctadr->{txt10}",
pseudocardpan => "$ctadr->{ct_name}",
ecommercemode => "internet", # wird zu 3Dscheck,
reference => "$ctt->{reference}"
};
# https://docs.payone.com/display/public/PLATFORM/Special+remarks+-+Recurring+transactions+credit+card
# https://docs.payone.com/display/public/INT/Best+Practices+for+PSD2#tab-3DS+2.0+Best+Case
$preauth_request->{ip} = "$ctadr->{txt25}" if($ctadr->{txt25} && $ctadr->{txt25} =~ /\d+\.\d+\.\d+\.\d+/);
my $request = { %$payone_conf, %$preauth_request};
$payoneret = $self->rpc("preauthorizationCC",$varenv,$request,$ctadr,$ctt,$owner) if($request);
}
return $payoneret;
}
#Request "captureCC"
sub captureCC_main {
my $self = shift;
my $varenv = shift;
my $ctadr = shift;
my $ctt = shift;
my $owner = shift || 0;
my $payoneret = "";
my $payone_conf = $dbt->{operator}->{$varenv->{dbname}}->{payone_conf} || $dbt->{payone_conf};
if($ctt->{c_id} && (!$ctt->{state} || $ctt->{int14} || $ctt->{txt28})){
my $amount = 0;
$amount = $ctt->{int01} * 100 if($ctt->{int01});
my $preauth_request = {
request => 'capture',
amount => "$amount",
currency => 'EUR',
txid => "$ctt->{txt16}"
};
my $request = { %$payone_conf, %$preauth_request};
$payoneret = $self->rpc("captureCC",$varenv,$request,$ctadr,$ctt,$owner) if($request);
}
return $payoneret;
}
#TODO
#with previous preauthorization/ authorization and clearingtype=”elv”:
#An “amount = 0” can be used to cancel a
#direct debit transaction. This is not possible if the parameter “due_time” has
#been used, if the portal has enabled a delayed settlement (setup by PAYONE) or
#the direct debit has already been processed (after midnight).
#./src/scripts/payone_post.pl $varenv{syshost} refund contenttrans "" 6799 4
##Request "refund" (Rückerstattung)
#txt16=txid must be copied from last captured invoice.
#int01 sum must be set!
#sequenz = 2
#sudo su www-data -c "./src/scripts/payone_post.pl tinkdms refund contenttrans '' 32332 2"
sub refund {
my $self = shift;
my $varenv = shift;
my $ctadr = shift;
my $ctt = shift;
my $owner = shift || 0;
my $sequenz = shift || 0;
my $payoneret = "";
my $payone_conf = $dbt->{operator}->{$varenv->{dbname}}->{payone_conf} || $dbt->{payone_conf};
if($ctt->{c_id}){
my $amount = 0;
$amount = $ctt->{int01} * 100 if($ctt->{int01});
my $currency = "EUR";
my $preauth_request = {
request => 'refund',
sequencenumber => "$sequenz",#$sequenz= must be +1 of the last capture
amount => "$amount",
currency => "$currency",
txid => "$ctt->{txt16}"
};
my $request = { %$payone_conf, %$preauth_request};
$payoneret = $self->rpc("refund",$varenv,$request,$ctadr,$ctt,$owner) if($request);
}
return $payoneret;
}
####################################################################################
#Create a request
sub rpc {
my $self = shift;
my $todo = shift;
my $varenv = shift;
my $request = shift;
my $ctadr = shift || { c_id => 0 };
my $ctt = shift || { c_id => 0 };
my $owner = shift || 0;
my $payoneret = "";
my $dbh = "";
#payone API URL
my $payoneLive = 1;
my $httpReqServer = "https://api.pay1.de/post-gateway/";
my $req = HTTP::Request->new(POST => "$httpReqServer");
my $post;
foreach (keys (%$request)){
my $encoded_val = $uri_encode->encode($request->{$_});
$post .= "$_=$encoded_val&";
}
$post =~ s/\&$//;
$req->content_type('application/x-www-form-urlencoded');
$req->content($post);
#Pass request to the user agent and get a response back
my $res = $ua->request($req);
my $vde_on_fail = $ctadr->{int12} || 1;#keep last or set 1
my $debug=0;
$debug=1;
my $update_adr = {
table => "contentadr",
mtime => "now()",
owner => $owner
};
my $update_ctt = {
table => "contenttrans",
mtime => "now()",
owner => $owner
};
open(FILE,">>$varenv->{logdir}/payone-return-post.log") if($debug);
print FILE "\n*** $now_dt (ctadr_id:$ctadr->{c_id}, ctt_id:$ctt->{c_id}) from payone_post.pl\n$httpReqServer \n" if($debug);
print FILE "---> request to payone $todo:\n$post\n";
#Payone CONFIGURATION TransactionStatus URL:
#https://tinkrpc.copri.eu/src/scripts/postread_server.pl
#Check the outcome of the response
if ($res->is_success) {
print FILE "<--- return from payone $todo:\n" . $res->content . "\n" if($debug);
#print FILE Dumper($res);
my @content = split(/\n/,$res->content);
print FILE $res->status_line, "\n" if($debug);
if($res->content =~ /status=APPROVED|status=REDIRECT/){
#SEPA
if($todo =~ /managemandate/){
my $mival = "";
$mival = $1 if($res->content =~ /mandate_identification=(.*)/);
$payoneret = $mival;
print FILE "mival: $mival && $ctadr->{c_id}\n" if($debug);
if($mival && $ctadr->{c_id}){
foreach(@content){
my ($key,$val) = split(/=/,$_);
$val = $q->escapeHTML("$val");
$update_adr->{txt22} = $val if($key eq "iban");
$update_adr->{txt23} = $val if($key eq "bic");
$update_adr->{ct_name} = $val if($key eq "mandate_identification");
$update_adr->{txt27} = $val if($key eq "mandate_status");
$update_adr->{txt28} = $val if($key eq "mandate_text" && ($val =~ /SEPA/ || !$val));
}
$update_adr->{int12} = 0;#Vde
$dbt->update_record($dbh,$update_adr,$ctadr) if($ctadr->{c_id} > 0);
my $ret = $self->pdfmandat($varenv,$ctadr->{c_id});
print FILE "pdfmandat call generates: $ret\n" if($debug);
}elsif($ctadr->{c_id}){
$update_adr->{int12} = $vde_on_fail;#Vde
}
}
my $txidval = "";
#CC and SEPA after preauthorization
if($todo =~ /preauthorization/){
$txidval = $1 if($res->content =~ /txid=(\d+)/);
$payoneret = $txidval;
print FILE "$todo: $txidval && $ctt->{c_id} && $ctadr->{c_id}\n" if($debug);
my $useridval = $1 if($res->content =~ /userid=(\d+)/);#2020-02-11 preauthorization returns payone Debitorennr
$update_ctt->{ct_name} = $ctt->{ct_name} if($ctt->{ct_name});
if($txidval && $ctt->{c_id} && $ctadr->{c_id}){
$update_ctt->{int03} = $ctadr->{int03};
$update_ctt->{int17} = $useridval if($useridval);
$update_ctt->{txt16} = $txidval;
$update_ctt->{txt22} = $ctt->{renewed} if($ctt->{renewed});
$update_ctt->{txt26} = $ctadr->{ct_name};#Mandat/pseudocp
$update_ctt->{txt28} = "";
$update_adr->{int12} = 0;
$update_adr->{int17} = $useridval if($useridval);
$update_adr->{txt28} = "";
}elsif($ctadr->{c_id}){
$update_ctt->{int14} = 1;#OPOS
$update_ctt->{txt28} = $now_dt . $res->content;
$update_adr->{int12} = $vde_on_fail;#Vde
}
}
#Capture
if($todo =~ /capture/){
$txidval = $1 if($res->content =~ /txid=(\d+)/);
$payoneret = $txidval;
print FILE "$todo: ($txidval && $ctt->{c_id} && $ctadr->{c_id})\n" if($debug);
if($txidval && $ctt->{c_id} && $ctadr->{c_id} && $res->content =~ /settleaccount=/){
#int01 and state will be set by "buchen" via Prelogic
$update_ctt->{int14} = "null";
$update_ctt->{txt28} = "";
$update_adr->{int12} = 0;
$update_adr->{txt28} = "";
}else{#because of Prelogic logic set it empty if no capture
$update_ctt->{int14} = 1;#OPOS
$update_ctt->{txt28} = $now_dt . $res->content;
$update_adr->{int12} = $vde_on_fail;#Vde
#system(`$varenv->{basedir}/src/Mod/newsletter_tink.pl "$varenv->{basedir}" "$varenv->{wwwhost}" "send_capture_fail" "$ctadr->{c_id}" "$ctt->{ct_name}"`);
}
}
}else{#not APPROVED
print FILE "not APPROVED: ($ctt->{c_id} && $res->content)\n" if($debug);
$update_ctt->{int14} = 1 if($ctt->{state} && $ctt->{state} !~ /Zahlungseingang/);;#OPOS
#errormessage=Reference number already exists --> disabled
#errormessage=Amount no longer available --> disabled
if($res->content !~ /errorcode=911/){
my $payone_message = "$now_dt\n" . $res->content . "\nAufgrund der payone Ablehnung wurde der Verleih gesperrt. Die Bankdaten müssen überarbeitet werden\n";
if($payoneLive == 1 && $ctadr->{c_id}){
$update_ctt->{txt28} = $payone_message;
$update_adr->{txt28} = $payone_message;
#never delete on state=occupied, in this case ist must delete it on available
if($res->content !~ /errorcode=80/){
$update_adr->{int12} = $vde_on_fail;#Vde
}
}
if($payoneLive == 1 && $ctt->{c_id}){
$update_adr->{txt28} = $payone_message;
}
}else{
if($payoneLive == 1 && $ctt->{c_id}){
my $payone_message = "$now_dt\n" . $res->content . "\n";
$update_ctt->{txt28} = $payone_message;
$update_adr->{txt28} = $payone_message;
}
}
}
}else {
print FILE $res->status_line, "\n" if($debug);
}
close(FILE) if($debug);
$dbt->update_record($dbh,$update_adr,$ctadr) if($ctadr->{c_id} > 0);
$dbt->update_record($dbh,$update_ctt,$ctt) if($ctt->{c_id} > 0);
return $payoneret;
}
#SEPA PDFGenerator
sub pdfmandat {
my $self = shift;
my $varenv = shift;
my $c_id = shift || 0;
my $dbh = "";
my $authref = {
table => "contentadr",
fetch => "one",
template_id => "202",
c_id => "$c_id",
};
my $ctadr = $dbt->fetch_record($dbh,$authref);
open(EMA, ">> $varenv->{logdir}/SEPA-PDFprint.log");
print EMA "*** $now_dt trying pdf --> $varenv->{basedir}/pdfinvoice/SEPA-Lastschriftmandat-$varenv->{dbname}-$ctadr->{ct_name}.pdf && $ctadr->{txt27}\n";
if((! -f "$varenv->{basedir}/pdfinvoice/SEPA-Lastschriftmandat-$varenv->{dbname}-$ctadr->{ct_name}.pdf") && $ctadr->{txt27} && $ctadr->{txt27} =~ /active|pending/){
my $topdf = "$varenv->{basedir}/src/wkhtmltopdf-amd64";
my $print_return = `$topdf --page-size A4 "$varenv->{wwwhost}/PDFGenerator?printer_id=SEPA-Lastschriftmandat\&mandant_main_id=$dbt->{shareedms_conf}->{parent_id}\&id=$ctadr->{c_id}" $varenv->{basedir}/pdfinvoice/SEPA-Lastschriftmandat-$varenv->{dbname}-$ctadr->{ct_name}.pdf 2>&1`;
my $exit_code = $?;
my $filesize = -s "$varenv->{basedir}/pdfinvoice/SEPA-Lastschriftmandat-$varenv->{dbname}-$ctadr->{ct_name}.pdf";
print EMA "$topdf --page-size A4 '$varenv->{wwwhost}/PDFGenerator?printer_id=SEPA-Lastschriftmandat\&mandant_main_id=$dbt->{shareedms_conf}->{parent_id}\&id=$ctadr->{c_id}' $varenv->{basedir}/pdfinvoice/SEPA-Lastschriftmandat-$varenv->{dbname}-$ctadr->{ct_name}.pdf\nreturn: $print_return\nfilesize: $filesize\nexit_code: $exit_code\n";
}
close EMA;
return "$varenv->{logdir}/pdfinvoice/SEPA-Lastschriftmandat-$varenv->{dbname}-$ctadr->{ct_name}.pdf";
}
#end ported from payone_post.pl
#
#jused by payone_cron.pl
sub payone_capture(){
my $self = shift;
my $varenv = shift;
my $ctf = shift;
my $ctadr = shift;
my $ctt = shift;
my $sum_paid = shift;
my $owner = shift;
my $lang = "de";
my $mandant_id = 100002;
my $main_id = 300008;#Rechnung
my $today4db = strftime("%Y-%m-%d %H:%M:%S",localtime(time));
my $retval = {};
my $return_text = "\n";
my $dbh = "";
#Node and HoleCkeck depended auto Rechnungs-Nummer
my $node = $db->get_node4multi($main_id,$lang);#Rechnung node
if($node->{int06} > 0){
if($ctt->{ct_name} !~ /\d/){
#HoleCheck if ReNr available before ReNr counter
my $ReNr_start = 40000;
my $freeNr = $lb->get_freeReNr("contenttrans","$ReNr_start","$node->{int06}","txt00","$node->{node_name}");
my $nextNr = $node->{int06};
$nextNr = $freeNr if($freeNr && $freeNr < $node->{int06});
$db->update_content4change("contenttrans",$ctt->{c_id},$nextNr,$nextNr,"barcode");
if(!$freeNr){
my $int06 = $node->{int06} + 1;
$db->updater("nodes","main_id",$main_id,"int06",$int06,"","","","","no_time");
}
}
}else{
$return_text = "---> payone_cron Payment.pm exit, $node->{int06} | $ctt->{ct_name} can not generate invoice number\n";
return $return_text;
}
#We do it only if txt80 end_time in Firma is defined
my $max_timestamp;
if($ctf->{txt80} && $ctt->{txt20}){
if($ctt->{txt20} =~ /(\d{2})\.(\d{2})\.(\d{4})$/){
$max_timestamp = "$1.$2.$3 23:59";
}else{
$return_text = "---> Payment.pm max_timestamp: $max_timestamp fails and exit\n";
return $return_text;
}
}
my $state = $ctt->{state};
if($varenv->{Zahlungsweise}){
my @_paymentstate = split(/\|/,$varenv->{Zahlungsweise});
if($ctadr->{int03} && $ctadr->{int03} == 1 && $ctadr->{ct_name} =~ /\w{2}-\d+/){
$state = "$_paymentstate[0]";
}else{
undef $_paymentstate[0];
}
if($ctadr->{int03} && $ctadr->{int03} == 2 && length($ctadr->{ct_name}) >= 19){
$state = "$_paymentstate[1]";
}else{
undef $_paymentstate[1];
}
}
$db->update_content4change("contenttrans",$ctt->{c_id},"","$sum_paid","int01");
$db->update_content4change("contenttrans",$ctt->{c_id},"",$state,"state");
$db->update_content4change("contenttrans",$ctt->{c_id},"",$owner,"owner");
$db->updater("contenttrans","c_id",$ctt->{c_id},"int14","2","","","","","");#must be to capture
#in cron we set OPOS anyway. If payone captured, it will be set int14=null
if(!$state || $state !~ /payone/){
$db->updater("contenttrans","c_id",$ctt->{c_id},"txt22","cronjob fail","","","","","");
$return_text = "---> Payment.pm can not preauthorization because of absent payment-data in ctadr.c_id:$ctadr->{c_id}, SEPA/CC:$ctadr->{int03}, $ctadr->{ct_name}, we exit\n";
return $return_text;
}
#preauth
if($ctadr->{int03} && $ctadr->{int03} == 1 && $ctadr->{ct_name} && $ctadr->{ct_name} =~ /\w{2}-\d+/ && (!$ctt->{txt16} || $ctt->{int03} ne "1")){
$return_text .= "---> trying payone preauthorizationSEPA\n";
$self->preauthorizationSEPA_main($varenv,$ctadr,$ctt,$owner);
sleep 2;
}elsif($ctadr->{int03} && $ctadr->{int03} == 2 && $ctadr->{ct_name} && length($ctadr->{ct_name}) >= 19 && (!$ctt->{txt16} || $ctt->{int03} ne "2")){
$return_text .= "---> trying payone preauthorizationCC\n";
$self->preauthorizationCC_main($varenv,$ctadr,$ctt,$owner);
sleep 2;
}
#check if preauth txid is done by payone
$ctt = $db->get_content1("contenttrans",$ctt->{c_id});
#SEPA capture
if($ctt->{int03} == 1 && $ctt->{txt16} && $ctt->{state} =~ /SEPA/){#SEPA
$return_text .= "---> trying payone captureSEPA\n";
$self->captureSEPA_main($varenv,$ctadr,$ctt,$owner);
}
#CC capture
if($ctt->{int03} == 2 && $ctt->{txt16} && $ctt->{state} =~ /Kreditkarte/){#CC
$return_text .= "---> trying payone captureCC\n";
$self->captureCC_main($varenv,$ctadr,$ctt,$owner);
}
#Rechnungspositionen itime > end Abrechnunsgdatum --> results in generating new Invoice
if($max_timestamp && $varenv->{wwwhost} =~ /tink/){
my $ctpos_ck = $db->get_content7("contenttranspos","ct_id",$ctt->{c_id},"itime",">","$max_timestamp");
if($ctpos_ck->{c_id}){
my $ctadr = $db->get_content7("contentadr","c_id",$ctadr->{c_id});
my $ct_id = $dbt->insert_contenttrans($dbh,$ctadr,"300008","218","----",$owner);
$db->updater("contenttrans","c_id",$ct_id,"start_time","$ctt->{start_time}",$owner);
$db->updater("contenttrans","c_id",$ct_id,"end_time","$ctt->{end_time}",$owner);
$db->updater("contenttranspos","ct_id",$ctt->{c_id},"ct_id",$ct_id,"","itime",">","$max_timestamp","no_time");
}
}
#wkhtml
#TODO to sharee
if(1==1){
my $praefix = "$ctt->{txt00}-TINK";
my $wc_line= $ctt->{int04};#Adresse.Tabelle
my $topdf = "$varenv->{basedir}/src/wkhtmltopdf-amd64";
my $print_return = `$topdf --page-size A4 "$varenv->{wwwhost}/Printpreview?printer_id=PDF\&mandant_main_id=$mandant_id\&main_id=$main_id\&ct_name2print=$ctt->{ct_name}\&c_id4trans=$ctt->{c_id}\&u_id=$owner\&wc=$wc_line" $varenv->{pdf}/$praefix-$ctt->{ct_name}.pdf 2>&1`;
$return_text .= "$topdf --page-size A4 \"$varenv->{wwwhost}/Printpreview?printer_id=PDF\&mandant_main_id=$mandant_id\&main_id=$main_id\&ct_name2print=$ctt->{ct_name}\&c_id4trans=$ctt->{c_id}\&u_id=$owner\&wc=$wc_line\" $varenv->{pdf}/$praefix-$ctt->{ct_name}.pdf\n";
#send_invoice infomail
if(-f "$varenv->{pdf}/$praefix-$ctt->{ct_name}.pdf"){
system(`$varenv->{basedir}/src/Mod/newsletter_tink.pl "$varenv->{basedir}" "$varenv->{wwwhost}" "send_invoice" "$ctadr->{c_id}" "$ctt->{ct_name}"`);
$return_text .= "---> Sent Invoice Info e-mail\n";
}
}
#TODO
#$retval = $db->get_content1("contenttrans",$ctt->{c_id});
return ($retval,$return_text);
}
1;

354
copri4/main/src/Mod/Prelib.pm Normal file
View file

@ -0,0 +1,354 @@
package Prelib;
#
# SPDX-License-Identifier: AGPL-3.0-or-later
# Copyright (c) Rainer Gümpelein, TeilRad GmbH
#
#migrate some methodes form Prelogic and Premain to here
#defined methodes are available for web-app and backend
use strict;
use warnings;
use POSIX;
use File::Path qw(make_path remove_tree);
use CGI ':standard';
use CGI::Carp qw(fatalsToBrowser);
use Scalar::Util qw(looks_like_number);
use Lib::Config;
use Mod::Libenzdb;
use Mod::Libenz;
use Mod::DBtank;
use Mod::Basework;
use Mod::APIfunc;
use Data::Dumper;
my $cf = new Config;
my $db = new Libenzdb;
my $lb = new Libenz;
my $dbt = new DBtank;
my $bw = new Basework;
my $apif = new APIfunc;
my $q = new CGI;
my @keywords = $q->param;
sub new {
my $class = shift;
my $self = {};
bless($self,$class);
return $self;
}
my $i_rows=0;
my $u_rows=0;
my $d_rows=0;
my $lang = "de";
my %varenv = $cf->envonline();
my $now_dt = strftime "%Y-%m-%d %H:%M:%S", localtime;
my $debug=1;
#new node relation with option to create subnode for Servicelog
sub new_relation {
my $self = shift;
my $main_id = shift;
my $owner = shift;
my %varenv = $cf->envonline();
my $ret = "";
my $dbh = "";
#$ret = "failure::temporarily disabled";
#return $ret;
open(FILE,">>$varenv{logdir}/new_relation.log") if($debug);
print FILE "\n*--> $now_dt| main_id: $main_id | owner: $owner\n" if($debug);
my $prefix_id = "0";
my $working_parent_id = $R::parent_id;
$prefix_id = $1 if($R::main_id =~ /^(\d)/ && $R::main_id >= "100000");
$ret = $lb->checkinput($R::node_name);
return $ret if($ret =~ /failure/);
my $node_name = $q->escapeHTML($R::node_name);
#check multiple node_name
my $subrelnode = $dbt->get_subrelnode($dbh,$working_parent_id,"",$node_name);
if($subrelnode->{node_name} eq "$R::node_name"){
return "failure::Abbruch, der Menuename \"$subrelnode->{node_name}\" ist bereits vorhanden. Bitte eindeutige Menuenamen verwenden.";
}
if($R::new_submenu){
$working_parent_id = $R::main_id;
$prefix_id++;
}
my $new_main_id = $dbt->get_freenode($dbh,$prefix_id);
my $template_id = 0,
my $n_sort = 1;
$template_id = $R::template_id if(looks_like_number($R::template_id));
$n_sort = $R::n_sort if(looks_like_number($R::n_sort));
my $insert = {
main_id => $new_main_id,
parent_id => $working_parent_id,
template_id => $template_id,
content_id => 0,
node_name => $node_name,
n_sort => $n_sort,
lang => "de",
owner => $owner,
change => "now()",
};
my $rel_id = $dbt->insert_nodeoid($dbh,$insert);
$i_rows = 1 if($rel_id > 0);
print FILE "new_relation with" . Dumper($insert) . "\n" if($debug);
#sub Servicelog for rental bikes
if($template_id == 205){
$prefix_id++;
my $new_submain_id = $dbt->get_freenode($dbh,$prefix_id);
my $new_subtemplate_id = $dbt->get_freetpl($dbh,"400","499");
my $ret_tpl_id = $dbt->copy_template($dbh,"400",$new_subtemplate_id,$owner);
my $insert_sub = {
main_id => $new_submain_id,
parent_id => $new_main_id,
template_id => $new_subtemplate_id,
content_id => 0,
node_name => "$node_name-Servicelog",
n_sort => $n_sort,
lang => "de",
owner => $owner,
change => "now()",
};
my $subrel_id = $dbt->insert_nodeoid($dbh,$insert_sub);
$i_rows += 1 if($subrel_id > 0);
print FILE "new_subrelation with" . Dumper($insert_sub) . "\nwith template_id=$ret_tpl_id" if($debug);
}
close(FILE) if($debug);
my $uri_path = $dbt->recurse_node("",$new_main_id);
print "$varenv{wwwhost}/$uri_path?return=$i_rows-$u_rows-$d_rows\n";
print redirect("$varenv{wwwhost}/$uri_path?return=$i_rows-$u_rows-$d_rows");
exit 0;
}
#end new_relation
#save node relation
sub save_relation {
my $self = shift;
my $main_id = shift;
my $owner = shift;
my %varenv = $cf->envonline();
my $dbh = "";
my $update_node = {
table => "nodes",
main_id => "$main_id",
};
my $update_relation = {
table => "relation",
main_id => "$main_id",
};
my $subrelnode = $dbt->get_subrelnode($dbh,$main_id,"","");
foreach(@keywords){
my $val = $q->param($_);
my $valxx = $q->escapeHTML("$val");
$valxx =~ s/^\s+//; $valxx =~ s/\s+$//;
if(($_ eq "node_name") && $valxx){
#if defined another path
my $node_name = $valxx;
my $node_path = $node_name;
#internal for splitting node_name node_path
($node_name,$node_path) = split(/\|/,$node_name) if($node_name =~ /\|/);
my $return;
$return = $lb->checkinput($node_name);
$return = $lb->checkinput($node_path);
return $return if($return =~ /failure/);
$u_rows = $dbt->update_one($dbh,$update_node,"node_name='$node_name'");
$u_rows = $dbt->update_one($dbh,$update_node,"node_path='$node_path'");
if($subrelnode->{main_id} && $subrelnode->{template_id} >= 400 && $subrelnode->{template_id} <= 499){
my $update_subnode = {
table => "nodes",
main_id => "$subrelnode->{main_id}",
};
$u_rows = $dbt->update_one($dbh,$update_subnode,"node_name='$node_name-Servicelog'");
$u_rows = $dbt->update_one($dbh,$update_subnode,"node_path='$node_path-Servicelog'");
}
}
if($_ =~ /template_id/ && $valxx){
$u_rows = $dbt->update_one($dbh,$update_relation,"template_id=$valxx");
}
if($_ =~ /int|n_sort|owner|node_public/){
$valxx =~ s/,/./;
$valxx = "null" if(!$valxx && $valxx ne "0");#for empty
$valxx = "0" if($valxx eq "0");
$u_rows = $dbt->update_one($dbh,$update_node,"$_=$valxx") if($valxx =~ /^\d+$|null|0/);
}
if($_ =~ /txt01/){
$u_rows = $dbt->update_one($dbh,$update_node,"$_='$valxx'");
}
if(! -d "$varenv{data}/$main_id"){
mkdir("$varenv{data}/$main_id",0777);
mkdir("$varenv{data}/$main_id-thumb",0777);
mkdir("$varenv{data}/$main_id-resize",0777);
}
}
my $uri_path = $dbt->recurse_node("",$main_id);
print "$varenv{wwwhost}/$uri_path?return=$i_rows-$u_rows-$d_rows\n";
print redirect("$varenv{wwwhost}/$uri_path?return=$i_rows-$u_rows-$d_rows");
exit 0;
}
#delete node relation with some ki deleting sub content
sub delete_relation {
my $self = shift;
my $main_id = shift;
my $owner = shift;
my %varenv = $cf->envonline();
my $dbh = "";
my $ret = "";
my $debug=1;
open(FILE,">>$varenv{logdir}/delete_relation.log") if($debug);
print FILE "\n*--> $now_dt| main_id: $main_id \n" if($debug);
#get all node para
my $noderef = {
main_id => $main_id,
fetch => "one",
};
my $noderel = $dbt->fetch_rel4tpl4nd($dbh,$noderef);
my $ctref = {
table => "$noderel->{ct_table}",
main_id => $main_id,
fetch => "one",
c_id => ">::0",
};
my $ct_record = $dbt->fetch_record($dbh,$ctref);
my $collect_rows=0;
if($R::template_id eq "205"){
(my $collect_node,$collect_rows) = $dbt->collect_noderel($dbh,$noderel->{parent_id},$R::template_id);
}
my $subrelnode = $dbt->get_subrelnode($dbh,$main_id,"","");
#if 1 then deleteable
my $deleteable_subnode = 1;
my $deleteable_node = 1;
my $deleteable_last_node = 1;
if($subrelnode->{template_id} >= 400 && $subrelnode->{template_id} <= 499){
$deleteable_subnode = 1;
if($collect_rows <= 1){
$deleteable_last_node = 0;
}
}elsif($subrelnode->{template_id}){
$deleteable_subnode = 0;
}
if($ct_record->{c_id} > 0){
$deleteable_node = 0;
}
print FILE "$deleteable_subnode == 0 || $deleteable_node == 0 --> collect_rows: $collect_rows|c_id: $ct_record->{c_id}\n" if($debug);
if($deleteable_last_node == 0){
$ret = "failure::Abbruch, es muss mindestens eine Mietrad Flotte definiert sein. ($collect_rows on $noderel->{parent_id})";
}elsif($deleteable_subnode == 0 || $deleteable_node == 0){
$ret = "failure::Abbruch, der Ordner enthält Daten. Für die referentielle Integrität ist es notwendig die Ordner Inhalte (content) und/oder Relationen des Ordners zu löschen. ($deleteable_subnode == 0 || $deleteable_node == 0 , $subrelnode->{template_id}, $main_id, $ct_record->{c_id}, $noderel->{ct_table})";
}else{
print FILE "delete_relation with $subrelnode->{main_id}, $subrelnode->{template_id}\n" if($debug);
if($deleteable_subnode && $subrelnode->{main_id}){
$dbt->delete_content($dbh,"contentpos","all",$subrelnode->{template_id}) if($subrelnode->{template_id} >= 400 && $subrelnode->{template_id} <= 499);
$d_rows += $dbt->delete_noderel($dbh,$subrelnode->{main_id});
$d_rows += $dbt->delete_template($dbh,$subrelnode->{template_id});
}
$d_rows += $dbt->delete_noderel($dbh,$main_id);
remove_tree("$varenv{data}/$main_id");
remove_tree("$varenv{data}/$main_id-thumb");
remove_tree("$varenv{data}/$main_id-resize");
my $uri_path = $dbt->recurse_node($dbh,$noderel->{parent_id});
$uri_path =~ s/\/\w+$//;
print redirect("$varenv{wwwhost}/$uri_path?return=$i_rows-$u_rows-$d_rows");
exit 0;
}
close(FILE) if($debug);
return $ret;
}
#sharee Bonusnummer with Tarif automatic
sub set_usertarif {
my $self = shift;
my $dbh = shift;
my $dbname = shift;
my $adr_bonus = shift;
open(FILE,">>$varenv{logdir}/save_account.log") if($debug);
print FILE "\n*Prelib--> $now_dt| c_id: $adr_bonus->{c_id} \n" if($debug);
my $ret = $adr_bonus->{ret};
my $i = 0;
my $dbh_operator = $dbt->dbconnect_extern($dbname);#operator connect
if($adr_bonus->{txt15} =~ /\w+/){
if(1==1){
my $pref_cc = {
table => "content",
keyfield => "c_id",
fetch => "all",
template_id => "228",
int03 => ">::0",
ct_name => $adr_bonus->{txt15},
};
my $record_op = $dbt->fetch_record($dbh_operator,$pref_cc);
my @new_txt30 = ();
foreach my $id (keys (%$record_op)){
print FILE "-1-> txt15: $adr_bonus->{txt15}\n" if($debug);
$i++;
foreach my $sourcetarif (@{$adr_bonus->{txt30_array}}){
print FILE "-1.2-> activeTarif-source:$sourcetarif | Bonus-source:$record_op->{$id}->{int21} | Bonus-target:$record_op->{$id}->{int22}\n" if($debug);
if($sourcetarif eq $record_op->{$id}->{int22}){
print FILE "-2.1-> still activ Bonusnr ct_name: $record_op->{$id}->{ct_name}\n" if($debug);
$ret = "success::txt15";
push(@new_txt30,$sourcetarif);
}elsif($record_op->{$id}->{int21} eq $sourcetarif && $record_op->{$id}->{int22}){
$dbt->update_content4comp($dbh_operator,$record_op->{$id}->{c_id},"-","1");
$u_rows = $dbt->update_one($dbh_operator,$adr_bonus,"txt15='$adr_bonus->{txt15}'");
print FILE "-2.2-> match-update Bonusnr ct_name: $record_op->{$id}->{ct_name}\n" if($debug);
$ret = "success::txt15";
push(@new_txt30,$record_op->{$id}->{int22});
}else{
print FILE "-2.3-> No matching Bonusnr ct_name: $record_op->{$id}->{ct_name}, keeping sourcetarif\n" if($debug);
push(@new_txt30,$sourcetarif);
#$ret = "failure::txt15#top1";
}
}
}
if(@new_txt30){
print FILE "-3-> txt30: @new_txt30\n" if($debug);
$u_rows = $dbt->update_one($dbh_operator,$adr_bonus,"txt30='@new_txt30'");
}
$ret = "failure::txt30#top2" if(!$adr_bonus->{txt30_array} || $adr_bonus->{txt30_array} !~ /\d/);
}
}else{
print FILE "-4-> update Tarif txt30: @{$adr_bonus->{txt30_array}}\n" if($debug);
$u_rows = $dbt->update_one($dbh_operator,$adr_bonus,"txt30='@{$adr_bonus->{txt30_array}}'");
$u_rows = $dbt->update_one($dbh_operator,$adr_bonus,"txt15=''");
$ret = "failure::txt30#top3" if(!$adr_bonus->{txt30_array} || $adr_bonus->{txt30_array} !~ /\d/);
}
#if bonus value doesn't match
if($adr_bonus->{txt15} && $i == 0){
print FILE "-5-> failure txt15: ''\n" if($debug);
$ret = "failure::txt15#top4";
}
close(FILE) if($debug);
return $ret;
}
1;

1126
copri4/main/src/Mod/Prelogic.pm Normal file
View file

File diff suppressed because it is too large Load diff

1294
copri4/main/src/Mod/Premain.pm Normal file
View file

File diff suppressed because it is too large Load diff

272
copri4/main/src/Mod/Pricing.pm Normal file
View file

@ -0,0 +1,272 @@
package Pricing;
#
# SPDX-License-Identifier: AGPL-3.0-or-later
# Copyright (c) Rainer Gümpelein, TeilRad GmbH
#
use strict;
use warnings;
use POSIX;
use CGI; # only for debugging
use Scalar::Util qw(looks_like_number);
use Lib::Config;
use Mod::Libenz;
use Mod::DBtank;
use Mod::Callib;
use Mod::Basework;
use Data::Dumper;
my $cf = new Config;
my $lb = new Libenz;
my $dbt = new DBtank;
my $cal = new Callib;
my $bw = new Basework;
sub new {
my $class = shift;
my $self = {};
bless($self,$class);
return $self;
}
my $dbh = "";
sub only_first_free(){
my $self = shift;
my $ctpos = shift;
my %varenv = $cf->envonline();
my $pref = {
table => "contenttrans",
table_pos => "contenttranspos",
fetch => "one",
template_id => "218",#Faktura tpl_id
ca_id => "=::$ctpos->{ca_id}",
c_id => "!=::$ctpos->{c_id}",
#txt10 => "IN::('available','canceled')",
int10 => "IN::('1','6')",
"ct.close_time" => "is::null",
};
$pref = { %$pref, time_range => "start_time >= '$ctpos->{start_time}' and start_time < '$ctpos->{end_time}' and start_time != end_time" };
my $record = $dbt->collect_post($dbh,$pref);
return $record;
}
sub sharee_pricing(){
my $self = shift;
my $ctpos = shift;
my $todo = shift;
my %varenv = $cf->envonline();
my $today4db = strftime("%Y-%m-%d %H:%M:%S",localtime(time));
my $return = {};
my $logging = {};
$logging->{ID} = "c_id:$ctpos->{c_id}/ct_id:$ctpos->{ct_id}/ca_id:$ctpos->{ca_id}";
my $computed_end_time = $ctpos->{end_time} || $today4db;
$computed_end_time = $today4db if($ctpos->{int10} && $ctpos->{int10} == 3);
my ($start_datetime,$end_datetime,$s_up,$e_up,$hours) = $cal->contenttranspos_dating($ctpos->{c_id},$ctpos->{start_time},"$computed_end_time","$today4db","");
$logging->{hours_input} = $hours;
$logging->{tariff} = "$ctpos->{txt04} - $ctpos->{int09}";
;
my $bike_group = "$dbt->{operator}->{$varenv{dbname}}->{oprefix}$ctpos->{int12}" || "";
my $days_pricemax = $ctpos->{int17} || 9;
$logging->{days_pricemax} = $days_pricemax;
my $price = 2; #FIXME to real val. must be not 0
$price = sprintf('%.2f',$ctpos->{int02}) if($ctpos->{int02} && $ctpos->{int02} > 0);
my $total = 0;
#my $days_pricemax = "4.5";#TINK max 9,- € bike/day depends on 2,- €/hour
#my $days_pricemax = 5; #KonRad max 15,- € bike/day depends on 3,- €/hour
my $days_hour4price = $days_pricemax / $price;
$logging->{days_hour4price} = $days_hour4price;
my $real_hours = $hours;
if($ctpos->{int16} && $ctpos->{int16} > 0){#z.b. 30 Min/Gratis --> 0.5
my $ctpos_freed = $self->only_first_free($ctpos);
#Bsp 1h = 60min , 60*0,02 = 1,2min
if(!$ctpos_freed->{c_id} || $real_hours <= 0.02){
$hours -= $ctpos->{int16};
$logging->{hours_freed} = $hours;
}else{
$logging->{hours_freed} = "Not freed because of (!$ctpos_freed->{c_id} && $ctpos->{int16} || $real_hours <= 0.02)";
}
}
#If available then take saved hours
if($ctpos->{int10} && $ctpos->{int10} == 1 && $todo eq "readonly"){
if($ctpos->{int03} && $ctpos->{int03} > 0){
$hours = $ctpos->{int03};
$total = $hours * $price if(looks_like_number($hours) && looks_like_number($price));
}else{
$hours = 0;
$total = 0;
}
}
#jede angebrochene Std.
elsif(looks_like_number($hours) && $hours > 0){
if($days_hour4price > 0 && $hours >= $days_hour4price && $hours <= 24){
$logging->{_hours_lower24} = "$days_hour4price > 0 && $hours >= $days_hour4price && $hours <= 24";
$logging->{__hours_lower24} = $hours;
$hours = $days_hour4price;
$logging->{hours_lower24} = $hours;
}
elsif($days_hour4price > 0 && $hours >= 24){
$logging->{hours_greate24} = "$days_hour4price > 0 && $hours >= 24";
my $days = $hours / 24;
my $days_int = $days;
my $dez = 0;
($days_int,$dez) = split(/\./, $days) if($days =~ /\.\d/);
my $days_hour = $days_int * 24;
my $rest = $hours - $days_hour;
$rest = $days_hour4price if($rest > $days_hour4price);
$hours = ($days_int * $days_hour4price) + $rest;
$logging->{hours_compute} = "$hours = ($days_int * $days_hour4price) + $rest";
}
$logging->{hours_preround} = $hours;
$hours = $lb->round_half($hours);
$logging->{hours_postround} = $hours;
$total = $hours * $price if(looks_like_number($hours) && looks_like_number($price));
}else{
$hours = 0;
}
$total = sprintf('%.2f', $total);
#Bsp 1h = 60min , 60*0,02 = 1,2min
$hours = "0" if($real_hours <= 0.02);
$return->{real_hours} = "$real_hours";
$return->{computed_hours} = "$hours";
$return->{unit_price} = "$price";
$return->{total_price} = "$total";
$return->{bike_group} = ["$bike_group"];
$return->{station} = "$dbt->{operator}->{$varenv{dbname}}->{oprefix}$ctpos->{int04}";#TODO save with prefix
$return->{uri_operator} = "$varenv{wwwhost}";#TODO, should be DB select
$return->{bike} = "$dbt->{operator}->{$varenv{dbname}}->{oprefix}$ctpos->{barcode}";
$return->{state} = "$dbt->{copri_conf}->{bike_state}->{$ctpos->{int10}}" || "";
$return->{bike_charge} = "$ctpos->{int19}" if($ctpos->{int19});
$return->{description} = "$ctpos->{txt01}";
$return->{request_time} = "$ctpos->{itime}";
$return->{start_time} = "$ctpos->{start_time}";
$return->{end_time} = "$computed_end_time";
$return->{system} = "Ilockit" || "";#FIXME
if($ctpos->{int11} eq "2"){
#$return->{gps} = "$ctpos->{txt06}";#end_gps
($return->{gps}->{latitude},$return->{gps}->{longitude}) = split(/,/,$ctpos->{txt06});
#if($ctpos->{txt10} =~ /requested|occupied/)
if($ctpos->{int10} == 2 || $ctpos->{int10} == 3){
$return->{tariff_description}->{name} = "$ctpos->{txt04}";
$return->{tariff_description}->{number} = "$ctpos->{int09}";
$return->{tariff_description}->{eur_per_hour} = "$ctpos->{int02}" || "0";
$return->{tariff_description}->{max_eur_per_day} = "$ctpos->{int17}" || "0";
$return->{tariff_description}->{free_hours} = "$ctpos->{int16}" if($ctpos->{int16} && $ctpos->{int16} > 0);
$return->{tariff_description}->{abo_eur_per_month} = "$ctpos->{int15}" if($ctpos->{int15} && $ctpos->{int15} > 0);
$return->{tariff_description}->{track_info} = "Ich stimme der Speicherung (Tracking) meiner Fahrstrecke zwecks wissenschaftlicher Auswertung und Berechnung der CO2-Einsparung zu!" if($ctpos->{int25});
$return->{tariff_description}->{operator_agb} = "Mit der Mietrad Anmietung wird folgender Betreiber <a href='$varenv{wwwhost}/site/agb.html' target='_blank'>AGB</a> zugestimmt (als Demo sharee AGB)." if($ctpos->{ca_id} == 1842 || $ctpos->{ca_id} == 5781);
$return->{Ilockit_GUID} = "$ctpos->{txt17}";
$return->{Ilockit_ID} = "$ctpos->{txt18}";
#$return->{gps} = "$ctpos->{txt06}";#start_gps
($return->{gps}->{latitude},$return->{gps}->{longitude}) = split(/,/,$ctpos->{txt06});
$return->{lock_state} = "locked" if($ctpos->{int20} == 1);
$return->{lock_state} = "unlocked" if($ctpos->{int20} == 2);
}
}
$bw->log("hour computed:",$logging,"");
return $return;
}
#CO2 calculator
#Bsp Berechnungen:
# Pkw:
# Distanz * CO2-Emission Pkw / 100 km
# 8.760 km * 20 kg CO2 / 100 km = 1.752 kg CO2
# Pedelec:
# Distanz * CO2-Emission Pedelec / 100 km
# 10.950 km * 0,546 kg CO2 / 100 km = 62 kg CO2
#
# Aus der Differenz zwischen der CO2-Emission Pkw und der CO2-Emission Pedelec ergibt sich das Einsparpotenzial:
# 1.752 kg CO2 – 62 kg CO2 = 1.690 kg CO2, also rund 1,7 t CO2 pro Jahr
#
sub co2calc {
my $self = shift;
my $ctpos = shift;
my $co2diff = 0;
my $co2pkw = $ctpos->{int26} * 20 / 100;
my $co2ped = $ctpos->{int26} * 0.546 / 100;
$co2diff = $co2pkw - $co2ped;
$co2diff = sprintf('%.2f',$co2diff);
$co2diff =~ s/\./,/;
return $co2diff;
}
#calculates sprit saving
sub sprit2calc {
my $self = shift;
my $ctpos = shift;
my $einzel = $ctpos->{int02};
my $menge = $ctpos->{int03};
my $rabatt_val = $ctpos->{int07} || 0;
my $gesamt = 0;
if($rabatt_val != 0 && $einzel && $menge){
my $rabatt_eur = $rabatt_val;
#if int08 != 1 alias €
$rabatt_eur = $einzel * $menge * $rabatt_val/100 if($ctpos->{int08} != 1);
$gesamt = $einzel * $menge - $rabatt_eur;
}elsif($einzel && $menge){
$gesamt = $einzel * $menge;
}
my $sprit_price = 0;
$sprit_price = $ctpos->{int26} * 0.3 if($ctpos->{int26} != 0);
$sprit_price -= $gesamt;
$sprit_price = sprintf('%.2f',$sprit_price);
$sprit_price =~ s/\./,/;
return $sprit_price;
}
#computes position price and rabatt
sub price2calc {
my $self = shift;
my $ctpos = shift;
my $gesamt = 0;
my $rabatt = "";
my $einzel = $ctpos->{int02};
my $menge = $ctpos->{int03};
my $rabatt_val = $ctpos->{int07} || 0;
if($rabatt_val != 0 && $einzel && $menge){
my $rabatt_eur = $rabatt_val;
#if int08 != 1 alias €
$rabatt_eur = $einzel * $menge * $rabatt_val/100 if($ctpos->{int08} != 1);
$gesamt = $einzel * $menge - $rabatt_eur;
}elsif($einzel && $menge){
$gesamt = $einzel * $menge;
}
if($ctpos->{int07} && $ctpos->{int07} > 0 && $menge > 0){
$rabatt = "-" . $ctpos->{int07};
if($ctpos->{int08} == 1){
$rabatt .= " €";
}else{
$rabatt =~ s/\.00//;
$rabatt .= " %";
}
}
return ($gesamt,$rabatt);
}
1;

78
copri4/main/src/Mod/Relation.pm Normal file
View file

@ -0,0 +1,78 @@
package Relation;
#
##
# SPDX-License-Identifier: AGPL-3.0-or-later
# Copyright (c) Rainer Gümpelein, TeilRad GmbH
#
use strict;
use warnings;
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use CGI ':standard';
use Mod::Buttons;
use Mod::Libenzdb;
sub new {
my $class = shift;
my $self = {};
bless($self,$class);
return $self;
}
#Template
sub tpl(){
my ($source,$main_id,$ct_name,$barcode,$u_id,$lang,$set_style,$colspan_left,$colspan_right) = @_;
my $q = new CGI;
my $db = new Libenzdb;
my $but = new Buttons;
my $users = $db->select_users($u_id);
my %ib = $but->ibuttons();
#collect recursive waren
my $node_mandant = $db->get_node2($users->{fullurl},"$source",$lang);
my $main_ids = $db->collect_noderec($node_mandant->{main_id},$lang,"nothing");
my $parent_nodes = $db->collect_node($node_mandant->{main_id},$lang);
my $nodes = $db->collect_node2("$main_ids");
my $setpart_main_id=$main_id;
my @_waren_rel;
foreach my $pid (sort { lc($parent_nodes->{$a}->{node_name}) cmp lc($parent_nodes->{$b}->{node_name}) } keys (%$parent_nodes)){
my $parent_name = "/";
$parent_name .= $parent_nodes->{$pid}->{node_name} if($parent_nodes->{$pid}->{node_name});
push (@_waren_rel, "$pid:$parent_name") if($parent_name && "$parent_name" !~ /root/);
foreach my $id (sort { lc($nodes->{$a}->{node_name}) cmp lc($nodes->{$b}->{node_name}) } keys (%$nodes)){
if($nodes->{$id}->{parent_id} eq $parent_nodes->{$pid}->{main_id}){
push (@_waren_rel, "$id:$parent_name/$nodes->{$id}->{node_name}") if($nodes->{$id}->{node_name});
}
}
}
print $q->hidden(-name=>'main_id', -value=>"$main_id");
print $q->Tr();
print "<td colspan='9' style='font-size:1em;border: solid #dcd77f;'>\n";
print $q->start_table({-style=>'',-border=>'0',-align=>'left', -cellpadding=>'0', -cellspacing=>'0'});
print $q->Tr();
print $q->td({-class=>'tdescr2',-colspan=>"$colspan_left",-style=>"$set_style"},"Kontext Kopie",$but->singlesubmit2("rel_edit","context_copy_content","$ib{context_copy_content}","$set_style"));
if($barcode){
$ct_name = "" if($barcode == $ct_name);
print $q->hidden(-name=>'barcode', -value=>"$barcode");
print $q->hidden(-name=>'empty_rel_id', -value=>"1");
print $q->td({-class=>'tdval2',-colspan=>"$colspan_right",-style=>"$set_style"}, "Teilenummer:",$q->textfield(-class=>'etxt',-name=>"other_ct_name",-default=>"$ct_name",-size=>12,-maxlength=>15), "&nbsp; Barcode (intern): $barcode\n");
}else{
print $q->td({-class=>'tdval2',-colspan=>"$colspan_right",-style=>"$set_style;color:red"}, "Der Barcode (intern) muss vorhanden sein\n");
}
#print $q->Tr();
#print $q->td({-class=>'tdescr2',-colspan=>"$colspan_left",-style=>"$set_style"},"Kopieren",$but->singlesubmit2("rel_edit","copy_content","$ib{copy_content}","$set_style"));
#print $q->hidden(-name=>'', -value=>"");
#print $q->td({-class=>'tdval2',-colspan=>"$colspan_right",-style=>"$set_style"}, "Barcode:",$q->textfield(-class=>'etxt',-name=>"new_barcode",-default=>"$barcode",-size=>12,-maxlength=>15), "\n");
print $q->Tr();
print $q->td({-class=>'tdescr2',-colspan=>"$colspan_left",-style=>"$set_style"},"Verschieben",$but->singlesubmit2("rel_edit","move_content","$ib{move_content}","$set_style"));
print $q->td({-class=>'tdval2',-colspan=>"$colspan_right",-style=>"$set_style"}, "Gruppen-Ordner:",$but->selector("setpart_main_id","250px",$setpart_main_id,@_waren_rel),"\n");
print $q->end_table;
print "</td>";
}
1;

216
copri4/main/src/Mod/RelationEdit.pm Normal file
View file

@ -0,0 +1,216 @@
package RelationEdit;
#
##
# SPDX-License-Identifier: AGPL-3.0-or-later
# Copyright (c) Rainer Gümpelein, TeilRad GmbH
#
use strict;
use warnings;
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use CGI ':standard';
use Lib::Config;
use Mod::Buttons;
use Mod::Libenz;
use Mod::Libenzdb;
sub new {
my $class = shift;
my $self = {};
bless($self,$class);
return $self;
}
#Template
sub tpl(){
my $node_meta = shift;
my $users_dms = shift;
my $u_group = shift;
my $return = shift;
my $q = new CGI;
my @keywords = $q->param;
my $cf = new Config;
my $lb = new Libenz;
my $db = new Libenzdb;
my $but = new Buttons;
my %ib = $but->ibuttons();
my $script = $q->script_name();
my %varenv = $cf->envonline();
my $path_info = $q->path_info();
my $path = $path_info;
#with meta_host,
if("$varenv{metahost}"){
$path = "$script" . "$path_info";
$script="";
}
my $lang = "de";
my $ctn;
if($R::rel_id){
$ctn = $db->collect_rel4nodes("",$node_meta->{content_id},$node_meta->{template_id});
}else{
return "failure::Fehler bei der Auswahluebergabe";
}
my $bg_color = "gray";
my $table = "content";
my $relate_key;
$relate_key = "move_content" if($R::rel_edit =~ /move_/);
$relate_key = "relate_content" if($R::rel_edit =~ /relate_/);
$relate_key = "copy_content" if($R::rel_edit =~ /copy_/);
if($node_meta->{ct_table} eq "contentadr"){
$table = "contentadr";
$relate_key = "move_contentadr" if($R::rel_edit =~ /move_/);
$relate_key = "relate_contentadr" if($R::rel_edit =~ /relate_/);
}
if($node_meta->{ct_table} eq "contenttrans"){
$table = "contenttrans";
$relate_key = "move_conttrans" if($R::rel_edit =~ /move_/);
$relate_key = "relate_contenttrans" if($R::rel_edit =~ /relate_/);
}
if($node_meta->{ct_table} eq "contenttver"){
$table = "contenttver";
$relate_key = "move_contenttver" if($R::rel_edit =~ /move_/);
$relate_key = "relate_contenttver" if($R::rel_edit =~ /relate_/);
}
if($node_meta->{ct_table} eq "contentnel"){
$table = "contentnel";
$relate_key = "move_contentnel" if($R::rel_edit =~ /move_/);
$relate_key = "relate_contentnel" if($R::rel_edit =~ /relate_/);
}
#print "$table,$node_meta->{main_id},$lang,$R::rel_id, xxxxxxxxxxxxxx";
my $ctrel = $db->get_ctrel($table,"",$lang,$R::rel_id);
my $node = $db->get_node4multi($node_meta->{main_id},$lang);
$ctrel->{mtime} = $lb->time4de($ctrel->{mtime},"1") if($ctrel->{mtime});
$ctrel->{rel_id} = 0 if(!$ctrel->{rel_id});
my $ct_users;
$ct_users = $db->collect_users("users") if($u_group eq "manager");#users map
#we mean roots for sub-NodePath selection
my $module;
my @viewsel = split /\//,$1 if($path =~ /^\/(.*)/);
my $depth = scalar(@viewsel);
my $view_root = $viewsel[0] || "root";
$module = $db->get_node("$view_root","$lang","<","200000");
if(!$module->{main_id} && ($path =~ /^\/([\w-\sßäöüÄÖÜ]+)\/([\w-\sßäöüÄÖÜ]+)/)){
$module = $db->get_node2($1,$2,$lang);
}
my $module_id = "$module->{main_id}" || "100000";
my $selector = "this_is_no_selection";
$selector = $1 if($path =~ /\/(Waren|Kunden|Veranstaltung|Nachrichten)/);
#collect recursive nodes
my $selsize="200px";
#nodes with relation would be better
my $nodes = $db->collect_node4all("","","","100000");
my @_menu_rel;
foreach my $id (sort { lc($nodes->{$a}->{node_name}) cmp lc($nodes->{$b}->{node_name}) } keys (%$nodes)){
my @viewsel;
my $depth=0;
my $j=0;
my ($m_id,$uri) = $lb->make_uri5($nodes->{$id}->{main_id},$nodes);
#print "$module->{node_name}|$selector|$m_id:$uri<br>";
#if(($uri =~ /$module->{node_name}/) && ($uri !~ /000 root/)){
if(($uri =~ /\w\/\w/) && ($uri !~ /000 root/)){
@viewsel = split(/\//,$uri) if($uri =~ /^\/(.*)/);
$depth = scalar(@viewsel);
if($varenv{orga} ne "dms"){
if($depth >= 3){
my $ct4rel = $db->collect_ct4rel("$table",$nodes->{$id}->{main_id},$lang,"","","","","");
foreach my $id (keys(%$ct4rel)){
$j++ if($ct4rel->{$id}->{c_id});
}
push (@_menu_rel, "$m_id:$uri");
}
}elsif($varenv{orga} eq "dms"){
#sharee-copri workaround to get only bike menue
if($selector && ($path =~ /\/$selector/) && ($uri =~ /$selector/) && ($node_meta->{template_id} == 205)){#Waren bikes
if($depth >= 2){
my $rel = $db->get_relation($nodes->{$id}->{main_id},$lang,"");
push (@_menu_rel, "$m_id:$uri") if($rel->{template_id} == 205);
}
}
}
}
}
my $mcount = scalar(@_menu_rel);
#
#collect content
my $content = $db->collect_content();
my @_content;
foreach my $id (sort { lc($content->{$a}->{ct_name}) cmp lc($content->{$b}->{ct_name}) } keys (%$content)){
push (@_content, "$id:$content->{$id}->{ct_name}") if($content->{$id}->{ct_name});
}
#
print "<div id='Container_cms'>";
my $u_name;
foreach my $ctu_id (keys (%$ct_users)){
if($ctrel->{owner} eq $ct_users->{$ctu_id}->{owner}){
$u_name = $ct_users->{$ctu_id}->{u_name};
}
}
$db->users_up("rel_id4edit",$ctrel->{rel_id},$users_dms->{u_id});
print $q->hidden(-name=>'main_id', -value=>"$ctrel->{main_id}");
print $q->hidden(-name=>'rel_id', -value=>"$ctrel->{rel_id}") if($ctrel->{rel_id});
print $q->hidden(-name=>'template_id', -value=>"$ctrel->{template_id}");
print $q->start_table({-class=>'list', -border=>'0', -width=>'100%', -align=>'left', -cellpadding=>'3', -cellspacing=>'3'});
#Buttons
print $q->Tr();
print "<td style='margin:1px 0;padding:2px;background-color:$bg_color' colspan='2' nowrap>\n";
print $but->singlesubmit7("rel_edit","$relate_key","$ib{$relate_key}");
print "</td>\n";
print $q->Tr();
print $q->td({-colspan=>'2'},"&nbsp;");
if("$R::relate_dialog" eq "menu" || $R::rel_edit =~ /dialog4menu/){
print $q->hidden(-name=>'set_content_id', -value=>"$ctrel->{content_id}");
print $q->Tr();
print $q->td({-class=>'tdescr2'}, "Content"),"\n";
print $q->td({-class=>'tdval2'},$q->b("$ctrel->{ct_name} ($ctrel->{txt01})"),"\n");
print $q->Tr();
print $q->td({-class=>'tdescr2'}, "Node"),"\n";
if($mcount > 0 || $varenv{orga} eq "dms"){
if($varenv{wwwhost} =~ /woge|fsd/){#with multiple select
my $height = scalar(@_menu_rel);
my $remain_id;
foreach my $in (keys(%$ctn)){
$remain_id .= "$ctn->{$in}->{main_id},";
}
$remain_id =~ s/,$//;
print $q->td({-class=>'tdval2'},$but->selector2("set_main_id","600px","$height",$remain_id,@_menu_rel)),"\n";
}else{
print $q->td({-class=>'tdval2'},$but->selector("set_main_id","250px",$node_meta->{main_id},@_menu_rel)),"\n";
}
}else{
print $q->td({-class=>'tdval2'},"Es ist kein leeres Menue fuer eine Verknuepfung vorhanden."),"\n";
}
print $q->hidden(-name=>'mastermain_id', -value=>"$node_meta->{mastermain_id}") if($node_meta->{mastermain_id});
}elsif("$R::relate_dialog" eq "content" || $R::rel_edit =~ /dialog4content/){
print $q->hidden(-name=>'set_main_id', -value=>"$node_meta->{main_id}");
print $q->Tr();
print $q->td({-class=>'tdescr2'}, "Node"),"\n";
print $q->td({-class=>'tdval2'},$q->b($node->{node_name}),"\n");
print $q->Tr();
print $q->td({-class=>'tdescr2'}, "Content"),"\n";
print $q->td({-class=>'tdval2'},$but->selector("set_content_id","250px",$ctrel->{c_id},@_content),"\n");
}
print $q->Tr();
print $q->td({-colspan=>'2'},"&nbsp;");
#print $q->Tr();
#print "<td class='element3' colspan='2'>";
#print $q->a({-class=>"linknav2",-href=>'javascript:history.back()'}, "zurück");
#print "</td>\n";
print $q->end_table;
print "</div>\n";
}
1;

125
copri4/main/src/Mod/SMSTransport.pm Normal file
View file

@ -0,0 +1,125 @@
package SMSTransport;
#
# SPDX-License-Identifier: AGPL-3.0-or-later
# Copyright (c) Rainer Gümpelein, TeilRad GmbH
#
#SMS sender
#
#perl -cw do
#use lib "/var/www/copri4/shareeapp-primary/src";
use strict;
use warnings;
use POSIX;
use CGI; # only for debugging
use LWP::UserAgent;
use URI::Encode;
use JSON;
use Scalar::Util qw(looks_like_number);
use Mod::DBtank;
use Mod::Basework;
use Data::Dumper;
my $q = new CGI;
my $dbt = new DBtank;
my $bw = new Basework;
sub new {
my $class = shift;
my $self = {};
bless($self,$class);
return $self;
}
my $now_dt = strftime "%Y-%m-%d %H:%M:%S", localtime;
my $ua = LWP::UserAgent->new;
$ua->agent("sharee smsclient");
my $uri_encode = URI::Encode->new( { encode_reserved => 1 } );
my $json = JSON->new->allow_nonref;
my $response_in = {};
my $dbh = "";
my $owner = 181;
sub sms_ack_digest {
my $self = shift;
my $ctadr = shift;
#Ack digest
my $ack_digest = $q->unescapeHTML($ctadr->{txt34}) || "";
my $email_ack_digest = $1 if($ack_digest =~ /^(.{5})/);
my $sms_ack_digest = $1 if($ack_digest =~ /(.{5})$/);
my $sms_from = "Mietradsystem";
my $sms_to = $ctadr->{txt07};# || "+491799xxxx72";
my $sms_message = "Ihr Mietradsystem SMS-Bestätigungscode lautet: $sms_ack_digest";
my $message = Encode::encode('iso-8859-1', Encode::decode('utf-8',"$sms_message"));
open(FILE,">>$dbt->{copri_conf}->{logdir}/sms_gtx.log");
print FILE "\n*** $now_dt 'sharee smsclient' \n";
my $request = {
from => $sms_from,
to => $sms_to,
text => $message,
};
print FILE "---> request:\n" . Dumper($request);
my $ret_json = $self->get_sms_gtx($request);
eval {
$response_in = decode_json($ret_json);
print FILE "<--- response_in:\n" . Dumper($response_in);
};
if ($@){
print FILE "<--- failure raw response_in:\n" . Dumper($ret_json) . "\n";
warn $@;
}
close(FILE);
return $ret_json;
}
#sms gtx http request
sub get_sms_gtx {
my $self = shift;
my $request = shift || "";
my $api_file = "/var/www/copri4/shareeconf/apikeys.cfg";
my $aconf = Config::General->new($api_file);
my %apikeyconf = $aconf->getall;
#print $apikeyconf{smsgtx}->{gtx_key};
my $endpoint = "https://rest.gtx-messaging.net/smsc/sendsms/$apikeyconf{smsgtx}->{gtx_key}/json";
my $rest;
foreach (keys (%$request)){
my $encoded_val = $uri_encode->encode($request->{$_});
$rest .= "$_=$encoded_val&";
}
$rest =~ s/\&$//;
my $gtx_request = "$endpoint?$rest";
print FILE "===> GET2gtx >> " . $gtx_request . "\n";
my $req = HTTP::Request->new(GET => "$gtx_request");
$req->content_type('application/x-www-form-urlencoded');
my $res = $ua->request($req);
if ($res->is_success) {
#print $res->content;
return $res->content;
print $res->status_line, "\n";
}else {
print $res->status_line, "\n";
}
}
#
1;

990
copri4/main/src/Mod/Shareework.pm Normal file
View file

@ -0,0 +1,990 @@
package Shareework;
#
# SPDX-License-Identifier: AGPL-3.0-or-later
# Copyright (c) Rainer Gümpelein, TeilRad GmbH
#
#disable for syntax check
#use lib qw(/var/www/copri4/shareeapp-primary/src);
use strict;
use warnings;
use POSIX;
use CGI; # only for debugging
use Mod::Libenzdb;
use Mod::Libenz;
use Mod::DBtank;
use Mod::Buttons;
use Lib::Config;
use Mod::APIfunc;
use Digest::MD5 qw(md5 md5_hex);
use Digest::SHA qw(sha1_base64);
use Scalar::Util qw(looks_like_number);
use Mod::Prelib;
use Mod::Basework;
use Mod::Payment;
#use Mod::MailTransport;
use Mod::SMSTransport;
use Data::Dumper;
my $cf = new Config;
my $but = new Buttons;
my $db = new Libenzdb;
my $lb = new Libenz;
my $dbt = new DBtank;
my $apif = new APIfunc;
my $pl = new Prelib;
my $bw = new Basework;
my $payone = new Payment;
#my $mailtrans = new MailTransport;
my $smstrans = new SMSTransport;
my $q = new CGI;
sub new {
my $class = shift;
my $self = {};
bless($self,$class);
return $self;
}
my $i_rows=0;
my $u_rows=0;
my $d_rows=0;
#
#also done in src/Tpl/Anmelden.pm!?
sub delete_account {
my $self = shift;
my $c_id = shift;
my $owner = shift;
my $now_dt = strftime "%Y-%m-%d %H:%M:%S", localtime;
my %varenv = $cf->envonline();
my $debug=1;
my $dbh = "";
$bw->log("delete_account",$c_id,"");
open(FILE,">>$varenv{logdir}/delete_account.log") if($debug);
my $dbh_primary = $dbt->dbconnect_extern("sharee_primary");
my $authref = {
table => "contentadr",
fetch => "one",
template_id => "202",
c_id => "$c_id",
};
my $ctadr = $dbt->fetch_record($dbh_primary,$authref);
print FILE "\n*-->DB $varenv{dbname} $now_dt| owner: $owner | c_id: $c_id \n" if($debug);
#First on operator DMS delete and then second on primary delete txt17 operator DB
if($varenv{dbname} ne "sharee_primary"){
$d_rows += $dbt->delete_content($dbh,"contentadr",$c_id);
my $update_primary = {
table => "contentadr",
mtime => "now()",
owner => "$owner",
c_id => "$c_id",
};
my @operators = ("$ctadr->{txt17}");
@operators = split(/\s+/,$ctadr->{txt17}) if($ctadr->{txt17} =~ /\w\s\w/);
my @new_operators = ();
foreach(@operators){
push(@new_operators,$_) if($_ =~ /sharee_\w+/ && $_ !~ /$varenv{dbname}/);
}
print FILE "delete operator dbname: $varenv{dbname} | update_primary txt17='@new_operators'\n";
$u_rows = $dbt->update_one($dbh_primary,$update_primary,"txt17='@new_operators'");
$u_rows = $dbt->update_one($dbh_primary,$update_primary,"txt19=null");
}else{
print FILE "delete on all by operatorsloop by primary\n";
$dbt->update_operatorsloop($varenv{dbname},$ctadr->{c_id},"delete");
$d_rows += $dbt->delete_content($dbh,"contentadr",$c_id);
}
close(FILE) if($debug);
return "$i_rows-$u_rows-$d_rows";
}
sub check_account(){
my $self = shift;
my ($column2,$op2,$content2,$column3,$op3,$content3) = @_;
my $table = "contentadr";
$content2 = $q->escapeHTML("$content2");
my $account_check = $db->get_like2sort("contentadr","","","$column2","$op2","$content2","$column3","$op3","$content3");
return $account_check;
}
#create_account is alwas done on primary first
sub create_account(){
my $self = shift;
my $owner = shift;
my $table = "contentadr";
my $c_idnew = $db->insert_content($table);
$db->updater("$table","c_id",$c_idnew,"ct_name","$c_idnew","$owner");
$db->updater("$table","c_id",$c_idnew,"barcode","$c_idnew","$owner");
$db->updater("$table","c_id",$c_idnew,"int20","$owner","$owner");
my $rel_idnew = $db->insert_relationlist($table,"200011","de",$c_idnew,"202","ca_id");
return $c_idnew;
}
#sharee save_account is always done on primary first
sub save_account(){
my $self = shift;
my $c_id = shift;
my $coo = shift || "";
my $owner = shift || 0;
my $table = "contentadr";
$q = new CGI;
$q->import_names('R');
my @keywords = $q->param;
my $now_dt = strftime "%Y-%m-%d %H:%M:%S", localtime;
my %varenv = $cf->envonline();
$bw->log("save_account",$q,"");
my $debug=1;
my $dbh = "";#keep in mind, empty dbh defaults to local copri-instance dbname
open(FILE,">>$varenv{logdir}/save_account.log") if($debug);
#Always on sharee_primary
if($varenv{dbname} ne "sharee_primary"){
$dbh = $dbt->dbconnect_extern("sharee_primary");
print FILE "\n*-->If no-primary connect DB sharee_primary $now_dt| c_id: $c_id \n" if($debug);
}else{
#keep in mind, should be only done by web-app user Formular (primary)
print FILE "\n*-->Else take local copri-Instance DB $varenv{dbname} $now_dt| c_id: $c_id \n" if($debug);
}
my $authref = {
table => "contentadr",
fetch => "one",
template_id => "202",
c_id => "$c_id",
};
my $ctadr = $dbt->fetch_record($dbh,$authref);
my $update_primary = {
table => "contentadr",
mtime => "now()",
owner => "$owner",
c_id => "$c_id",
};
my $ret = "";
my $ret_conflict = "";
my $fkeys = "";
my $pw_dummy = "";
@keywords = grep {!/txt31/} @keywords;
print FILE Dumper($q) if($debug);
foreach(@keywords){
$fkeys .= "$_,";
my $val = $q->param("$_");
my $valxx = $q->escapeHTML("$val");
$valxx =~ s/^\s+//;
$valxx =~ s/\s+$//;
print FILE "$_:$valxx \n" if($debug);
if($_ =~ /^int|barcode/){
$valxx =~ s/,/./g;
if(looks_like_number($valxx)){
$valxx = $valxx;
}else{
$valxx = "null"
}
}
if($_ =~ /^txt[\d+]|^int[\d+]|^uri[\d+]|ct_name/){
#PW
if($_ =~ /^txt04/){
if($valxx eq "xxxxxxxx"){
$pw_dummy = "1";
}elsif($valxx){
my $pwmd5 = md5_hex($valxx);
$u_rows = $dbt->update_one($dbh,$update_primary,"txt11='$pwmd5'");
}
}
#operators, only if saved by operator DMS
elsif($_ eq "txt17"){
#2021-07-29 post input disabled, because it fails
#my @txt17 = $q->param('txt17');
#@txt17 = grep {!/null/g} @txt17;
#push(@txt17,$varenv{dbname}) if($varenv{dbname} ne "sharee_primary");
#my %txt17 = map {$_ => 1} @txt17;
my %txt17 = ();
if($ctadr->{txt17} =~ /\w\s\w/){
%txt17 = map { $_ => 1 } split(/\s+/,$ctadr->{txt17});
}else{
$txt17{$ctadr->{txt17}} = 1;
}
my $txt19 = $q->escapeHTML($q->param('txt19')) || "";
if($txt19 && $dbt->{operator}{$txt19}->{database}->{dbname}){
$txt17{$dbt->{operator}{$txt19}->{database}->{dbname}} = 1;
}
my @operators = ();
foreach my $keys (keys %txt17) {
push(@operators,$keys);
}
$u_rows = $dbt->update_one($dbh,$update_primary,"txt17='@operators'");
}
#Web-Login|Rabatt|Vde|payone cron-intervall|Ilockit-Admin
#elsif($_ =~ /int05|int07|int12|int16|int19/){
elsif($_ =~ /int05|int07|int16|int19/){
#if($varenv{dbname} ne "sharee_primary"){
#on all $keys which on delete on loop sync
$u_rows = $dbt->update_one("",$update_primary,"$_=$valxx");
# }
}
#user_tour
elsif($_ =~ /txt18/){
#if($varenv{dbname} ne "sharee_primary"){
#on all $keys which on delete on loop sync
my @txt18 = $q->param('txt18');
@txt18 = grep {!/null/} @txt18;
$u_rows = $dbt->update_one("",$update_primary,"$_='@txt18'");
# }
}
#Text Sonstiges
elsif($_ =~ /txt29/){
# if($varenv{dbname} ne "sharee_primary"){
#on all $keys which on delete on loop sync
$u_rows = $dbt->update_one("",$update_primary,"$_='$valxx'");
# }
}
#txt15=Bonus- oder Antragsnummer (falls vorhanden)=15
#only check bonusnr and add operators dbname.
#bonustarif will be set after operator insert
elsif($_ eq "txt15"){
#only done by App web iframe Anmelde-Registration formular
print FILE "Bonusnr request $_: $valxx\n" if($debug);
if($varenv{dbname} eq "sharee_primary"){
my %txt17 = ();
if($ctadr->{txt17} =~ /\w\s\w/){
%txt17 = map { $_ => 1 } split(/\s+/,$ctadr->{txt17});
}else{
$txt17{$ctadr->{txt17}} = 1;
}
if($valxx && ($valxx =~ /^(\w{2,3})-(\w+)/ || $valxx =~ /^(\w{2,3})(\d+)/)){
$valxx =~ s/\s//g;
my $bonus_prefix = uc($1),
my $bonusnr = $2;
my $operator_conf = $dbt->get_operator_conf($bonus_prefix);
if(ref($operator_conf) eq "HASH" && $operator_conf->{oprefix} && $operator_conf->{database}->{dbname}){
print FILE "Bonus- oder Antragsnummer $valxx : " . $operator_conf->{oprefix} . " " . $operator_conf->{database}->{dbname} . "\n" if($debug);
my $dbh_operator = $dbt->dbconnect_extern($operator_conf->{database}->{dbname});
#to get operator bonusnr
my $pref_bo = {
table => "content",
fetch => "one",
template_id => "228",
int03 => ">::0",
ct_name => "$bonusnr",
};
my $bonus_record = $dbt->fetch_record($dbh_operator,$pref_bo);
#add operators dbname only if Bonusnr matches
print FILE "txt15=$bonusnr requested on web Bonustarif on: $operator_conf->{database}->{dbname} --> barcode:$bonus_record->{barcode} --> txt21:$bonus_record->{int21} --> txt22:$bonus_record->{int22}\n" if($debug);
if($bonus_record->{c_id}){
$txt17{$operator_conf->{database}->{dbname}} = 1;
my @operators = ();
foreach my $keys (keys %txt17) {
push(@operators,$keys) if($keys =~/sharee_/);
}
print FILE "txt17 saving operators on primary: @operators\n" if($debug);
$u_rows = $dbt->update_one($dbh,$update_primary,"txt17='@operators'");
#insert adr to operator if it doesn't exist before set operator bonustarif
my $ctadr_operator = $dbt->fetch_record($dbh_operator,$authref);
my @txt30_op = ();
#multiple select sharee Tarif
@txt30_op = ("$ctadr_operator->{txt30}") if($ctadr_operator->{txt30});
@txt30_op = split(/\s+/,$ctadr_operator->{txt30}) if($ctadr_operator->{txt30} =~ /\w\s+\w/);
if(!$ctadr_operator->{c_id}){
print FILE "Bonus oprefix address INSERT adr from record_primary to operator $operator_conf->{database}->{dbname} , c_id:$ctadr->{c_id}\n";
my $insert_op = {
%$ctadr,
table => "contentadr",
mtime => 'now()',
owner => "198",
};
my $c_id_op = $dbt->insert_contentoid($dbh_operator,$insert_op,"reset_adropkeys");
$dbt->update_content4comp($dbh_operator,$bonus_record->{c_id},"-","1");
@txt30_op = ("$bonus_record->{int22}") if($bonus_record->{int22});
}
my $adr_bonus = {
table => "contentadr",
mtime => "now()",
c_id => $c_id,
txt15 => $bonusnr,
txt30_array => \@txt30_op,
owner => $owner,
ret => $ret,
};
print FILE "adr_bonus" . Dumper($adr_bonus) . "\n";
$ret = $pl->set_usertarif($dbh,$operator_conf->{database}->{dbname},$adr_bonus);
}
}else{
$ret = "failure::txt15#top5";
}
}elsif($valxx && $valxx =~ /\w+/){
$ret = "failure::txt15#top6";
}
}
}
#sharee txt30=Tarif (multible) and Bonusnummer txt15 automatic
elsif($_ eq "txt30"){
#only done by Operator DMS
if($varenv{dbname} ne "sharee_primary"){
my @txt30 = $q->param('txt30');#multiple select sharee Tarif
@txt30 = grep {!/null/} @txt30;
my $bonusnr = $q->escapeHTML("$R::txt15");#on Operator DMS without oprefix-
my $bonushash = {
table => "contentadr",
mtime => "now()",
c_id => $c_id,
txt15 => $bonusnr,
txt30_array => \@txt30,
owner => $owner,
ret => $ret,
};
$ret = $pl->set_usertarif($dbh,$varenv{dbname},$bonushash);
}
#phonenr
}elsif($_ eq "txt07"){
$valxx =~ s/[\s\-\/]//g;
if($valxx !~ /\d{9}/ || length($valxx) > 16 || $valxx !~ /\+[1-9]{3}/){
$ret = "failure::$_#top";
}else{
my $lastnum = $valxx;
$lastnum = $1 if($valxx =~ /(\d{9})$/);
my $phone_check = &check_account("","txt07","~",$lastnum,"c_id","!=",$c_id);
if($phone_check->{c_id} && $phone_check->{c_id} != $c_id){
$ret_conflict = "failure::conflict_$_=$valxx#top";
}
#smsAck reset
if($valxx ne $ctadr->{txt07}){
$u_rows = $dbt->update_one($dbh,$update_primary,"int13=0");
}
$u_rows = $dbt->update_one($dbh,$update_primary,"$_='$valxx'");
my $email = $R::txt08;
$email =~ s/\s//g;
my $confirm_digest = sha1_base64($email . $valxx);
$u_rows = $dbt->update_one($dbh,$update_primary,"txt34='$confirm_digest'");
}
#user alias email
}elsif($_ eq "txt08"){
$valxx =~ s/\s//g;
if($valxx !~ /\w\@\w/){
$ret = "failure::$_#top";
}else{
my $account_check = &check_account("","txt08","ilike",$valxx,"c_id","!=",$c_id);
print FILE "$account_check->{c_id} && $account_check->{c_id} != $c_id\n" if($debug);
if($account_check->{c_id} && $account_check->{c_id} != $c_id){
$ret_conflict = "failure::conflict_$_=$valxx#top";
}
#mailAck reset
if($valxx ne $ctadr->{txt08}){
$u_rows = $dbt->update_one($dbh,$update_primary,"int04=0");
}
$u_rows = $dbt->update_one($dbh,$update_primary,"$_='$valxx'");
}
}elsif($_ eq "int12"){
if($varenv{dbname} eq "sharee_primary" && $ctadr->{int12} == 2){
$u_rows = $dbt->update_one($dbh,$update_primary,"$_=2");
}else{
$u_rows = $dbt->update_one($dbh,$update_primary,"$_=$valxx");
}
}elsif($_ =~ /^int|barcode/){
$u_rows = $dbt->update_one($dbh,$update_primary,"$_=$valxx");
}elsif($_ eq "ct_name" && $R::base_edit){
$u_rows = $dbt->update_one($dbh,$update_primary,"$_='$valxx'");
#}elsif($_ !~ /ct_name|txt22|txt23|txt15/){
}elsif($_ !~ /ct_name|txt15/){
$u_rows = $dbt->update_one($dbh,$update_primary,"$_='$valxx'");
}
#Additionals after default updater
#on IBAN/BIC change set override Mandantsreferenz to c_id to trigger payone
if(($_ eq "txt22" && $valxx ne $ctadr->{txt22}) || ($_ eq "txt23" && $valxx ne $ctadr->{txt23})){
$u_rows += $dbt->update_one($dbh,$update_primary,"ct_name='$c_id'");
}
if($_ =~ /txt22/ && $valxx){
my $currency = "EUR";
$currency = "CHF" if($valxx =~ /^(CH)/i);
$u_rows = $dbt->update_one($dbh,$update_primary,"txt24='$currency'");
}
print FILE "-----> $_: $valxx\n" if($debug);
$ret = "failure::$_#top" if(($_ =~ /int14/) && ($valxx eq "null" || !$valxx));#sharee AGB
#Zahlungsart
$ret = "failure::$_#top" if(($_ =~ /int03/) && ($valxx eq "null" || !$valxx));
$ret = "failure::$_#top" if($_ =~ /txt01/ && $valxx !~ /[a-zäöü]+\s+[a-zäöü]+/i);
$ret = "failure::$_#top" if($_ =~ /txt03/ && ($valxx !~ /[\w|\.]+\s+\d+/ && $valxx !~ /\d+\s+[\w|\.]+/));
if($_ =~ /txt04/ && !$pw_dummy){
my $alphacount = 0;
my $alphafail = 0;
$alphacount = () = $valxx =~ /[a-z]/gi;
$alphafail = length($valxx) - $alphacount;
if(!$valxx || length($valxx) < 8 || $alphafail < 2){
#$ret = "failure::pwlazy_txt04#top";
$ret = "failure::$_#top";
}
}
$ret = "failure::$_#top" if($_ =~ /txt06/ && $valxx !~ /\d+\s+[a-zäöü]+/i);
$ret = "failure::$_#top" if($_ =~ /txt08/ && $valxx !~ /\w\@\w/);
$ret = "failure::$_#top" if($R::sharee_edit && $_ =~ /txt22/ && $valxx !~ /\w/);
$ret = "failure::$_#top" if($R::sharee_edit && $_ =~ /txt23/ && $valxx !~ /\w/);
}
print FILE "ret: $ret | ret_conflict: $ret_conflict\n" if($debug && ($ret || $ret_conflict));
}#end foreach keyword
#payone only if SEPA Mandat checked
#Testbuchhung mit 1 € preauthorization and 0 € capture
$ctadr = $dbt->fetch_record($dbh,$authref);
print FILE "+++ $R::request && $ctadr->{int03} == 1 && $ctadr->{ct_name} eq $ctadr->{c_id} \n" if($debug);
if($R::request eq "managemandate" && $ctadr->{int03} == 1 && $ctadr->{ct_name} eq $ctadr->{c_id}){
my $vde_on_fail = $ctadr->{int12} || 3;#keep last or set 3
my $payone_mival = $payone->managemandate_main(\%varenv,$ctadr,"",$owner);
if($payone_mival && $payone_mival =~ /\w{2}-\d+/){
#define fictiv invoice to get 1 € test
my $epoche = time();
my $ctt = {
c_id => 1,
int01 => 0,
int15 => 1,
txt16 => "",
reference => "$ctadr->{c_id}_$epoche",
renewed => ''
};
my $payone_txid = "";
$payone_txid = $payone->preauthorizationSEPA_main(\%varenv,$ctadr,$ctt,$owner);
if($payone_txid){
$ctt->{txt16} = "$payone_txid";
$payone_txid = $payone->captureSEPA_main(\%varenv,$ctadr,$ctt,$owner);
}else{
$u_rows = $dbt->update_one($dbh,$update_primary,"int12=$vde_on_fail");#Vde
}
}else{
$u_rows = $dbt->update_one($dbh,$update_primary,"int12=$vde_on_fail");#Vde
}
#$u_rows = $dbt->update_one($dbh,$update_primary,"int12=3");#Vde test fail
}
if($R::txt04 && $R::confirm_txt04 && $R::txt04 ne $R::confirm_txt04){
$ret = "failure::confirm_txt04#top";
}
if($ret =~ /failure::(\w+)/ && $ret !~ /txt15|txt16/){#persistent failure without Bonus or Gutschein
my $rval = $1;
#$rval =~ s/pwlazy_//g;#obsolet, all done in pw template description
$rval =~ s/confirm_//g;#PW confirm
$rval =~ s/conflict_//g;#conflict
print FILE "ret: $ret | rval: $rval\n" if($debug);
$dbt->update_one($dbh,$update_primary,"txt31='$rval'");
}elsif($fkeys =~ /$ctadr->{txt31}/){
print FILE " No failure and empty txt31 (fkeys: $fkeys =~ /$ctadr->{txt31}/) \n" if($debug);
$u_rows = $dbt->update_one($dbh,$update_primary,"txt31=''");
}
$ret = $ret_conflict if($ret_conflict);
print FILE "final ret: $ret \n" if($debug);
close(FILE) if($debug);
#if(!$ret){#we do it also on failures to get sync
#update operator with primary data after COPRI address edit
$dbt->update_operatorsloop($varenv{dbname},$ctadr->{c_id},"update");
return ($ret,"$i_rows-$u_rows-$d_rows");
}
#insert/save/delete DMS users
sub manage_dmsusers {
my $self = shift;
my $base_edit = shift;
my $u_id = shift;
my $users_dms = shift || {};
my $owner = $users_dms->{u_id} || 0;
my $table = "users";
$q = new CGI;
$q->import_names('R');
my @keywords = $q->param;
my $now_dt = strftime "%Y-%m-%d %H:%M:%S", localtime;
my %varenv = $cf->envonline();
$bw->log("manage_dmsusers",$q,"");
my $dbh = "";
my $authref = {
table => "contentadr",
fetch => "one",
template_id => "202",
c_id => "$u_id",
};
my $ctadr = $dbt->fetch_record($dbh,$authref);
#users have to be exist only if DMS activated
my $uref = {
table => "users",
fetch => "one",
u_id => "$u_id",
};
my $users = $dbt->fetch_tablerecord($dbh,$uref);
#datahash on update
my $dmsusers = {
table => "users",
mtime => "now()",
owner => "$owner",
u_id => "$u_id",
};
if(ref($users) eq "HASH" && $users->{u_id} && (!$ctadr->{c_id} || $base_edit eq "delete_dmsusers")){
$bw->log("delete DMS user from $varenv{dbname}",$ctadr->{c_id},"");
$d_rows += $dbt->delete_content($dbh,"users",$u_id);
}elsif(ref($users) eq "HASH" && $users->{u_id} && $ctadr->{c_id} && $ctadr->{c_id} == $users->{u_id} && $base_edit eq "save_dmsusers"){
$bw->log("update DMS user to $varenv{dbname}",$ctadr->{c_id},"");
foreach(@keywords){
my $val = $q->param($_);
my $valxx = $q->escapeHTML("$val");
$valxx =~ s/^\s+//; $valxx =~ s/\s+$//;
if($_ =~ /^int\d+/){
$valxx =~ s/,/./g;
#$valxx = "null" if(!looks_like_number($valxx));#empty
$valxx = 0 if(!looks_like_number($valxx));# set to 0 for using == operator
$u_rows = $dbt->update_one($dbh,$dmsusers,"$_=$valxx");
}
}
}elsif($ctadr->{c_id} && !$users->{u_id} && $base_edit eq "new_dmsusers"){
$bw->log("insert DMS user to $varenv{dbname}",$ctadr->{c_id},"");
$i_rows = $dbt->insert_users($dbh,$ctadr->{c_id},$owner);
}
return "$i_rows-$u_rows-$d_rows";
}
#coupon alias Gutschein
sub save_transact(){
my $self = shift;
my ($c_id,$coo,$owner) = @_;
$q = new CGI;
$q->import_names('R');
my @keywords = $q->param;
my $now_dt = strftime "%Y-%m-%d %H:%M:%S", localtime;
my %varenv = $cf->envonline();
$bw->log("save_transact",$q,"");
my $debug=1;
my $dbh = "";#keep in mind, empty dbh defaults to local copri-instance dbname
open(FILE,">>$varenv{logdir}/save_account.log") if($debug);
print FILE "\n*-->local copri-Instance DB $varenv{dbname} $now_dt| c_id: $c_id \n" if($debug);
my $authref = {
table => "contentadr",
fetch => "one",
template_id => "202",
c_id => "$c_id",
};
my $ctadr = $dbt->fetch_record($dbh,$authref);
my $update_primary = {
table => "contentadr",
mtime => "now()",
owner => "$owner",
c_id => "$c_id",
};
my $pos_id="";
my $ret;
my $fkeys;
foreach(@keywords){
$fkeys .= "$_,";
my $val = $q->param($_);
my $valxx = $q->escapeHTML("$val");
#print "|$_: $valxx";
$valxx =~ s/^\s+//;
$valxx =~ s/\s+$//;
#Gutschein
if($_ eq "txt16"){
print FILE "Gutschein request $_: $valxx\n" if($debug);
if($valxx && ($valxx =~ /^(\w{2,3})-(\w+)/ || $valxx =~ /^(\w{2,3})(\d+)/)){
$valxx =~ s/\s//g;
my $coupon_prefix = uc($1),
my $coupon_nr = $2;
my $operator_conf = $dbt->get_operator_conf($coupon_prefix);
if(ref($operator_conf) eq "HASH" && $operator_conf->{oprefix} && $operator_conf->{database}->{dbname}){
print FILE "Gutschein $valxx : " . $operator_conf->{oprefix} . " " . $operator_conf->{database}->{dbname} . "\n" if($debug);
my $dbh_operator = $dbt->dbconnect_extern($operator_conf->{database}->{dbname});
#to get operator coupon_nr
my $pref_co = {
table => "content",
fetch => "one",
template_id => "224",
int03 => ">::0",
ct_name => "$coupon_nr",
};
my $ct = { c_id => 0 };
$ct = $dbt->fetch_record($dbh_operator,$pref_co);
$ct->{int02} *= -1 if($ct->{int02} > 0);#coupon price must be negate
print FILE "txt16=$coupon_nr, unit_price $ct->{int02} --> requested on web on: $operator_conf->{database}->{dbname} --> barcode:$ct->{barcode}\n" if($debug);
if($ct->{c_id}){
my $ctadr_operator = { c_id => 0 };
$ctadr_operator = $dbt->fetch_record($dbh_operator,$authref);
if(!$ctadr_operator->{c_id}){
print FILE "Gutschein oprefix address INSERT adr from record_primary to operator $operator_conf->{database}->{dbname} , c_id:$ctadr->{c_id}\n";
my $insert_op = {
%$ctadr,
table => "contentadr",
mtime => 'now()',
owner => "198",
};
my $c_id_op = $dbt->insert_contentoid($dbh_operator,$insert_op,"reset_adropkeys");
}
$ctadr_operator = $dbt->fetch_record($dbh_operator,$authref);
if($ctadr_operator->{c_id} > 0){
my $pref = {
table => "contenttrans",
fetch => "one",
main_id => 300008,#must be Rechnung (and not Storno)
template_id => 218,
#ca_id => "$ctadr->{c_id}",
int10 => "$ctadr_operator->{c_id}",
state => "is::null",
close_time => "is::null",
};
my $ctt = { c_id => 0 };
$ctt = $dbt->fetch_record($dbh_operator,$pref);
if($ctt->{c_id} > 0){
$pos_id = $dbt->insert_pos($dbh_operator,$ctt->{c_id},$ct,$ctadr_operator,"",$now_dt,$ct->{ct_name},"0",$owner);
}else{
my $ct_id = $dbt->insert_contenttrans($dbh_operator,$ctadr_operator,"300008","218","----",$owner);
$pos_id = $dbt->insert_pos($dbh_operator,$ct_id,$ct,$ctadr_operator,"",$now_dt,$ct->{ct_name},"0",$owner);
}
if($pos_id){
$ret = "success::txt16";
$dbt->update_content4comp($dbh_operator,$ct->{c_id},"-","1");
}
}else{
$ret = "failure::txt16#top";
}
}else{
$ret = "failure::txt16#top";
}
}
}elsif($valxx && $valxx =~ /\w+/){
$ret = "failure::txt16#top";
}
}
}
print FILE "save_transact ret: $ret \n" if($debug);
close(FILE) if($debug);
return $ret;
}#end save_transact
#online net bike booking
#Used by APP API
sub net_booking(){
my $self = shift;
my $auth = shift;#API auth
my $bikeIDin = shift;#API request
my $owner = shift;
my $gps = shift || "";
my $c_id = $auth->{c_id};
$bikeIDin =~ s/\s//g;
my $bikeID = $q->escapeHTML($bikeIDin) if($bikeIDin =~ /\d+$/);
my $db_bike = $bikeID;
$db_bike = $1 if($db_bike =~ /(\d+)/);
my %varenv = $cf->envonline();
my $ctf = $db->get_content1("contentuser",$dbt->{shareedms_conf}->{parent_id});
my $pos_id="";
my $return=0;
my $now_dt = strftime "%Y-%m-%d %H:%M", localtime;
my $dbh = "";
my $response_state = "OK";
my $response_text = "";
$bw->log("net_booking booking_request bikeIDin $bikeIDin, authID $auth->{c_id}","","");
my $ctadr = $db->get_contentrow("contentadr",$auth->{c_id});
my $pref = {
table => "contenttrans",
fetch => "one",
main_id => 300008,
template_id => 218,
#ca_id => "$ctadr->{c_id}",#TODO
int10 => "$ctadr->{c_id}",
state => "null",
close_time => "is::null",
};
my $main_ids;
my ($bike_group,$user_group,$tariff_content,$user_tour) = $apif->fetch_tariff($ctadr,"");
$main_ids = join(",",@{$bike_group});
$main_ids =~ s/[a-z_]+//ig;
my $ct = {};
my $pref_cc = {
table => "content",
fetch => "one",
main_id => "IN::($main_ids)",
barcode => $db_bike,
int10 => 1,
};
$ct = $dbt->fetch_record($dbh,$pref_cc) if($main_ids);
#$tariff_nr in contentadr are saved by COPRI OR user Tarif-Select!!!
#This is the automatic user tariff setter
my $tariff_nr = "";
my @adr_tariff = ();
@adr_tariff = ("$ctadr->{txt30}");
@adr_tariff = split(/\s+/,$ctadr->{txt30}) if($ctadr->{txt30} =~ /\w\s+\w/);
if(ref($ct) eq "HASH" && $ct->{main_id}){
foreach my $id (keys (%$tariff_content)){
foreach(@adr_tariff){
if($tariff_content->{$id}->{int12} && $tariff_content->{$id}->{int12} == $ct->{main_id} && $tariff_content->{$id}->{barcode} && $_ == $tariff_content->{$id}->{barcode}){
$tariff_nr = $tariff_content->{$id}->{barcode};
}
}
}
#2021-07-10, if no tarif then update user account to fallback default public or private or hidden tarif
#if(!$tariff_nr && !$ctadr->{txt30})
if(!$tariff_nr){
foreach my $id (keys (%$tariff_content)){
# #int18
#<sharing_type>
# 2 = "public"
# 3 = "private"
# 4 = "hidden-lv"
#</sharing_type>
if($tariff_content->{$id}->{int18} && ($tariff_content->{$id}->{int18} == 2 || $tariff_content->{$id}->{int18} == 3 || $tariff_content->{$id}->{int18} == 4)){
if($tariff_content->{$id}->{int12} && $tariff_content->{$id}->{int12} == $ct->{main_id} && $tariff_content->{$id}->{barcode}){
$tariff_nr = $tariff_content->{$id}->{barcode};
}
}
}
$bw->log("--> NO user tariff defined, update user account to fallback default public or private or hidden",$tariff_nr,"");
$db->updater("contentadr","c_id",$ctadr->{c_id},"txt30","$tariff_nr",$owner);
}else{
$bw->log("--> user tariff selected",$tariff_nr,"");
}
}
$bw->log("---> bike $ct->{barcode} matching by bike_group: @{$bike_group} main_ids:$main_ids | user_group:@{$user_group} | Tarif selected: $tariff_nr",$tariff_content->{$tariff_nr},"");
if($ct->{c_id} && $tariff_nr){
my $ctt;
my $payoneable_check=0;
if(($ctadr->{int03} == 1 && $ctadr->{ct_name} =~ /\w{2}-\d+/ && $ctadr->{ct_name} !~ /LV-\d+/) || ($ctadr->{int03} == 2 && length($ctadr->{ct_name}) >= 19) || ($ctadr->{int03} == 1 && $varenv{dbname} eq "sharee_lv" && $ctadr->{ct_name} =~ /LV-\d+/)){
$payoneable_check=1;
}else{
$response_state="Failure 1006: There is no valid payment methode";
$response_text="Bitte überprüfen Sie Ihre Profildaten auf Vollständigkeit, nur dann können wir das Fahrradmietsystem für Sie freischalten";
}
$bw->log("--->0. payable_check=$payoneable_check for $ctadr->{txt08} int01=$ctadr->{int01}|int03=$ctadr->{int03}|int04=$ctadr->{int04}|int13=$ctadr->{int13}|int12=$ctadr->{int12}|$ctadr->{ct_name}|length($ctadr->{ct_name}) >= 19\n","","");
#int04==1 if email Ack
#int13==1 if sms Ack
#int12!=1|2|3 if Vde
#int14==1 if AGB
if($ctadr->{txt08} && $ctadr->{int04} == 1 && $ctadr->{int13} == 1 && !$ctadr->{int12} && $ctadr->{int14} && $payoneable_check){
$bw->log("---> net_booking select Tarif ct->{main_id}:$ct->{main_id}| tariff_nr:$tariff_nr| ct_tariff --> Tarif-Nr:$tariff_content->{$tariff_nr}->{barcode}|Tarif desc:$tariff_content->{$tariff_nr}->{ct_name}|unit_price:$tariff_content->{$tariff_nr}->{int02}|max EUR/Tag:$tariff_content->{$tariff_nr}->{int17}|Abo EUR:$tariff_content->{$tariff_nr}->{int15}|Gratis Std/Rad:$tariff_content->{$tariff_nr}->{int16}\n","","");
$ctt = $dbt->fetch_record($dbh,$pref);
#if invoice exist
if($ctt->{c_id}){
my $ctpos = {};
if($bikeID && $ctadr->{c_id}){
my $booking_pos = {
table => "contenttranspos",
fetch => "one",
barcode => "$db_bike",
int10 => "IN::('2','3')",
ca_id => "$ctadr->{c_id}",
};
$ctpos = $dbt->fetch_tablerecord($dbh,$booking_pos);
}
if(!$ctpos->{c_id}){
#2 = "requested"
$pos_id = $dbt->insert_pos($dbh,$ctt->{c_id},$ct,$ctadr,$tariff_content->{$tariff_nr},$now_dt,"$bikeID","2","$owner");
if($pos_id){
$response_state = "OK, bike " . $bikeID . " succesfully requested";
$response_text = "Fahrrad Nr. $bikeID wurde erfolgreich für 15 Min. reserviert";
$bw->log("--->2. (insert contenttranspos pos_id: $pos_id\n","","");
#require "Mod/KMLout.pm";
#my $kmlfile = Mod::KMLout::kmlGenerator($ctadr,"");
$db->updater("contenttrans","c_id",$ctt->{c_id},"start_time","$now_dt",$owner);
$db->updater("contenttrans","c_id",$ctt->{c_id},"end_time","$now_dt",$owner);
}else{
$response_state="Failure 1007: booking request fails";
$response_text="Entschuldigung, es ist ein Fehler aufgetreten. Bitte kontaktieren Sie unsere Hotline damit wir das Problem lösen können";
}
}
#else if invoice does not exist, generate one
}else{
my $ct_id;
if($ctt->{c_id}){
$ct_id = $ctt->{c_id};
}else{
$ct_id = $dbt->insert_contenttrans($dbh,$ctadr,"300008","218","----","$owner");
$ctt = $dbt->fetch_record($dbh,$pref);
}
$ctt = $dbt->fetch_record($dbh,$pref);
#TODO refactory, routines douple definend
if($ctt->{c_id}){
my $ctpos = {};
if($bikeID && $ctadr->{c_id}){
my $booking_pos = {
table => "contenttranspos",
fetch => "one",
barcode => "$db_bike",
int10 => "IN::('2','3')",
ca_id => "$ctadr->{c_id}",
};
$ctpos = $dbt->fetch_tablerecord($dbh,$booking_pos);
}
if(!$ctpos->{c_id}){
#2 = "requested"
$pos_id = $dbt->insert_pos($dbh,$ctt->{c_id},$ct,$ctadr,$tariff_content->{$tariff_nr},$now_dt,"$bikeID","2","$owner");
if($pos_id){
$response_state = "OK, bike " . $bikeID . " succesfully requested";
$response_text = "Fahrrad Nr. $bikeID wurde erfolgreich für 15 Min. reserviert";
$bw->log("--->3. (insert contenttranspos pos_id: $pos_id\n","","");
#require "Mod/KMLout.pm";
#my $kmlfile = Mod::KMLout::kmlGenerator($ctadr,"");
$db->updater("contenttrans","c_id",$ctt->{c_id},"start_time","$now_dt",$owner);
$db->updater("contenttrans","c_id",$ctt->{c_id},"end_time","$now_dt",$owner);
}else{
$response_state="Failure 1008: booking request fails";
$response_text="Entschuldigung, es ist ein Fehler aufgetreten. Bitte kontaktieren Sie unsere Hotline damit wir das Problem lösen können";
}
}
}
}
}else{#end Vde AGB and payable_check
$response_state="Failure 1005: user-account deactivated because of failing data";
$response_text="Bitte überprüfen Sie Ihre Profildaten auf Vollständigkeit, nur dann können wir das Fahrradmietsystem für Sie freischalten";
}
}else{
my $ctpos = {};
my $booking_pos = {
table => "contenttranspos",
fetch => "one",
barcode => "$db_bike",
int10 => "IN::('2','3')",
ca_id => "$ctadr->{c_id}",
};
$ctpos = $dbt->fetch_tablerecord($dbh,$booking_pos) if($bikeID && $ctadr->{c_id});
if($ctpos->{c_id}){
$response_state = "OK, bike " . $bikeID . " already requested or occupied";
$response_text = "Fahrrad Nr. " . $bikeID . " ist bereits reserviert";
}elsif($ct->{c_id} && !$tariff_nr){
$response_state="Failure 2089: booking bike $bikeID fails, no user tariff available";
$response_text="Reservierungsfehler Fahrrad Nr. $bikeID. Es konnte kein Mietrad Tarif gefunden werden.";
}else{
$response_state="Failure 2001: booking bike $bikeID fails, bike not available";
$response_text="Fahrrad Nr. $bikeID ist leider nicht verfügbar. U.U. ist die Fahrrad Flotte für Sie nicht freigeschaltet. Bitte überprüfen Sie Ihre Profildaten auf Vollständigkeit";
}
}
$bw->log("response_state:$response_state\n","","");
if(ref($auth) eq "HASH"){
$return = {
bike => "$bikeID",
state => "requested",
response_state => "$response_state",
response_text => "$response_text"
};
}else{
if($response_state =~ /Failure/){
$return = "failure::int01 $response_state";
}
}
return $return;
}
#Send sms after payable check and !int13
sub smsack(){
my $self = shift;
my $ctadr = shift;
$smstrans->sms_ack_digest($ctadr);
}
#Send email after payable check and !int04
sub emailack(){
my $self = shift;
my $c_id = shift;
my %varenv = $cf->envonline();
system(`$varenv{basedir}/src/Mod/newsletter_tink.pl "$varenv{basedir}" "$varenv{wwwhost}" "emailack" "$c_id" ""`);
}
#Password forgotten send email
sub send_password(){
my $self = shift;
my ($email,$coo,$owner) = @_;
my %varenv = $cf->envonline();
$email = $q->escapeHTML($email);
$email =~ s/\s//g;
my $pwmd5 = md5_hex($coo);
$db->updater("contentadr","1","1","txt11","$pwmd5","$owner","txt08","ilike","$email");
system(`$varenv{basedir}/src/Mod/newsletter_tink.pl "$varenv{basedir}" "$varenv{wwwhost}" "send_password" "$email" "$coo"`);
}
1;

68
copri4/main/src/Mod/ajax_json.pm Normal file
View file

@ -0,0 +1,68 @@
package Mod::ajax_json;
#
# SPDX-License-Identifier: AGPL-3.0-or-later
# Copyright (c) Rainer Gümpelein, TeilRad GmbH
#
use warnings;
use strict;
use POSIX;
use CGI;
use Apache2::Const -compile => qw(OK );
use DBI;
use JSON;
use Mod::Libenzdb;
use Lib::Config;
use Data::Dumper;
sub handler {
my ($r) = @_;
my $q = new CGI;
$q->import_names('R');
my $db = new Libenzdb;
my $cf = new Config;
my %varenv = $cf->envonline();
my $now_dt = strftime "%Y-%m-%d %H:%M:%S", localtime;
my $lang="de";
my $main_id = $q->param('main_id');
my $table = $q->param('table');
my $search = $q->param('term');
my @keywords = $q->param;
my @query_output = ();
my $debug=1;
print $q->header(-type => "application/json", -charset => "utf-8");
open(FILE,">>/var/log/copri4/ajax_json.log") if($debug);
print FILE "$now_dt|$main_id\n" if($debug);
foreach(@keywords){
my @val = $q->param($_);
my $valxx = $q->escapeHTML("@val");
if($_ eq "c_idadr"){
$search = $valxx;
}
print FILE "$_: $valxx\n" if($debug);
}
if($table eq "content"){
my $sth = $db->search_json("$table","$lang","$search","$main_id");
while ( my $row = $sth->fetchrow_hashref ){
push @query_output, $row;
}
print FILE Dumper(\@query_output) if($debug);
print JSON::to_json(\@query_output);
}elsif($table eq "contentadr"){
my $sth = $db->search_jsonadr("$table","$lang","$search","$main_id","");
while ( my $row = $sth->fetchrow_hashref ){
push @query_output, $row;
}
print FILE Dumper(\@query_output) if($debug);
print JSON::to_json(\@query_output);
}
close(FILE) if($debug);
return Apache2::Const::OK;
}
1;

96
copri4/main/src/Mod/ajax_post.pm Normal file
View file

@ -0,0 +1,96 @@
package Mod::ajax_post;
#
# SPDX-License-Identifier: AGPL-3.0-or-later
# Copyright (c) Rainer Gümpelein, TeilRad GmbH
#
use strict;
use warnings;
use POSIX;
use CGI ':standard';
use Apache2::Const -compile => qw(OK );
use Scalar::Util qw(looks_like_number);
use Lib::Config;
use Mod::Libenzdb;
use Mod::Libenz;
sub handler {
my ($r) = @_;
my $q = new CGI();
$q->import_names('R');
my @keywords = $q->param;
my $cf = new Config;
my $db = new Libenzdb;
my $lb = new Libenz;
my %varenv = $cf->envonline();
my $now_dt = strftime "%Y-%m-%d %H:%M:%S", localtime;
my $lang = "de";
print $q->header(-charset=>'utf-8');
open(FILE,">>$varenv{logdir}/ajax_post.log");
print FILE "\n\nPost-start: $now_dt\n";
foreach my $xkey (@keywords){
my @val;
my $matrix_val;
my $tpl_id;
my $xval;
if($xkey =~ /^matrix_/){
@val = $q->param($xkey);
foreach(@val){
my ($key,$des,$size,$interval,$service_type) = split /=/,$_;
#print FILE "$key,$des,$size,$interval,$service_type\n";
my $interval = 0;
$interval = $q->param("interval_$key") if(looks_like_number($q->param("interval_$key")));
my $service_type = 0;
$service_type = $q->param("servicetype_$key") if(looks_like_number($q->param("servicetype_$key")));
print FILE "\n$key --> interval: $interval | service_type: $service_type\n";
$matrix_val .= "$_=$interval=$service_type,";# if($interval =~ /(\d+)/);
}
$matrix_val =~ s/,$//;
#print FILE "$xkey: @val\n";
#print FILE "matrix_val: $matrix_val\n";
#}elsif($_ =~ /^ckid_rel|ckid_main|edit_main|post_request/){
}else{
my @xval = $q->param($xkey);
foreach(@xval){
$xval .= "$_," if($_);
}
$xval =~ s/,$//;
print FILE "$xkey: $xval (owner: $R::owner)\n";
}
if($xkey =~ /c_id4trans/ && looks_like_number($R::owner) && looks_like_number($xval)){
$db->update_ajaxes("users","","","","c_id4trans","$xval","$R::owner");
}
if($xkey =~ /matrix_users/ && $R::owner){
$matrix_val = "" if($R::u_group =~ /supervisor/);
$db->update_ajaxes("users","","","","checkboxes","$matrix_val","$R::owner");
}
if($xkey =~ /matrix_template/ && $R::template_id){
$db->update_ajaxes("template","tpl_id","=","$R::template_id","tpl_order","$matrix_val","");
print FILE "update_ajaxes(\"template\",\"tpl_id\",\"=\",\"$R::template_id\",\"tpl_order\",\"$matrix_val\")\n";
}
if($xkey =~ /k9itemList_(\d+)/){
$db->update_ajaxes("template","tpl_id","=","$1","tpl_order","$xval","");
}
#because of downward compatibility
if($xkey =~ /^ckid_rel/ && $R::owner){
$db->update_ajaxes("users","","","","checked4dragg","$xval","$R::owner");
}
if($xkey =~ /^ckid_main/ && $R::owner){
$db->update_ajaxes("users","","","","view_list","$xval","$R::owner");
}
if($xkey =~ /^edit_main/ && $R::owner){
$db->update_ajaxes("users","","","","edit_list","$xval","$R::owner");
}
}
close(FILE);
return Apache2::Const::OK;
}
1;

564
copri4/main/src/Mod/newsletter_tink.pl Normal file
View file

@ -0,0 +1,564 @@
#!/usr/bin/perl -w
#
## SPDX-License-Identifier: AGPL-3.0-or-later
# Copyright (c) Rainer Gümpelein, TeilRad GmbH
#
#TODO, migrate to MailTransport.pm
#
#su www-data -c "./src/Mod/newsletter_tink.pl '/var/www/copri4/shareeapp-operator' 'https://shareeapp-operator.copri-bike.de' 'emailack' '1842'"
#on command
#sudo su www-data -c "./src/Mod/newsletter_tink.pl '/var/www/copri3/konrad' 'https://konrad.tink-konstanz.de' 'send_password' 'ragu@gnu-systems.de' '59e5c7bce6'"
#su www-data -c "./src/Mod/newsletter_tink.pl '/var/www/copri3/tinkdms' 'https://tinkdms.copri.eu' 'send_invoice' '1842' '2866'"
use strict;
use warnings;
use utf8;
use Encode;
use CGI ':standard';
use DBI;
use POSIX;
use Email::MIME;
use IO::All;
use Email::MIME::CreateHTML;
use Email::Sender::Simple qw(sendmail);
#use Email::Sender::Transport::SMTPS;
use Net::SMTP;
use Try::Tiny;
use Config::General;
use URI::Encode;
my $uri_encode = URI::Encode->new( { encode_reserved => 1 } );
use Data::Dumper;
use Sys::Hostname;
my $hostname = hostname;
my $q = new CGI;
my $basedir = $ARGV[0];
my $wwwhost = $ARGV[1];
my $todo = $ARGV[2];
my $c_id="";
my $ct_name="";
my $emailpw="";
my $coopw="";
if($todo =~ /emailack|send_invoice|send_capture_fail/){
$c_id = $ARGV[3] || "";#contentadr.c_id
$ct_name = $ARGV[4] || "";#contenttrans.c_id
}elsif($todo eq "send_password"){
$emailpw = $ARGV[3] || "";
$emailpw =~ s/\s//g;
$coopw = $ARGV[4] || "";
}
my $today = strftime("%d.%m.%Y %H:%M:%S",localtime(time));
my $globalconf_file = "/var/www/copri4/shareeconf/global.cfg";
my $gconf = Config::General->new($globalconf_file);
my %globalconf = $gconf->getall;
my $mailx_file = "/var/www/copri4/shareeconf/mailx.cfg";
my $mconf = Config::General->new($mailx_file);
my %mailxconf = $mconf->getall;
require "$basedir/src/Lib/Config.pm";
my %varenv = &Config::envonline("","$wwwhost");
#print Dumper(%varenv);
open(EMA, ">> $varenv{logdir}/newsletter_tink.log");
print EMA "\n$today, start mailing\n";
print EMA "'$today' '$basedir' '$wwwhost' '$todo' 'c_id:$c_id' 'invoice ct_name:$ct_name' 'emailpw:$emailpw' 'coopw:$coopw'\n";
close EMA;
my $dbh = &dbconnect();
sub dbconnect {
my $options ="";
my $dbh = DBI->connect("dbi:Pg:dbname=$varenv{dbname};host=$varenv{dbhost};port=5432;options='$options'", "$varenv{dbuser}", "$varenv{dbpassw}",{ RaiseError => 1, AutoCommit => 1 }) or die "Can't connect to $varenv{dbname}: $DBI::errstr";
return $dbh;
}
sub get_contentadr(){
my ($c_id,$emailpw) = @_;
my $where="where ct.c_id=rel.content_id";
$where .= " and ct.c_id=$c_id" if($c_id =~ /^\d+$/);
$where .= " and ct.txt08 ilike '$emailpw'" if($emailpw =~ /\w+/);
$where .= " and rel.template_id = 202";#tpl_id Adressen
my $sth = $dbh->prepare("SELECT * FROM contentadr ct, relation rel $where");
my $rc = $sth->execute();
my $ct = $sth->fetchrow_hashref();
return $ct;
}
sub get_content(){
my ($table,$c_id,$tpl_id) = @_;
my $where="where ct.c_id=rel.content_id";
$where .= " and ct.c_id=$c_id" if($c_id =~ /^\d+$/);
$where .= " and rel.template_id = $tpl_id" if($tpl_id =~ /^\d+$/);
my $sth = $dbh->prepare("SELECT * FROM $table ct, relation rel $where");
my $rc = $sth->execute();
my $ct = $sth->fetchrow_hashref();
return $ct;
}
#update trivial, matchs anything
sub updater(){
my ($table,$w_col,$w_val,$column,$content,$owner,$w_col2,$w_op2,$w_val2,$set_time) = @_;
my $ct_set = "mtime='now()'";
if($set_time eq "no_time"){
$ct_set = "";
}elsif($table !~ /content/){
$ct_set = "change='now()'";
}
if("$content" eq "null" || (!$content && $content !~ /^0$/)){
$ct_set .= ",$column=null";
}elsif($content || $content == 0){
$ct_set .= ",$column='$content'";
}
$ct_set .= ",owner='$owner'" if($owner);
$ct_set =~ s/^,/ /;
my $where = "$w_col='$w_val'";
$where .= " and $w_col2 $w_op2 ($w_val2)" if("$w_col2" && "$w_op2" && "$w_val2");
my $sth = $dbh->prepare("UPDATE $table SET $ct_set where $where");
my $rows = $sth->execute();
return $rows;
}
my $ctadr = &get_contentadr($c_id,$emailpw) if($c_id =~ /^\d+$/ || $emailpw =~ /\w+\@\w+/);
my $smtp = Net::SMTP->new($mailxconf{mailx}->{mail_gateway},
Port => 465,
Hello => 'fahrradspezialitaeten.com',
Timeout => 30,
Debug => 0,
SSL => 1,
);
#$varenv{sasl_password} = Encode::encode('iso-8859-1', Encode::decode('utf-8', $varenv{sasl_password}));
$smtp->auth($mailxconf{mailx}->{sasl_username},$mailxconf{mailx}->{sasl_password});
$smtp->mail($mailxconf{mailx}->{mail_from});
my $smtp_return = "";
if($todo eq "emailack"){
$smtp_return = &esender_success($smtp,$ctadr,$wwwhost);
}elsif($todo eq "send_password" && $ctadr->{txt08} =~ /\w+\@\w+/){
$smtp_return = &esender_password($smtp,$ctadr,$coopw,$wwwhost);
}elsif($todo eq "send_invoice"){
my $send_invoice;
$smtp_return = &esender_invoice($smtp,$todo,$ctadr,$ct_name,$wwwhost);
# if sendmail true then null. For us we need text
#if(!$smtp_return && $ct_name =~ /\d+/){
if($ct_name =~ /\d+/){
$today =~ s/:\d+$//;
$send_invoice = "$today, Rechnungsinfo per eMail versandt (debug: $smtp_return)";
&updater("contenttrans","ct_name","$ct_name","txt30","$send_invoice","","","","","no_time");
}
}elsif($todo eq "send_capture_fail"){
$smtp_return = &esender_invoice($smtp,$todo,$ctadr,$ct_name,$wwwhost);
}
open(EMA, ">> $varenv{logdir}/newsletter_tink.log");
print EMA "smtp_return: $smtp_return\n";
close EMA;
#Registration acknowledgement
sub esender_success {
my $smtp = shift;
my $ctadr = shift;
my $wwwhost = shift;
my %varenv = &Config::envonline("","$wwwhost");
my $ct = {};
if($varenv{syshost} =~ /konrad|tink/i){
$ct = &get_content("content","3435","1");
$ct->{txt01} = $q->unescapeHTML($ct->{txt01});
$ct->{txt01} =~ s/\r\n/<br \/>/g;
$ct->{txt01} = Encode::encode('iso-8859-1', Encode::decode('utf-8', $ct->{txt01}));
}else{
$ct = &get_content("contentuser",$globalconf{shareedms_conf}->{parent_node},"201");
}
my $email = $q->unescapeHTML($ctadr->{txt08});
my $anrede = $q->unescapeHTML($ctadr->{txt02});
my $name = $q->unescapeHTML($ctadr->{txt01});
$name = Encode::encode('iso-8859-1', Encode::decode('utf-8', $name));
my $strasse = $q->unescapeHTML($ctadr->{txt03});
$strasse = Encode::encode('iso-8859-1', Encode::decode('utf-8', $strasse));
my $ort = $q->unescapeHTML($ctadr->{txt06});
my $telefon = $q->unescapeHTML($ctadr->{txt07});
#Ack digest
my $ack_digest = $q->unescapeHTML($ctadr->{txt34}) || "";
my $email_ack_digest = $1 if($ack_digest =~ /^(\w{5})/);
my $sms_ack_digest = $1 if($ack_digest =~ /(\w{5})$/);
#disabled because of payone payment
#my $iban = $q->unescapeHTML($ctadr->{txt22});
#$iban =~ s/.{3}$/XXX/;
#IBAN: $iban (letzte drei Ziffern maskiert)
#email html body---------------------------------------------------
my $body;
if($varenv{syshost} =~ /konrad|tink/i){
my $encoded_email = $uri_encode->encode($ctadr->{txt08});
$body = <<EOF
Vielen Dank für Ihre Anmeldung.
Damit wir das Fahrradmietsystem für Sie freischalten können, benötigen wir abschließend eine Bestätigung. Klicken Sie hierzu auf folgenden Link:
<a href='http://www.konrad-konstanz.net?confirm_email=$encoded_email&confirm_code=$ctadr->{c_id}'>www.konrad-konstanz.net?confirm_email=$encoded_email&confirm_code=$ctadr->{c_id}</a>
Der Link führt Sie zur Website der Stadtwerke Konstanz. Damit sind Sie freigeschaltet.
Falls Sie zur Eingabe eines Bestätigungscode aufgefordert werden, lautet dieser: <b>$ctadr->{c_id}</b>
Die hinterlegten Zugangsdaten dienen zum Anmelden im Fahrradmietsystem der APP und im Browser <a href='http://www.konrad-konstanz.de'>www.konrad-konstanz.de</a>
Viel Spaß beim Radeln.
EOF
;
}else{#sharee
my $encoded_email = $uri_encode->encode($ctadr->{txt08});
$body = <<EOF
Vielen Dank für Ihre Anmeldung.
Damit wir das Fahrradmietsystem für Sie freischalten können, benötigen wir eine e-Mail Bestätigung.
Der e-Mail Bestätigungscode lautet: <b>$email_ack_digest</b>
Viel Spaß beim Radeln.
<div>
$ct->{txt09}
$ct->{txt04}
$ct->{txt05}
$ct->{txt08}
$ct->{txt11}
</div>
EOF
;
}
$body =~ s/\n/<br \/>/g;
my $html = "<html><head><title>$varenv{title}</title></head><body style='text-align:left;border:0px solid silver;padding:15px;margin:2%;width:90%;'>\n";
$html .= "<div>$body</div>";
#if($mandant eq "TINK"){
# $html .= "<div><img src=\"https://www2.tink-konstanz.de/img/TINK_Signatur.jpg\" \/></div>";
#}
if($varenv{syshost} =~ /konrad|tink/i){
$html .= "<div>$ct->{txt01}</div>\n";
}
$html .= "</body></html>";
#-----------------------------------------------------------------
my $subject = "$varenv{title} Anmeldebestätigung";
if($hostname ne "$varenv{live_hostname}"){
$email = $mailxconf{mailx}->{mail_testto};
$subject .= "* offline Test *";
}
if ($smtp->to($email)) {
$smtp->data();
$smtp->datasend("To: $email\n");
$smtp->datasend("Subject: $subject\nMIME-Version: 1.0\nContent-Type: text/html; charset=UTF-8 \n\n");
$smtp->datasend($html);
$smtp->dataend();
} else {
print "Error: ", $smtp->message();
}
return "1. okay";
}
#Password forgotten
sub esender_password {
my ($smtp,$ctadr,$coopw,$wwwhost) = @_;
my %varenv = &Config::envonline("","$wwwhost");
my $ct = {};
if($varenv{syshost} =~ /konrad|tink/i){
$ct = &get_content("content","3435","1");
$ct->{txt01} = $q->unescapeHTML($ct->{txt01});
$ct->{txt01} =~ s/\r\n/<br \/>/g;
$ct->{txt01} = Encode::encode('iso-8859-1', Encode::decode('utf-8', $ct->{txt01}));
}else{
$ct = &get_content("contentuser",$globalconf{shareedms_conf}->{parent_node},"201");
}
my $email = $q->unescapeHTML($ctadr->{txt08});
my $anrede = $q->unescapeHTML($ctadr->{txt02});
my $name = $q->unescapeHTML($ctadr->{txt01});
$name = Encode::encode('iso-8859-1', Encode::decode('utf-8', $name));
#email html body---------------------------------------------------
my $body;
if($varenv{syshost} =~ /konrad|tink/i){
$body = <<EOF
Hallo $name,
Sie haben ein neues Passwort beantragt. Das neue Passwort lautet: <b>$coopw</b>
Nach Ihrem Login <a href='http://www.konrad-konstanz.de'>www.konrad-konstanz.de</a> können Sie das Passwort in Ihrem Profil unter Kundendaten auch gerne wieder ändern.
Viel Spaß beim Radeln.
EOF
;
}else{#sharee
$body = <<EOF
Hallo $name,
Sie haben ein neues Passwort beantragt. Das neue Passwort lautet: <b>$coopw</b>
Nach Ihrem Login können Sie das Passwort in Ihrem NutzerInnen Konto unter 1.Kundendaten auch gerne wieder ändern.
<div>
Freundliche Grüße,
--
$ct->{txt09}
$ct->{txt04}
$ct->{txt05}
$ct->{txt08}
$ct->{txt11}
</div>
sharee.bike ist ein Angebot der TeilRad GmbH
EOF
;
}
$body =~ s/\n/<br \/>/g;
my $html = "<html><head><title>$varenv{title}</title></head><body style='text-align:left;border:0px solid silver;padding:15px;margin:2%;width:90%;'>\n";
$html .= "<div>$body</div>";
#if($mandant eq "TINK"){
# $html .= "<div><img src=\"https://www2.tink-konstanz.de/img/TINK_Signatur.jpg\" \/></div>";
#}
if($varenv{syshost} =~ /konrad|tink/i){
$html .= "<div>$ct->{txt01}</div>\n";
}
$html .= "</body></html>";
#-----------------------------------------------------------------
my $subject = "$varenv{title} Passwort vergessen";
if($hostname ne "$varenv{live_hostname}"){
$email = $mailxconf{mailx}->{mail_testto};
$subject .= "* offline Test *";
}
if ($smtp->to($email)) {
$smtp->data();
$smtp->datasend("To: $email\n");
$smtp->datasend("Subject: $subject\nMIME-Version: 1.0\nContent-Type: text/html; charset=UTF-8 \n\n");
$smtp->datasend($html);
$smtp->dataend();
} else {
print "Error: ", $smtp->message();
}
return "2. okay";
}
#Send Invoice and capture_fails
sub esender_invoice {
my ($smtp,$todo,$ctadr,$ct_name,$wwwhost) = @_;
my %varenv = &Config::envonline("","$wwwhost");
my $ct = {};
$ct = &get_content("contentuser",$globalconf{shareedms_conf}->{parent_node},"201");
#generate html for email-body
my $email = $q->unescapeHTML($ctadr->{txt08});
my $anrede = $q->unescapeHTML($ctadr->{txt02});
my $name = $q->unescapeHTML($ctadr->{txt01});
$name = Encode::encode('iso-8859-1', Encode::decode('utf-8', $name));
#email html body---------------------------------------------------
my $subject;
my $body;
my $signature;
if($varenv{syshost} =~ /konrad|tink/i){
$signature = <<EOF
Mit freundlichen Grüßen,
--
fahrradspezialitaeten.com
Heinrich-von-Stephan-Str. 12
79100 Freiburg
<small>Für Hinweise auf herumstehende Räder (gerne mit Radnummer, genauer Position und Fotos) aber auch Personen, die unsere Räder unrechtmäßig fahren oder beschädigen sind wir sehr dankbar. Sie erreichen uns über E-Mail (konrad\@fahrradspezialitaeten.com) und telefonisch über unsere Hotline: +49 761 45370099 (7 Tage/ 24 Stunden erreichbar).
Wenn Sie beobachten, wie jemand eines unserer Räder beschädigt, rufen Sie bitte unmittelbar die Polizei (Tel.:07531 995 2222) hinzu!
Vielen Dank für Ihre Unterstützung!</small>
EOF
;
$signature =~ s/\n/<br \/>/g;
}
if($todo eq "send_invoice"){
#$subject = "TINK Rechnung";
$subject = "Fahrradmietsystem Rechnung";
if($varenv{syshost} =~ /konrad|tink/i){
$body = <<EOF
Guten Tag $name,
Ihre aktuelle Rechnung mit der Nummer $ct_name liegt ab sofort unter <a href='https://www.stadtwerke-konstanz.de/mobilitaet/rad-mietsystem?konrad_goto=Anmelden'>https://www.stadtwerke-konstanz.de/mobilitaet/rad-mietsystem</a> für Sie bereit.
Nach dem Anmelden ist in Ihrem Nutzer Profil unter Verleihdaten die Rechnung als PDF hinterlegt.
EOF
;
$body =~ s/\n/<br \/>/g;
}else{#sharee
$body = <<EOF
Guten Tag $name,
Ihre aktuelle Rechnung mit der Nummer $ct_name liegt ab sofort in Ihrem sharee.bike App Konto für Sie bereit.
Nach dem Anmelden ist in Ihrem Nutzer Konto unter Verleihdaten die Rechnung als PDF hinterlegt.
<div>
Freundliche Grüße,
--
$ct->{txt09}
$ct->{txt04}
$ct->{txt05}
$ct->{txt08}
$ct->{txt11}
</div>
sharee.bike ist ein Angebot der TeilRad GmbH
EOF
;
$body =~ s/\n/<br \/>/g;
}
}elsif($todo eq "send_capture_fail"){
$subject = "Fahrradmietsystem Account";
if($varenv{syshost} =~ /konrad|tink/i){
$body = <<EOF
Guten Tag $name,
wir mussten Ihren Fahrradmietsystem Account sperren weil der letzte Mietbetrag nicht eingezogen werden konnte.
Sie können Ihren Account selbst wieder freischalten, indem Sie die Zahlungsdaten erneuern. Dies kann aus Sicherheitsgründen von Seiten Ihrer Bank nötig sein oder es gab einen Fehler in Ihren Eingaben.
Nach der Anmeldung im Fahrradmietsystem Konstanz ( <a href='https://www.stadtwerke-konstanz.de/mobilitaet/rad-mietsystem?konrad_goto=Anmelden'>https://www.stadtwerke-konstanz.de/mobilitaet/rad-mietsystem</a> ) haben Sie die Möglichkeit Ihre Daten zu überprüfen und ggf. zu erneuern.
Kontaktieren Sie uns bitte falls Ihr Account für den Verleih nicht automatisch freigeschaltet wurde.
Für weitere Fragen wenden Sie sich bitte an unsere Buchhaltung unter: buchhaltung\@fahrradspezialitaeten.com oder telefonisch 0761/5158912 (Mo, Mi, Fr 9-12 Uhr)
EOF
;
$body =~ s/\n/<br \/>/g;
}else{#sharee
$body = <<EOF
Guten Tag $name,
wir mussten Ihren Fahrradmietsystem Account sperren weil der letzte Mietbetrag nicht eingezogen werden konnte.
Sie können Ihren Account selbst wieder freischalten, indem Sie die Zahlungsdaten erneuern. Dies kann aus Sicherheitsgründen von Seiten Ihrer Bank nötig sein oder es gab einen Fehler in Ihren Eingaben.
Nach der Anmeldung in Ihrem Konto der sharee.bike App haben Sie die Möglichkeit Ihre Daten zu überprüfen und ggf. zu erneuern.
Kontaktieren Sie uns bitte falls Ihr Account für den Verleih nicht automatisch freigeschaltet wurde.
Für weitere Fragen wenden Sie sich bitte an unsere Buchhaltung unter: post\@sharee.bike oder telefonisch 0761/5158912 (Mo, Mi, Fr 9-12 Uhr)
<div>
Freundliche Grüße,
--
$ct->{txt09}
$ct->{txt04}
$ct->{txt05}
$ct->{txt08}
$ct->{txt11}
</div>
sharee.bike ist ein Angebot der TeilRad GmbH
EOF
;
$body =~ s/\n/<br \/>/g;
}
}
my $html = "<html><head><title></title></head><body style='text-align:left;border:0px solid silver;padding:15px;margin:2%;width:90%;'>\n";
$html .= "<div>$body</div>\n";
#$html .= "<div><img src=\"https://www2.tink-konstanz.de/img/TINK_Signatur.jpg\" \/></div>";
$html .= "<div>$signature</div>\n";
$html .= "</body></html>";
#-----------------------------------------------------------------
if($hostname ne "$varenv{live_hostname}"){
$email = $mailxconf{mailx}->{mail_testto};
$subject .= "* offline Test *";
}
my $message;
if ($smtp->to($email)) {
$smtp->data();
$smtp->datasend("To: $email\n");
$smtp->datasend("Subject: $subject\nMIME-Version: 1.0\nContent-Type: text/html; charset=UTF-8 \n\n");
$smtp->datasend($html);
$smtp->dataend();
} else {
print "Error: ", $smtp->message();
}
return "3. okay";
}
open(EMA, ">> $varenv{logdir}/newsletter_tink.log");
print EMA "\n$today, done mailing\n";
print EMA "'$today' '$basedir' '$wwwhost' '$todo' '$ctadr->{txt08}'\n";
print EMA "\n\n";
close EMA;
$smtp->quit;
1;