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 DateTime; use DateTime::Format::Pg; use Text::CSV_XS; use Lib::Config; use Mod::Libenzdb; use Mod::Libenz; use Mod::DBtank; use Mod::Basework; use Mod::APIfunc; use Mod::Pricing; use Mod::APIsigclient; 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 $pri = new Pricing; my $si = new APIsigclient; 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; #insert/save/delete DMS users sub manage_dmsusers { my $self = shift; my $q = shift; my $varenv = shift; my $base_edit = shift; my $u_id = shift; my $users_dms = shift || {}; my $owner = $users_dms->{u_id} || 0; my $table = "users"; $q->import_names('R'); my @keywords = $q->param; my $now_dt = strftime "%Y-%m-%d %H:%M:%S", localtime; my $feedb = { message => "", i_rows => 0, u_rows => 0, d_rows => 0 }; $bw->log("manage_dmsusers",$q,""); my $dbh = ""; my $adref = { table => "contentadr", fetch => "one", template_id => "202", c_id => "$u_id", }; my $ctadr = $dbt->fetch_record($dbh,$adref); #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},""); $feedb->{d_rows} = $dbt->delete_content($dbh,"users",$u_id); $dbt->update_one($dbh,$adref,"int07=null"); $dbt->update_one($dbh,$adref,"int09=null"); }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 = 0 if(!looks_like_number($valxx));# set to 0 for using == operator $feedb->{u_rows} = $dbt->update_one($dbh,$dmsusers,"$_=$valxx"); if($_ eq "int09"){ if($valxx == 1){ $dbt->update_one($dbh,$adref,"int09=1"); }else{ $dbt->update_one($dbh,$adref,"int09=null"); } } }elsif($_ =~ /^txt\d+/){ my @val = $q->param($_); $valxx = $q->escapeHTML("@val"); $feedb->{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},""); $feedb->{i_rows} = $dbt->insert_users($dbh,$ctadr->{c_id},$owner); $dbt->update_one($dbh,$adref,"int07=100"); } return $feedb; }#end manage_dmsusers #insert content or contentuser sub new_content { my $self = shift; my $q = shift; my $users_dms = shift; $q->import_names('R'); my $dbh = ""; my $feedb = { message => "" }; my $pref_cc = { table => "$R::ct_table", fetch => "one", template_id => "$R::template_id", main_id => "$R::main_id", }; my $cc_part = { c_id => 0 }; $cc_part = $dbt->fetch_record($dbh,$pref_cc);#get last barcode by order barcode DESC my $next_barcode = $cc_part->{c_id}; $next_barcode = $cc_part->{barcode} + 1 if($cc_part->{barcode} > 0); my $insert_ctu = { table => "$R::ct_table", itime => 'now()', mtime => 'now()', owner => "$users_dms->{u_id}", barcode => "$next_barcode", ct_name => "---", template_id => "$R::template_id", main_id => "$R::main_id", txt12 => "$dbt->{operator}->{$varenv{dbname}}->{oprefix}", }; my $c_idnew = 0; $c_idnew = $dbt->insert_contentoid($dbh,$insert_ctu,"") if($R::ct_table && $R::template_id && $R::main_id); if($c_idnew){ $feedb->{c_id} = $c_idnew; $feedb->{i_rows} = $i_rows; } return $feedb; } #save content or contentuser sub save_content { my $self = shift; my $q = shift; my $users_dms = shift; my $node_meta = shift; my $c_id = shift || ""; $q->import_names('R'); my @keywords = $q->param; my $dbh = ""; my $feedb = { message => "", u_rows => 0 }; my $ct = { c_id => $c_id }; my $update_ct = { table => $node_meta->{ct_table}, owner => $users_dms->{u_id}, mtime => "now()", }; foreach(@keywords){ #my $val = $q->param($_); #my $valxx = $q->escapeHTML("$val"); my @val = $q->param($_); my $valxx = $q->escapeHTML("@val"); #txt24 bike_node/station_group and txt25 bike_group multiple select if($node_meta->{template_id} == 225 && $_ eq "txt24"){ my %station_filter_hash = (); my @_valxx_filter = (); my $node = { template_id => 205, parent_id => 200013, fetch => "all", keyfield => "main_id", }; my $bike_nodes = {}; $bike_nodes = $dbt->fetch_rel4tpl4nd($dbh,$node); foreach my $bike_node (@val){ foreach my $rid ( keys (%$bike_nodes)){ if($bike_node == $bike_nodes->{$rid}->{main_id} && $bike_nodes->{$rid}->{type_id}){ $station_filter_hash{$bike_nodes->{$rid}->{type_id}} = 1; } } } foreach my $type_id (keys (%station_filter_hash)){ push (@_valxx_filter, "$type_id"); } $update_ct->{txt25} = "@_valxx_filter"; $update_ct->{$_} = "$valxx"; }elsif($node_meta->{template_id} == 205 && $_ eq "txt06"){#GPS if($valxx =~ /^(\d{1,2}\.\d+),\s?(\d{1,2}\.\d+)$/ || !$valxx || $valxx eq "null"){ $update_ct->{$_} = "$valxx"; }else{ $feedb->{message} = "failure::Eingabefehler \"$valxx\", falsches GPS Format. Bitte folgendes Format mit latitude, longitude verwenden. Bsp: 47.927738,7.973855"; } }elsif($node_meta->{template_id} == 205 && $_ =~ /byte/){ if(!$valxx){ $update_ct->{$_} = ""; }elsif($valxx !~ /[g-z]/ig && length($valxx) == 32){ $update_ct->{$_} = "\\x$valxx"; }else{ $feedb->{message} = "failure::Eingabefehler \"$valxx\", der Token muss 32 HEX Zeichen enthalten"; } }elsif($_ =~ /^time\d+/){ $valxx = "00:00" if($valxx !~ /\d{1,2}:\d{2}/); $update_ct->{$_} = "$valxx"; }elsif($_ =~ /date_time\d+/){ my ($date_time,$chck) = $lb->checkdate($valxx); if(!$chck){ $update_ct->{$_} = "$valxx"; }else{ $feedb->{message} = "failure::Eingabefehler \"$valxx\", falsche Datum Uhrzeit Format"; } }elsif($_ =~ /^int|barcode/){ if(($valxx && $valxx =~ /\d/) || looks_like_number($valxx)){ $valxx =~ s/,/./; $valxx =~ s/\s//g; if(looks_like_number($valxx)){ $update_ct->{$_} = "$valxx"; }else{ $feedb->{message} = "failure::Eingabefehler \"$valxx\", hier sind nur numerische Werte erlaubt"; } }elsif(!$valxx){ $update_ct->{$_} = "null"; }else{ $feedb->{message} = "failure::Eingabefehler \"$valxx\", hier sind nur numerische Werte erlaubt"; } }elsif($node_meta->{template_id} == 194 && $_ =~ /txt/ && !$valxx){ $update_ct->{$_} = "null";#important for coalesce select alias lang fallback }elsif($_ =~ /ct_name|txt|state|time/){ $update_ct->{$_} = "$valxx"; } } if($ct->{c_id}){ $feedb->{u_rows} += $dbt->update_record($dbh,$update_ct,$ct); } return $feedb; }#end save_content #delete content sub delete_content { my $self = shift; my $node_meta = shift || ""; my $c_id = shift || ""; my $users_dms = shift; my $dbh = ""; my $feedb = { d_rows => 0,message => "" }; if($node_meta->{ct_table},$c_id){ $feedb->{d_rows} = $dbt->delete_content($dbh,$node_meta->{ct_table},$c_id); } return $feedb; } #save invoice address or text sub save_text2contenttrans { my $self = shift; my $q = shift; my $users_dms = shift; my $c_id = shift || ""; $q->import_names('R'); my @keywords = $q->param; my $dbh = ""; my $feedb = { message => "" }; open(FILE,">>$varenv{logdir}/save_text2contenttrans.log") if($debug); print FILE "\n*--> $now_dt| c_id:$c_id | u_id:$users_dms->{u_id}\n" if($debug); print FILE Dumper($q) . "\n" if($debug); my $ctt = { c_id => $c_id }; my $update_ctt = { table => "contenttrans", owner => $users_dms->{u_id}, mtime => "now()", }; foreach(@keywords){ my $val = $q->param($_); my $valxx = $q->escapeHTML("$val"); my @val = $q->param($_); $valxx = $q->escapeHTML("@val"); #Set formular title if Mahnung if($_ eq "int06"){ my $s_hash = {}; $s_hash = $dbt->{shareedms_conf}->{warning_state}; if($valxx > 0){ foreach my $s_key (sort keys (%{ $s_hash })) { if($valxx eq $s_key){ $update_ctt->{txt00} = $s_hash->{$s_key} if($s_hash->{$s_key} =~ /Mahnung/); $update_ctt->{$_} = "$valxx"; } } }else{ $update_ctt->{txt00} = "Rechnung"; $update_ctt->{$_} = "$valxx"; } } elsif($_ =~ /int|time/){ if(!$valxx){ $update_ctt->{$_} = "null"; }else{ $update_ctt->{$_} = "$valxx"; } } elsif($_ =~ /txt|state/){ $update_ctt->{$_} = "$valxx"; } } if($ctt->{c_id}){ $u_rows += $dbt->update_record($dbh,$update_ctt,$ctt); #empty warn_time if warnstate not set #if(!$R::int06 || !$R::warn_time){ # $dbt->update_one($dbh,$update_ctt,"warn_time=null",$c_id); #} if($R::txt22 && $R::txt22 eq "Zahlungseingang"){ $dbt->update_one($dbh,$update_ctt,"int14=null",$c_id); $dbt->update_one($dbh,$update_ctt,"pay_time=now()",$c_id); } if($R::txt22 && $R::txt22 eq "Zahlung offen"){ $dbt->update_one($dbh,$update_ctt,"int14=1",$c_id); $dbt->update_one($dbh,$update_ctt,"pay_time=null",$c_id); } } close(FILE) if($debug); $feedb->{u_rows} = $u_rows; return $feedb; }#end save_text2contenttrans #part or fee to invoice sub insert_contenttranspos { my $self = shift; my $q = shift; my $cc_id = shift || "";#part my $ca_id = shift || "";#adr my $ct_id = shift || "";#invoice my $owner = shift || ""; my $dbh = ""; my $feedb = { message => "" }; if(looks_like_number($cc_id) && looks_like_number($ca_id) && looks_like_number($ct_id)){ my $pref = { table => "contenttrans", table_pos => "contenttranspos", fetch => "one", template_id => "218",#Mietjournal tpl_id ct_id => $ct_id, "ct.state" => "is::null", }; my $ctpos = { c_id => 0 }; $ctpos = $dbt->collect_post($dbh,$pref); if($ctpos->{c_id}){ my $pref_cc = { table => "content", fetch => "one", template_id => "IN::(229)", c_id => $cc_id, }; my $cc_part = { c_id => 0 }; $cc_part = $dbt->fetch_record($dbh,$pref_cc); my $pref_ca = { table => "contentadr", fetch => "one", template_id => "202", c_id => "$ca_id", }; my $ctadr = { c_id => 0 }; $ctadr = $dbt->fetch_record($dbh,$pref_ca); my $pos_id = 0; if($cc_part->{int02}){ $pos_id = $dbt->insert_pos($dbh,$ct_id,$cc_part,"",$ctadr,"","",$cc_part->{barcode},"0",$owner,""); }else{ $feedb->{message} = "failure::Fehler, VK Preis von Artikel Nr. $cc_part->{barcode} nicht definiert."; } if($pos_id > 0){ $i_rows += 1; $dbt->update_content4comp($dbh,$cc_part->{c_id},"-","1"); $feedb->{message} = "Artikel Nr. $cc_part->{barcode} erfolgreich hinzugefügt."; } }else{ $feedb->{message} = "failure::Fehler, die Rechnung ist bereits gebucht. Das hinzufügen einer weiteren Rechnungsposition wird somit abgelehnt."; } }else{ $feedb->{message} = "failure::Fehler, es fehlt mindestens ein Key! ($cc_id && $ca_id && $ct_id)"; } $feedb->{u_rows} = $u_rows; return $feedb; }#end insert_contenttranspos sub save_contenttranspos { my $self = shift; my $q = shift; my $c_id = shift; my $owner = shift; my $dbh = ""; my $feedb = { message => "" }; if($c_id && $R::start_date =~ /\d{1,2}\.\d{1,2}\.\d{4}/ && $R::end_date =~ /\d{1,2}\.\d{1,2}\.\d{4}/){ my $s_hh = $q->escapeHTML("$R::s_hh") || "0"; my $s_mi = $q->escapeHTML("$R::s_mi") || "0"; my $e_hh = $q->escapeHTML("$R::e_hh") || "0"; my $e_mi = $q->escapeHTML("$R::e_mi") || "0"; $s_hh = "24" if($s_hh > "24"); $e_hh = "24" if($e_hh > "24"); $s_mi = "59" if($s_mi > "59"); $e_mi = "59" if($e_mi > "59"); $s_hh = sprintf('%.2d',$s_hh); $e_hh = sprintf('%.2d',$e_hh); $s_mi = sprintf('%.2d',$s_mi); $e_mi = sprintf('%.2d',$e_mi); my $start_time=""; my $end_time=""; my $dtnow = DateTime->now( time_zone => "Europe/Berlin" ); my $dt0 = DateTime->now( time_zone => "Europe/Berlin" ); my $dt1 = DateTime->now( time_zone => "Europe/Berlin" ); if($R::start_date =~ /(\d{1,2})\.(\d{1,2})\.(\d{4})/){ $dt0 = DateTime->new( year => $3, month => $2, day => $1, hour => $s_hh, minute => $s_mi, time_zone => 'Europe/Berlin', ); $start_time = $dt0->strftime("%Y-%m-%d %H:%M:%S"); #print $start_time; } if($R::end_date =~ /(\d{1,2})\.(\d{1,2})\.(\d{4})/){ $dt1 = DateTime->new( year => $3, month => $2, day => $1, hour => $e_hh, minute => $e_mi, time_zone => 'Europe/Berlin', ); $end_time = $dt1->strftime("%Y-%m-%d %H:%M:%S"); } if($c_id && $start_time && $end_time && $dt0 < $dtnow && $dt1 < $dtnow){ my $pref = { table => "contenttrans", table_pos => "contenttranspos", fetch => "one", template_id => "218",#Mietjournal tpl_id c_id => $c_id, "ct.state" => "is::null", }; my $ctpos = { c_id => 0 }; $ctpos = $dbt->collect_post($dbh,$pref); my $pricing = {}; my $counting = {}; my $update_pos = { table => "contenttranspos", start_time => "$start_time", end_time => "$end_time", owner_end => $owner, mtime => "now()", }; #if sig if($ctpos->{int11} == 3 && $ctpos->{ca_id}){ #sig booking_request my $sig_book = { bikeId => "", rentalId => "", }; if(looks_like_number($R::int10) && $R::int10 == 1){ my $authref = { table => "contentadr", fetch => "one", template_id => "202", c_id => "=::$ctpos->{ca_id}", }; my $authraw = {}; $authraw = $dbt->fetch_record($dbh,$authref); $sig_book = $si->sig_booking(\%varenv,"reserve_end",$authraw,"",$ctpos); } }else{ if($ctpos->{c_id}){ $u_rows += $dbt->update_record($dbh,$update_pos,$ctpos); }else{ $feedb->{message} = "failure::Fehler, Änderung abgelehnt da Rechnung bereits gebucht"; } } #again to get setted date-times $ctpos = $dbt->collect_post($dbh,$pref); #print "$R::start_date $s_hh:$s_mi | $R::start_date $e_hh:$e_mi xxxxxxxxx
";exit; ($pricing,$counting) = $pri->counting_rental(\%varenv,$ctpos); $update_pos->{int38} = "$counting->{int38}" if(looks_like_number($counting->{int38})); $update_pos->{int39} = "$counting->{int39}" if(looks_like_number($counting->{int39})); $update_pos->{int40} = "$counting->{int40}" if(looks_like_number($counting->{int40})); $update_pos->{int41} = "$counting->{int41}" if(looks_like_number($counting->{int41})); $update_pos->{int10} = $R::int10 if(looks_like_number($R::int10)); $update_pos->{int20} = $R::int20 if(looks_like_number($R::int20)); $update_pos->{int04} = $R::int04 if(looks_like_number($R::int04)); $update_pos->{int07} = $R::int07 if(looks_like_number($R::int07)); $update_pos->{int08} = $R::int08 if(looks_like_number($R::int08)); $update_pos->{txt01} = $q->escapeHTML($R::txt01) if($R::txt01); $update_pos->{txt23} = $q->escapeHTML($R::txt23) if($R::txt23); #before update bike content check if realy last rental my $pref2ck = { table => "contenttrans", table_pos => "contenttranspos", fetch => "one", template_id => "218",#Mietjournal tpl_id start_time => ">::$end_time", barcode => $ctpos->{barcode}, "ct.state" => "is::null", }; my $ctpos2ck = { c_id => 0 }; $ctpos2ck = $dbt->collect_post($dbh,$pref2ck); #update bike content only if there is no later rental start if($ctpos->{cc_id} && !$ctpos2ck->{c_id}){ my $ctpref = { table => "content", fetch => "one", c_id => $ctpos->{cc_id}, }; my $ctbike = $dbt->fetch_tablerecord($dbh,$ctpref); $ctpref->{int10} = $R::int10 if(looks_like_number($R::int10)); $ctpref->{int20} = $R::int20 if(looks_like_number($R::int20)); $ctpref->{int04} = $R::int04 if(looks_like_number($R::int04)); $ctpref->{owner} = $owner; $ctpref->{mtime} = "now()"; $u_rows += $dbt->update_record($dbh,$ctpref,$ctbike); $feedb->{message} = "Mietdaten gespeichert und Mietrad Stati in Warenstamm übernommen"; }else{ $feedb->{message} = "Mietdaten gespeichert. Achtung, Mietrad Stati in Warenstamm NICHT übernommen, da es sich nicht um die letzte Miete handelt"; } if($ctpos->{c_id}){ $u_rows += $dbt->update_record($dbh,$update_pos,$ctpos); # if($ctpos->{ct_id}){ my $ctpref = { table => "contenttrans", c_id => $ctpos->{ct_id}, start_time => "$start_time", end_time => "$end_time", owner => $owner, mtime => "now()", }; $u_rows += $dbt->update_record($dbh,$ctpref,$ctpref); } }else{ $feedb->{message} = "failure::Fehler, Änderung abgelehnt da Rechnung bereits gebucht"; } } }elsif($R::int02 && $R::int03){ $R::int02 =~ s/,/\./ if($R::int02 =~ /\,/); $R::int03 =~ s/,/\./ if($R::int03 =~ /\,/); $R::txt01 = $q->escapeHTML($R::txt01) if($R::txt01); $R::txt23 = $q->escapeHTML($R::txt23) if($R::txt23); if($c_id && looks_like_number($R::int02) && looks_like_number($R::int03)){ my $pref = { table => "contenttrans", table_pos => "contenttranspos", fetch => "one", template_id => "218",#Mietjournal tpl_id c_id => $c_id, "ct.state" => "is::null", }; my $ctpos = { c_id => 0 }; $ctpos = $dbt->collect_post($dbh,$pref); my $update_pos = { table => "contenttranspos", int02 => "$R::int02", int03 => "$R::int03", txt01 => "$R::txt01", txt23 => "$R::txt23", owner => $owner, mtime => "now()", }; if($ctpos->{c_id}){ $u_rows += $dbt->update_record($dbh,$update_pos,$ctpos); }else{ $feedb->{message} = "failure::Fehler, Änderung abgelehnt da Rechnung bereits gebucht"; } }else{ $feedb->{message} = "failure::Fehler, es sind nur numerische Werte erlaubt."; } }else{ $feedb->{message} = "failure::Fehler, fehlerhafte Eingaben oder Datensatz nicht gefunden!"; } $feedb->{u_rows} = $u_rows; return $feedb; }#end save_contenttranspos #set Faktura workflow like Rechnung to Storno sub set_workflow { my $self = shift; my $q = shift; my $users_dms = shift; my $c_id = shift; my $set_main_id = shift || ""; my %varenv = $cf->envonline(); my $dbh = ""; my $node = $dbt->get_node($dbh,$set_main_id); my $pref = { table => "contenttrans", fetch => "one", c_id => $c_id, }; my $ctt = { c_id => 0 }; $ctt = $dbt->fetch_tablerecord($dbh,$pref); #barcode setting logic reset. keep barcode from orignal for backlinking #counter invoice subnr if($ctt->{ct_name} =~ /\d+-\d+/){ my ($ct_name,$subname) = split(/-/,$ctt->{ct_name}); $subname++; $ctt->{ct_name} = "$ct_name-$subname"; }else{ $ctt->{ct_name} = "$ctt->{ct_name}-1"; } delete $ctt->{c_id}; delete $ctt->{txt00}; delete $ctt->{state}; delete $ctt->{int01}; delete $ctt->{int14}; delete $ctt->{int15}; delete $ctt->{int16}; delete $ctt->{int18}; delete $ctt->{txt16}; delete $ctt->{txt12}; delete $ctt->{txt21}; delete $ctt->{txt22}; delete $ctt->{txt23}; delete $ctt->{txt25}; delete $ctt->{txt30}; delete $ctt->{itime}; delete $ctt->{mtime}; delete $ctt->{close_time}; delete $ctt->{invoice_time}; delete $ctt->{pay_time}; delete $ctt->{warn_time}; my $insert_ctt = { %$ctt, table => "contenttrans", itime => 'now()', mtime => 'now()', owner => "$users_dms->{u_id}", ct_name => "$ctt->{ct_name}", txt00 => "$node->{node_name}", template_id => "218", main_id => "$node->{main_id}", }; my $c_idnew = 0; $c_idnew = $dbt->insert_contentoid($dbh,$insert_ctt,""); $i_rows = 1 if($c_idnew); #print Dumper($insert_ctt); #exit; #position copy if($c_idnew > 0){ my ($cttpos,$rows) = $db->collect_contentpos("contenttrans",$c_id); foreach my $id (sort { $cttpos->{$a}->{c_id} <=> $cttpos->{$b}->{c_id} } keys(%$cttpos)){ #reverse pos sum for example by Storno $cttpos->{$id}->{int01} = $cttpos->{$id}->{int01} * -1 if($cttpos->{$id}->{int01} != 0); $cttpos->{$id}->{int05} = $cttpos->{$id}->{c_id};# set source pos id if sub doc $cttpos->{$id}->{txt23} = "workflow doc" if($cttpos->{$id}->{int01} == -1); delete $cttpos->{$id}->{c_id}; delete $cttpos->{$id}->{ct_id}; delete $cttpos->{$id}->{itime}; delete $cttpos->{$id}->{mtime}; my $insert_pos = { %{$cttpos->{$id}}, table => "contenttranspos", ct_id => $c_idnew, itime => 'now()', mtime => 'now()', }; my $ctpos_id = $dbt->insert_contentoid($dbh,$insert_pos,""); $i_rows += 1 if($ctpos_id > 0); } } $db->update_users4trans($c_idnew,"218","",$users_dms->{u_id}); #my $uri_path = $dbt->recurse_node($dbh,$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"); print redirect("$varenv{wwwhost}/DMS/Faktura?ct_trans=open\&c_id4trans=$c_idnew\&tpl_id4trans=218\&owner=$users_dms->{u_id}\&offset=$R::offset\&limit=$R::limit\&return=$i_rows-$u_rows-$d_rows"); exit 0; }#end set_workflow #generate invoice from operator accounting sub set_accounting2invoice { my $self = shift; my $q = shift; my $users_dms = shift; my $c_id = shift; my $set_main_id = shift || ""; my %varenv = $cf->envonline(); my $dbh = ""; my $node = $dbt->get_node($dbh,$set_main_id); my $pref = { table => "contenttrans", fetch => "one", c_id => $c_id, }; my $ctt = { c_id => 0 }; $ctt = $dbt->fetch_tablerecord($dbh,$pref); #barcode setting logic reset. keep barcode from orignal for backlinking #counter invoice subnr if($ctt->{ct_name} =~ /\d+-\d+/){ my ($ct_name,$subname) = split(/-/,$ctt->{ct_name}); $subname++; $ctt->{ct_name} = "$ct_name-$subname"; }else{ $ctt->{ct_name} = "$ctt->{ct_name}-1"; } delete $ctt->{c_id}; delete $ctt->{txt00}; delete $ctt->{state}; delete $ctt->{itime}; delete $ctt->{mtime}; delete $ctt->{close_time}; delete $ctt->{invoice_time}; delete $ctt->{pay_time}; my $insert_ctt = { %$ctt, table => "contenttrans", itime => 'now()', mtime => 'now()', owner => "$users_dms->{u_id}", ct_name => "$ctt->{ct_name}", txt00 => "$node->{node_name}", template_id => "218", main_id => "$node->{main_id}", }; my $c_idnew = 0; $c_idnew = $dbt->insert_contentoid($dbh,$insert_ctt,""); $i_rows = 1 if($c_idnew); #taking just same (operator_accounting) invoices detected by int10=2 $db->update_users4trans($c_idnew,"218","",$users_dms->{u_id}); my $uri_path = $dbt->recurse_node($dbh,$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; }#end set_accounting2invoice #new node relation with option to create subnode for Servicelog sub new_relation { my $self = shift; my $q = 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; my $type_id = 300101; my $energy_id = 0; $template_id = $R::template_id if(looks_like_number($R::template_id)); $n_sort = $R::n_sort if(looks_like_number($R::n_sort)); $type_id = $R::type_id if(looks_like_number($R::type_id)); $energy_id = $R::energy_id if(looks_like_number($R::energy_id)); 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, type_id => $type_id, energy_id => $energy_id, 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,"401","499"); my $ret_tpl_id = $dbt->copy_template($dbh,"400",$new_subtemplate_id,"$node_name Service-Config",$owner); my $ct_name = "$node_name Service-Config"; $ct_name =~ s/^Flotte //; $dbt->copy_content($dbh,"contentuser","400",$ret_tpl_id,"$ct_name",$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($dbh,$new_main_id); print "$varenv{wwwhost}/$uri_path?node2edit=edit_relation\&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 $q = shift; my $main_id = shift; my $owner = shift; my %varenv = $cf->envonline(); my @keywords = $q->param; 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'"); } }elsif($_ =~ /template_id/ && $valxx){ $u_rows = $dbt->update_one($dbh,$update_relation,"template_id=$valxx"); }elsif($_ =~ /int|n_sort|owner/){ $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/); }elsif($_ eq "type_id" && $valxx){ $u_rows = $dbt->update_one($dbh,$update_node,"type_id=$valxx"); }elsif($_ eq "energy_id"){ $valxx = "null" if(!$valxx || $valxx eq "null"); $u_rows = $dbt->update_one($dbh,$update_node,"energy_id=$valxx"); }elsif($_ =~ /node_public/){ $valxx = "t" if($valxx eq "1" || $valxx eq "t"); $valxx = "f" if(!$valxx || $valxx eq "f"); $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($dbh,$main_id); print redirect("$varenv{wwwhost}/$uri_path?node2edit=edit_relation\&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 $q = 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($noderel->{template_id} == 205){ (my $collect_node,$collect_rows) = $dbt->collect_noderel($dbh,$noderel->{parent_id},$noderel->{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 "$deleteable_subnode|$deleteable_node|$deleteable_last_node|$collect_rows"; print FILE "deleteable_subnode:$deleteable_subnode | deleteable_node:$deleteable_node | deleteable_last_node:$deleteable_last_node --> 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}){ if($subrelnode->{template_id} > 400 && $subrelnode->{template_id} < 499){ $dbt->delete_content($dbh,"contentpos","all",$subrelnode->{template_id}); $dbt->delete_content($dbh,"contentuser",$subrelnode->{template_id}); } $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; my $bonus_collect = shift || {}; open(FILE,">>$varenv{logdir}/save_account.log") if($debug); print FILE "\n*Prelib--> $now_dt| dbname: $dbname | c_id: $adr_bonus->{c_id} | txt15: $adr_bonus->{txt15}\n" if($debug); my $oprefix = $dbt->{operator}->{$dbname}->{oprefix}; my $ret = $adr_bonus->{ret}; my $i = 0; my $dbh_operator = $dbt->dbconnect_extern($dbname);#operator connect my $tariff_all = { barcode => 0, int18 => 0}; my $tariff = { table => "content", fetch => "all", keyfield => "barcode", template_id => "210",#Tariff tpl_id }; $tariff_all = $dbt->fetch_record($dbh_operator,$tariff); my $dbh_primary = $dbt->dbconnect_extern($dbt->{primary}->{sharee_primary}->{database}->{dbname}); my $adref = { table => "contentadr", fetch => "one", template_id => "202", c_id => "$adr_bonus->{c_id}", }; my $adr_primary = { c_id => 0 }; $adr_primary = $dbt->fetch_record($dbh_primary,$adref) if($adr_bonus->{c_id}); #collect Tarif with prefix saving on primary my %prim_tarif_hash = (); if($adr_primary->{txt30} && $adr_primary->{txt30} =~ /\w\s\w/){ %prim_tarif_hash = map { $_ => 1 } split(/\s+/,$adr_primary->{txt30}); }elsif($adr_primary->{txt30}){ $prim_tarif_hash{$adr_primary->{txt30}} = 1; } #first delete operator tarif in prim_tarif_hash. we will fill up downunder foreach my $rid (sort { $tariff_all->{$a}->{barcode} <=> $tariff_all->{$b}->{barcode} } keys (%$tariff_all)){ print FILE "--> Cleanup operator specific prim_tarif_hash: $tariff_all->{$rid}->{barcode}\n"; delete $prim_tarif_hash{$oprefix . $tariff_all->{$rid}->{barcode}}; } if($adr_bonus->{txt15} =~ /\w+/){ if(1==1){ my %tarif_hash = (); my @new_txt30 = (); #collect multiple tarif by bonusnr my $pref_cc = { table => "content", keyfield => "c_id", fetch => "all", template_id => "228", int03 => ">::0", ct_name => "ilike::$adr_bonus->{txt15}", }; $bonus_collect = $dbt->fetch_record($dbh_operator,$pref_cc) if(ref($bonus_collect->{1}) ne "HASH"); foreach my $sourcetarif (@{$adr_bonus->{txt30_array}}){ $tarif_hash{$sourcetarif} = 1; #additional and only! save privat or hidden tarif to primary to get caching if($tariff_all->{$sourcetarif}->{int18} == 3 || $tariff_all->{$sourcetarif}->{int18} == 4){ $prim_tarif_hash{$oprefix . $sourcetarif} = 1; } } print FILE "Prelib bonus_collect by request txt15: $adr_bonus->{txt15}\n"; foreach my $id (keys (%$bonus_collect)){ $i++; print FILE "$i)-1-> loop bonus_collect and find $bonus_collect->{$id}->{ct_name} = $adr_bonus->{txt15}\n|==>Take and insert Tarif $bonus_collect->{$id}->{int22}\n" if($debug); $tarif_hash{$bonus_collect->{$id}->{int22}} = 1; #additional and only! save privat or hidden tarif to primary to get caching if($tariff_all->{$bonus_collect->{$id}->{int22}}->{int18} == 3 || $tariff_all->{$bonus_collect->{$id}->{int22}}->{int18} == 4){ $prim_tarif_hash{$oprefix . $bonus_collect->{$id}->{int22}} = 1; } if($bonus_collect->{$id}->{int21} && $bonus_collect->{$id}->{int21} != $bonus_collect->{$id}->{int22}){ print FILE "$i)-2-> delete if($bonus_collect->{$id}->{int21} && $bonus_collect->{$id}->{int21} != $bonus_collect->{$id}->{int22})\n" if($debug); delete $tarif_hash{$bonus_collect->{$id}->{int21}}; delete $prim_tarif_hash{$oprefix . $bonus_collect->{$id}->{int21}}; print FILE "$i)-3-> delete done $bonus_collect->{$id}->{int21}\n" if($debug); } } @new_txt30 = keys %tarif_hash; if(@new_txt30){ print FILE "Final -3-> txt30: @new_txt30\n" if($debug); $u_rows = $dbt->update_one($dbh_operator,$adr_bonus,"txt30='@new_txt30'"); $u_rows = $dbt->update_one($dbh_operator,$adr_bonus,"txt15='$adr_bonus->{txt15}'"); #collect Tarif with prefix saving on primary my @prim_txt30 = keys %prim_tarif_hash; $u_rows = $dbt->update_one($dbh_primary,$adr_bonus,"txt30='@prim_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=''"); #collect Tarif with prefix saving on primary #delete bonus tarif on primary if not defined by operator #additional and only! save privat or hidden tarif to primary to get caching foreach my $rid (sort { $tariff_all->{$a}->{barcode} <=> $tariff_all->{$b}->{barcode} } keys (%$tariff_all)){ foreach(@{$adr_bonus->{txt30_array}}){ if($tariff_all->{$rid}->{barcode} == $_ && ($tariff_all->{$_}->{int18} == 3 || $tariff_all->{$_}->{int18} == 4)){ print FILE "--> Adding private/hidden key on operator to primary: $_\n"; $prim_tarif_hash{$oprefix . $_} = 1; } } } my @prim_txt30 = keys %prim_tarif_hash; $u_rows = $dbt->update_one($dbh_primary,$adr_bonus,"txt30='@prim_txt30'"); $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; } #save service-config sub save_service_desc { my $self = shift; my $q = shift; my $c_id = shift; my $users_dms = shift; my @keywords = $q->param; my $dbh = ""; my $c_tplid = {c_id => $c_id}; my $update_ctuser = { table => "contentuser", template_id => "199", mtime => "now()", owner => "$users_dms->{u_id}", }; my $update_template = { table => "template", tpl_id => "$c_id", owner => "$users_dms->{u_id}", }; open(FILE,">>$varenv{logdir}/save_service_desc.log") if($debug); print FILE "\n*Prelib--> $now_dt | ctpl_id $c_id | owner: $users_dms->{u_id}\n" if($debug); my $tpl_order_desc = "c_id=ID=4=0=0,mtime=Zeitstempel=6=0=0,owner=von=3=0=0,barcode=Rad=3=0=0,txt01=Aufgaben=area5-8=0=0"; foreach(@keywords){ my @val = $q->param($_); my $valxx = $q->escapeHTML("@val"); $valxx =~ s/\s/=/g; print FILE $_ . ":" . $valxx . "
\n"; my $count = 0; ++$count while $valxx =~ /=/g; return "failure::Abbruch. Die Wartungsnamen dienen als Schlüsselwerte und dürfen somit keine Leer- oder Sonderzeichen enthalten ($valxx). Das Speichern wurde abgebrochen!" if($count > 4); #txt01:int01=Reifen-Bremse-Lampe=checkbox=10=2 if($_ =~ /txt\d+/ && $valxx =~ /int\d+=[a-z-]+=checkbox=\d+=\d/i){ $update_ctuser->{$_} = "$valxx"; $tpl_order_desc .= ",$valxx"; }else{ $update_ctuser->{$_} = ""; $tpl_order_desc .= ""; } } print FILE "update contentuser c_id:$c_id\n" . Dumper($update_ctuser) . "\n"; print FILE "update template tpl_id:$c_id\n" . $tpl_order_desc . "\n"; my $rows = 0; $rows = $dbt->update_record($dbh,$update_ctuser,$c_tplid); $rows = $dbt->update_one($dbh,$update_template,"tpl_order='$tpl_order_desc'"); close(FILE) if($debug); return $rows; } #Operator Accounting sub operator_accounting { my $self = shift; my $q = shift; my $users_dms = shift; my $users_sharee = shift; my $accounting_type = shift || ""; my $ck4ex = shift || ""; my $dbh = ""; my %varenv = $cf->envonline(); open(FILE,">>$varenv{logdir}/operator_accounting.log") if($debug); print FILE "\n*--> $now_dt| accounting_type: $accounting_type | owner: $users_dms->{u_id}\n" if($debug); print FILE "Invoice c_id's ck4ex: $ck4ex\n"; my $accounting_main_id = 300029; my $node_faktura = $dbt->get_node($dbh,$dbt->{shareedms_conf}->{faktura}); my $node = $dbt->get_node($dbh,$accounting_main_id); my $praefix = "$node->{node_name}-$varenv{praefix}"; my $ret = ""; my $c_idnew = ""; if($ck4ex){ my $opuser = { table => "contentuser", fetch => "one", c_id => 2, }; my $ctuser = $dbt->fetch_tablerecord($dbh,$opuser); $c_idnew = $dbt->insert_contenttrans($dbh,$ctuser,$accounting_main_id,"208","----",$users_dms->{u_id}); if($c_idnew){ print FILE "c_idnew: $c_idnew\n"; $i_rows++; my $ctt = { c_id => $c_idnew }; my $update_ctt = { table => "contenttrans", int12 => $node->{main_id}, txt00 => $node->{node_name}, mtime => "now()", owner => $users_dms->{u_id}, }; my $tplop = $dbt->get_tpl($dbh,"196");#Operator-Faktura my @tplop_order = split /,/,$tplop->{tpl_order}; foreach(@tplop_order){ my ($key,$val,$size,$unit) = split /=/,$_; if($key =~ /int(\d+)/){ #take fee values used by creating operator accounting invoice my $count_key = $1 + 20;#cu.int to ctt.int my $ctt_key = "int" . $count_key; $update_ctt->{$ctt_key} = $ctuser->{$key} if($ctuser->{$key}); } } $dbt->update_record($dbh,$update_ctt,$ctt); my $pref = { table => "contenttrans", fetch => "one", main_id => $accounting_main_id, template_id => 208, c_id => $c_idnew, }; $ctt = $dbt->fetch_record($dbh,$pref); $bw->log("operator_accounting used invoice c_id:",$ctt->{c_id},""); $ck4ex =~ s/\s/,/g; $dbt->update_sql($dbh,"UPDATE contenttrans set int20='$ctt->{c_id}' where c_id IN ($ck4ex)"); print FILE "UPDATE contenttrans set int20='$ctt->{c_id}' where c_id IN ($ck4ex)\n"; $db->update_users4trans($c_idnew,"208","",$users_dms->{u_id}); } my $uri_path = $dbt->recurse_node($dbh,$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; }else{ $ret = "failure::Abbruch, es wurden keine Belege selektiert."; } close FILE; return $ret; } #CSV Export sub export_csv { my $self = shift; my $node_meta = shift; my $users_dms = shift; my $ct4rel = shift || {}; my $coo = shift || ""; my $time = time; my %varenv = $cf->envonline(); my $scol = "c_id"; my $feedb = { message => "" }; $node_meta->{tpl_order} =~ s/txt06=[\w\s=]+,/byte01=Ilockit Token,/ if($node_meta->{tpl_id} == 205); my @tpl_order = split(/,/,$node_meta->{tpl_order}); my $csv_export = Text::CSV_XS->new ({ binary => 1, sep_char => ";", eol => "\r\n" }); my $filename_csv_export = "$dbt->{operator}->{$varenv{dbname}}->{oprefix}-$node_meta->{node_name}-Export-$time.csv"; my @header_line = (); open my $csv, ">", "$varenv{csv}/$filename_csv_export" or die "$filename_csv_export: $!\n"; foreach (@tpl_order){ my ($key,$val,$size,$title) = split /=/,$_; push @header_line, $val; } $csv_export->print($csv, \@header_line);#header foreach my $id (sort { if($users_dms->{sort_updown} eq "down"){ if ($scol =~ /barcode|int/) { $ct4rel->{$b}->{$scol} <=> $ct4rel->{$a}->{$scol} }else{ lc($ct4rel->{$b}->{$scol}) cmp lc($ct4rel->{$a}->{$scol}) } }else{ if ($scol =~ /barcode|int/) { $ct4rel->{$a}->{$scol} <=> $ct4rel->{$b}->{$scol} }else{ lc($ct4rel->{$a}->{$scol}) cmp lc($ct4rel->{$b}->{$scol}) } } } keys(%$ct4rel)){ my @line = (); foreach (@tpl_order){ my ($key,$val,$size,$title) = split /=/,$_; if($key =~ /byte/){ my $K_int = unpack "H*", $ct4rel->{$id}->{$key}; push @line, $K_int; }else{ push @line, $ct4rel->{$id}->{$key}; } } $csv_export->print($csv, \@line); } if( -f "$varenv{basedir}/csv/$filename_csv_export"){ print ""; }else{ $feedb->{message} = "failure:: Der CSV Export von \"$filename_csv_export\" ist fehlgeschlagen."; } return $feedb; } 1;