+++ /dev/null
-#!/usr/bin/perl
-use strict;
-use File::Basename;
-use Getopt::Long;
-use Time::HiRes;
-use Data::Dumper;
-#if ($^O ne "MSWin32" ){
-# eval("use lib (dirname($0));
-# use lib ($ENV{HOME}.'/perl5/lib/perl5');
-# use lib ('C:/USers/ksaff/Workspace/DKSService');");
-#
-#}
-use lib (dirname($0));
-if ($^O eq "darwin"){
- eval("use lib ($ENV{HOME}.'/perl5/lib/perl5');");
-}
-use Plack::Builder;
-use Plack::App::File;
-use Plack::App::WrapCGI;
-use Plack::Middleware::Auth::Basic;
-use Plack::Request;
-use Plack::Runner;
-use Module::Service;
-use Module::Test;
-use Module::SQLite;
-use Module::PDFExtract;
-#use Module::Audio;
-use Module::System;
-use Module::OpenVPN;
-#use Module::SSH;
-#use JSON::PP;
-
-print $^O."\n";
-
-
-my @match = grep { /par-.*inc$/} @INC;
-
-my $basedir = dirname($0);
-if (scalar(@match) > 0){
- $basedir = $match[0];
-}
-
-my $cfgpath = "";
-#print "BASEDIR:".$basedir."\n";
-
-
-sub version {
- require Twiggy;
- print "Twiggy $Twiggy::VERSION\n";
-}
-
-#sub authen_cb {
-# my($username, $password, $env) = @_;
-# return $username eq 'admin' && $password eq 'admin';
-# }
-#my $name = basename($0);
-#$name =~ s/srv\.pl$//;
-#$name =~ s/srv\.exe$//;
-#my $appcfgpath = "";
-#if ($^O eq "MSWin32"){
-# $appcfgpath = $ENV{APPDATA}.'/'.$name;
-#}else {
-# $appcfgpath = $ENV{HOME}.'/Library/Application Support/'.$name;
-#}
-
-
-my $allapp = builder {
- mount "/app" => Module::Service->new();
- mount "/system" => Module::System->new();
- mount "/test" => Module::Test->new();
- mount "/openvpn" => Module::OpenVPN->new();
- mount "/sqlite" => Module::SQLite->new();
- mount "/pdfextract" => Module::PDFExtract->new();
-};
-
-
-my @args = ("-p","6060");
-my $runner = Plack::Runner->new(server => 'Twiggy', env => 'deployment', version_cb => \&version);#env => development, test
-$runner->parse_options(@args);
-$runner->run($allapp);
-
-print "Started\n";
-
-
+++ /dev/null
-#!/usr/bin/perl
-use strict;
-use File::Basename;
-use Getopt::Long;
-use Time::HiRes;
-use Data::Dumper;
-use Plack::Builder;
-use Plack::Request;
-use Plack::Runner;
-use Getopt::Long;
-use lib (dirname($0));
-use pgsql;
-
-sub version {
- require Twiggy;
- print "Twiggy $Twiggy::VERSION\n";
-}
-my $dbhost = "";
-my $dbuser = "";
-my $dbpwd = "";
-my $dbname = "";
-GetOptions("host|h=s" => \$dbhost, "user|u=s" => \$dbuser, "password|p=s" => \$dbpwd,"database|d=s" => \$dbname);
-
-my $db = pgsql->new({"host" => $dbhost,"db" => $dbname, "user" => $dbuser, "pwd" => $dbpwd});
-
-my $pgsync = sub {
- my $env = shift;
- my $html = "";
- my $ct="application/json";
- my $status=200;
- my $request = Plack::Request->new($env);
- if (($env->{REMOTE_ADDR} =~ "^127\.0\.") &&
- ($env->{REMOTE_ADDR} =~ "^10\.") &&
- ($env->{REMOTE_ADDR} =~ "^172\.16\.") &&
- ($env->{REMOTE_ADDR} =~ "^192\.168\.")) {
- return [
- 404,
- [ 'Content-Type' => "text/html",'Cache-Control' => 'no-store, no-cache, must-revalidate' ],
- [ "Sorry no remote access allowed!" ]
- ];
- }
- if ($env->{PATH_INFO} =~ /^\/query/){
- my $type = "querysorted";
- if (exists($request->body_parameters->{type})){
- $type = $request->body_parameters->{type};
- }
- my $r = ();
- if (($type eq "querykey") && (exists($request->body_parameters->{key}))){
- $r = $db->dbquery($request->body_parameters->{key},$request->body_parameters->{sql});
- } elsif ($type eq "queryarray"){
- $r = $db->dbqueryarray($request->body_parameters->{sql});
- } else {
- $r = $db->dbquerysorted($request->body_parameters->{sql});
- }
- $html = JSON::::encode_json($r,{allow_nonref => 1});
- } elsif ($env->{PATH_INFO} =~ /^\/exec/){
- my $r = $db->dbexec($request->param('$sql'));
- $html = JSON::::encode_json($r);
- }
- else {
- $status = 404;
- my $msg->{"error"} = "no valid data 1!";
- $msg->{"pathinfo"} = $env->{PATH_INFO};
- $html = JSON::::encode_json($msg);
- }
-
- if (($html eq "") && ($ct eq "application/json")){
- $status = 404;
- $html='{"error":"no data","path_info":"'.$env->{PATH_INFO}.'"}';
- }
-
- return [
- $status,
- [ 'Content-Type' => $ct,'Cache-Control' => 'no-store, no-cache, must-revalidate' ], #'text/html'
- [ $html ],
- ];
-};
-
-my $app = sub(){
- my $env = shift;
- my $html = "";
- my $ct="application/json";
- my $status=200;
- my $request = Plack::Request->new($env);
- if (($env->{REMOTE_ADDR} =~ "^127\.0\.") &&
- ($env->{REMOTE_ADDR} =~ "^10\.") &&
- ($env->{REMOTE_ADDR} =~ "^172\.16\.") &&
- ($env->{REMOTE_ADDR} =~ "^192\.168\.")) {
- return [
- 404,
- [ 'Content-Type' => "text/html",'Cache-Control' => 'no-store, no-cache, must-revalidate' ],
- [ "Sorry no remote access allowed!" ]
- ];
- }
- if (($env->{PATH_INFO} =~ /^\/stop/) || ($env->{PATH_INFO} =~ /^\/unload/)){
- exit(0);
- }
- if ($env->{PATH_INFO} =~ /^\/reconnect/){
-
- $db->reconnect();
- }
-};
-
-my $allapp = builder {
- mount "/sync" => $pgsync;
- mount "/app" => $app;
-};
-
-my @args = ("-p","6060");
-my $runner = Plack::Runner->new(server => 'Twiggy', env => 'deployment', version_cb => \&version);#env => development, test
-$runner->parse_options(@args);
-$runner->run($allapp);
-
-print "Started\n";
-
+++ /dev/null
-package Module::OpenVPN;
-
-use strict;
-use warnings;
-use parent qw(Plack::Component);
-use Plack::Request;
-use Data::Dumper;
-use File::Find::Rule;
-use File::Basename;
-use JSON::PP;
-use File::Copy;
-use File::Path qw(make_path);
-
-sub call {
- my($self, $env) = @_;
- #$self->_app->($env);
- if (($env->{REMOTE_ADDR} =~ "^127\.0\.") &&
- ($env->{REMOTE_ADDR} =~ "^10\.") &&
- ($env->{REMOTE_ADDR} =~ "^172\.16\.") &&
- ($env->{REMOTE_ADDR} =~ "^192\.168\.")) {
- return [
- 404,
- [ 'Content-Type' => "text/html",'Cache-Control' => 'no-store, no-cache, must-revalidate' ],
- [ "Sorry no remote access allowed!" ]
- ];
- }
- if ($env->{PATH_INFO} =~ /^\/connect/){
- return $self->vpnconnect($env);
- } elsif ($env->{PATH_INFO} =~ /^\/disconnect/){
- return $self->vpndisconnect($env);
- } elsif ($env->{PATH_INFO} =~ /^\/installprofile/){
- return $self->vpninstallprofile($env);
- } elsif ($env->{PATH_INFO} =~ /^\/listprofiles/){
- return $self->vpnprofilelist($env);
- }
- return [
- 404,
- [ 'Content-Type' => "text/html",'Cache-Control' => 'no-store, no-cache, must-revalidate' ],
- [ "Unknown System Request!" ]
- ];
-}
-
-sub vpnconnect(){
- my $self = shift;
- my $env = shift;
- my $html->{result} = 0;
- my $req = Plack::Request->new($env);
- my $uprofile = "";
- #is gui or vpn running
-
- if (exists($req->query_parameters->{vpnprofile})){
- my $status = $self->vpnstatus();
- if (!exists($status->{active}->{$req->query_parameters->{vpnprofile}})){
- if ($^O eq "MSWin32"){
- if (exists($status->{gui})){
- system('taskkill.exe /F /IM openvpn.exe');
- system('taskkill.exe /F /IM openvpn-gui.exe');
- sleep(1);
- }
- my $st = system(1,'start /b "" "C:\Program Files\OpenVPN\bin\openvpn-gui.exe" --connect "'.$req->query_parameters->{vpnprofile}.'.ovpn"');
- if ($st == 0){
-
- my $bconn = 0;
- my $i = 30;
- while ($bconn == 0 || $i > 0){
- $status = $self->vpnstatus();
- if (exists($status->{active}->{$req->query_parameters->{vpnprofile}})){
- $html->{result} = $status;
- $bconn = 1;
- }
- $i--;
- sleep(1);
- }
- }
- }
- } else {
- $html->{result} = $status;
- }
- }
- return [
- 200,
- [ 'Content-Type' => "application/json",'Cache-Control' => 'no-store, no-cache, must-revalidate', 'Access-Control-Allow-Origin'=> '*' ],
- [ JSON::PP::encode_json($html) ]
- ];
-}
-
-sub vpnstatus(){
- my $self = shift;
- my $status = ();
- if ($^O eq "MSWin32"){
-
- my $tasklist = `tasklist`;
- my @task = split("\n",$tasklist);
- my @ovpntasks = grep(/openvpn-gui\.exe/,@task);
- if (scalar(@ovpntasks) > 0){
- $status->{gui} = "running";
- }
- @ovpntasks = grep(/openvpn.exe/,@task);
- #$status->{active_connections} = scalar(@ovpntasks);
- if (scalar(@ovpntasks) > 0){
- my $ff = File::Find::Rule->new();
- $ff->file;
- $ff->name('*.log');
- my @loglist =$ff->in($ENV{USERPROFILE}.'/OpenVPN/log');
- foreach my $c (@loglist){
- open(CLOG,$c);
- my @data = <CLOG>;
- close(CLOG);
- my $laststate=$data[scalar(@data)-1];
- chomp($laststate);
- if ($laststate =~ /CONNECTED/){
- my ($time,$ip,$server,$port) = $laststate =~ /.+MANAGEMENT:\s>STATE:(\d+),CONNECTED,SUCCESS,(.+),(.+),(.+),,$/;
- if (!exists($status->{connection}->{$ip})){
- $status->{connection}->{$ip}->{config} = substr(basename($c),0,-4);;
- $status->{connection}->{$ip}->{server} = $server;
- $status->{connection}->{$ip}->{port} = $port;
- $status->{connection}->{$ip}->{connected_since} = $time;
- }else {
- if ($time >= $status->{connection}->{$ip}->{connected_since}){
- $status->{connection}->{$ip}->{config} = substr(basename($c),0,-4);
- $status->{connection}->{$ip}->{server}= $server;
- $status->{connection}->{$ip}->{port} = $port;
- $status->{connection}->{$ip}->{connected_since} = $time;
- }
- }
- }
- }
- my @notactive = ();
- my $active = ();
- foreach my $c (keys(%{$status->{connection}})){
- my $routeslist = `route print -4`;
- my @routes = split("\n",$routeslist);
- my @activetest = grep(/$c/,@routes);
- if (scalar(@activetest) == 0){
- push @notactive,$c;
- } else {
- $active->{$status->{connection}->{$c}->{config}} = $c;
- }
- }
- foreach my $na (@notactive){
- delete $status->{connection}->{$na};
- }
- $status->{active} = $active;
- }
- }
- return $status;
-}
-
-sub vpndisconnect(){
- my $self = shift;
- my $env = shift;
- my $html->{result} = 1;
- if ($^O eq "MSWin32"){
- system('taskkill.exe /F /IM openvpn.exe');
- system('taskkill.exe /F /IM openvpn-gui.exe');
- }
- return [
- 200,
- [ 'Content-Type' => "application/json",'Cache-Control' => 'no-store, no-cache, must-revalidate', 'Access-Control-Allow-Origin'=> '*' ],
- [ JSON::PP::encode_json($html) ]
- ];
-}
-
-sub vpninstallprofile(){
- my $self = shift;
- my $env = shift;
- my $req = Plack::Request->new($env);
- my $html->{result} = 0;
- if ($^O eq "MSWin32"){
- if ( ! -d $ENV{USERPROFILE}.'/OpenVPN'){
- make_path($ENV{USERPROFILE}.'/OpenVPN');
- }
- if (exists($req->query_parameters->{vpnprofile}) && (-e $req->query_parameters->{vpnprofile}) && ($req->query_parameters->{vpnprofile} =~ /\.ovpn$/)){
- copy(req->query_parameters->{vpnprofile},$ENV{USERPROFILE}.'/OpenVPN/'.basename($req->query_parameters->{vpnprofile}));
- $html->{result} = 1;
- }
- }
- return [
- 200,
- [ 'Content-Type' => "application/json",'Cache-Control' => 'no-store, no-cache, must-revalidate', 'Access-Control-Allow-Origin'=> '*' ],
- [ JSON::PP::encode_json($html) ]
- ];
-}
-
-sub vpnprofilelist(){
- my $self = shift;
- my $env = shift;
- my $html->{result} = ();
- if ($^O eq "MSWin32"){
- my $ff = File::Find::Rule->new();
- $ff->file;
- $ff->name('*.ovpn');
- my @vpnlist =$ff->in($ENV{USERPROFILE}.'/OpenVPN');
- foreach (my $p=0;$p<scalar(@vpnlist);$p++){
- $vpnlist[$p] = substr(basename($vpnlist[$p]),0,-5);
- }
- $html->{result} = \@vpnlist;
- }
- return [
- 200,
- [ 'Content-Type' => "application/json",'Cache-Control' => 'no-store, no-cache, must-revalidate', 'Access-Control-Allow-Origin'=> '*' ],
- [ JSON::PP::encode_json($html) ]
- ];
-}
-
-
-1;
\ No newline at end of file
+++ /dev/null
-package Module::PDFExtract;
-
-use strict;
-use warnings;
-use parent qw(Plack::Component);
-use Plack::Request;
-use File::Basename;
-use Data::Dumper;
-use PDF::API2;
-use File::Path qw/make_path/;
-
-sub call {
- my($self, $env) = @_;
- #$self->_app->($env);
- my $html->{result} = "unknown function";
- if (($env->{REMOTE_ADDR} =~ "^127\.0\.") &&
- ($env->{REMOTE_ADDR} =~ "^10\.") &&
- ($env->{REMOTE_ADDR} =~ "^172\.16\.") &&
- ($env->{REMOTE_ADDR} =~ "^192\.168\.")) {
- return [
- 404,
- [ 'Content-Type' => "text/html",'Cache-Control' => 'no-store, no-cache, must-revalidate' ],
- [ "Sorry no remote access allowed!" ]
- ];
- }
- if ($env->{PATH_INFO} =~ /^\/pdfsplit/){
- return $self->pdfsplit($env);
- }
- if ($env->{PATH_INFO} =~ /^\/pdfpagenumbers/){
- return $self->pdfpagesnumbers($env);
- }
-# if ($env->{PATH_INFO} =~ /^\/pdfextract/){
-# return $self->pdfextract($env);
-# }
- if ($env->{PATH_INFO} =~ /^\/parsedata/){
- return $self->parsedata($env);
- }
- if ($env->{PATH_INFO} =~ /^\/parsestatement/){
- return $self->parsestatement($env);
- }
- return [
- 404,
- [ 'Content-Type' => 'text/html','Cache-Control' => 'no-store, no-cache, must-revalidate' , 'Access-Control-Allow-Origin'=> '*'],
- [ "unknown function" ]
- ];
-}
-
-sub pdfpagesnumbers(){
- my $self = shift;
- my $env = shift;
- my $ct="application/json";
- my $status=200;
- my $req = Plack::Request->new($env);
- my $html->{result}->{pagenumbers} = 0;
- if (exists($req->query_parameters->{file}) && ($req->query_parameters->{file} =~ /\.pdf$/)){
- my $pdf = PDF::API2->open($req->query_parameters->{file});
- $html->{result}->{pagenumbers} = $pdf->pages;
- }
- return [
- 200,
- [ 'Content-Type' => $ct,'Cache-Control' => 'no-store, no-cache, must-revalidate' , 'Access-Control-Allow-Origin'=> '*'],
- [ JSON::PP::encode_json($html) ]
- ];
-}
-
-sub pdfsplit(){
- my $self = shift;
- my $env = shift;
- my $html->{result} = ();
- my $ct="application/json";
- my $status=200;
- my $req = Plack::Request->new($env);
- my @nfiles = ();
- my $outputdir = $ENV{TEMP};
- if (exists($req->query_parameters->{file}) && exists($req->query_parameters->{prefix})){
- my $basepdf = basename($req->query_parameters->{file});
- $outputdir =~ s/\\/\//g;
-
- my $oldpdf = PDF::API2->open($req->query_parameters->{file});
- my $xx = $oldpdf->pages;
- for my $page_nb (1..$xx) {
- my $newpdf = PDF::API2->new;
- my $page = $newpdf->importpage($oldpdf, $page_nb);
-
- my $npdfname = $outputdir.'/'.$req->query_parameters->{prefix}.substr($basepdf,0,-4).".".$page_nb.".pdf";
- push @nfiles,$npdfname;
- if (-e $npdfname){ unlink($npdfname); }
- $newpdf->saveas($npdfname);
- }
- }
- foreach my $n (@nfiles){
- my $r = $self->pdfextract($n);
- }
- $html->{result}->{files} = \@nfiles;
- return [
- 200,
- [ 'Content-Type' => $ct,'Cache-Control' => 'no-store, no-cache, must-revalidate' , 'Access-Control-Allow-Origin'=> '*'],
- [ JSON::PP::encode_json($html) ]
- ];
-};
-
-sub pdfextract(){
- my $self = shift;
- my $file = shift;
-# my $html->{result} = ();
-# my $ct="application/json";
-# my $status=200;
-# my $req = Plack::Request->new($env);
- my $pdftotext;
- my $sep = "/";
- if ($^O eq "MSWin32") {
- $sep = "\\";
- $pdftotext=dirname($0).$sep.'pdftotext.exe';
- }else {
- $pdftotext=dirname($0).$sep.'pdftotext';
- }
- if (-e $file.'.txt'){
- unlink($file.'.txt');
- }
- my $cmd = 'start /b "" "'.$pdftotext.'" -q -table -eol unix "'.$file.'" "'.$file.'.txt"';
- my $st = `$cmd`;#'system(1,$cmd)' ;
- #print $cmd."->".$st."\n";
- return $st;
-}
-
-sub parsedata(){
- my $self = shift;
- my $env = shift;
- my $req = Plack::Request->new($env);
- if (exists($req->query_parameters->{type}) && exists($req->query_parameters->{file})){
- if ($req->query_parameters->{type} eq "inv"){
- return $self->parseinvoice($req->query_parameters->{file});
- } elsif ($req->query_parameters->{type} eq "invold"){
- return $self->parseoldinvoice($req->query_parameters->{file});
- } elsif ($req->query_parameters->{type} eq "stmt") {
- return $self->parsestatement($req->query_parameters->{file});
- } else {
- return [
- 404,
- [ 'Content-Type' => 'text/html','Cache-Control' => 'no-store, no-cache, must-revalidate' , 'Access-Control-Allow-Origin'=> '*'],
- [ "unknown function" ]
- ];
- }
- }
-}
-
-sub parseinvoice(){
- my $self = shift;
- my $file = shift;
- my $html->{result} = ();
- my $ct="application/json";
- my $status=200;
- my $pxdata = ();
- if (-e $file){
- my @invoicedata = ();
- open(EXT,$file);
- while (my $l = <EXT>){
- chomp($l);
- push(@invoicedata,$l);
- }
- close(EXT);
- foreach my $p (@invoicedata){
- if ($p =~ /^N. Facture/) {
- my ($tmp) = $p =~ m/.+\s(\d{4,}.\d{1,2}.\d{4,})\s.+$/;
- $pxdata->{reference} = $tmp;
- }
- if ($p =~ /^Date de la facture/) {
- my ($d,$m,$y) = $p =~ m/.+\s(\d{1,2}).(\d{1,2}).(\d{4,}).+$/;
- if (length($d) == 1) { $d = "0".$d;}
- if (length($m) == 1) { $m = "0".$m;}
- $pxdata->{invoicedate} = $y.'-'.$m.'-'.$d;
- }
-# if (($p =~ /facture/) && ($pxdata->{invoicedate} eq "--")) {
-# my ($d,$m,$y) = $p =~ m/.+\s(\d{1,2}).(\d{1,2}).(\d{4,})$/;
-# if (length($d) == 1) { $d = "0".$d;}
-# if (length($m) == 1) { $m = "0".$m;}
-# $pxdata->{invoicedate} = $y.'-'.$m.'-'.$d;
-# }
- if ($p =~ /^Enfant/) {
- my ($tmp) = $p =~ m/.+\s\((\d+)\).+$/;
- $pxdata->{checkservice} = $tmp;
- }
- if (($p =~ /^\s+\(\d+\)$/) && (!defined($pxdata->{checkservice}))) {
- my ($tmp) = $p =~ m/\s+\((\d+)\)$/;
- $pxdata->{checkservice} = $tmp;
- }
- if ($p =~ /Heures.+\sh\s/) {
- my ($hrs,$p1,$e1) = $p =~ m/.+Heures.+\s+([\s|\d]+,\d{1,2})\sh\s+([\s|\d]+,\d{1,2})\s+([\s|\d]+,\d{1,2}).+$/;
- $p1 =~ s/,/\./;
- $e1 =~ s/,/\./;
- $p1 =~ s/\ //;
- $e1 =~ s/\ //;
- if (exists($pxdata->{hoursamount})){
- $pxdata->{hoursamount} = $pxdata->{hoursamount} + $p1 + $e1;
- } else {
- $pxdata->{hoursamount} = $p1 + $e1;
- }
-
- }
- if ($p =~ /Repas/) {
- my ($rn,$p1,$e1) = $p =~ m/.+Repas.+\s+(\d+)\s+([\s|\d]+,\d{1,2})\s+([\s|\d]+,\d{1,2}).+$/;
- $p1 =~ s/,/\./;
- $e1 =~ s/,/\./;
- $p1 =~ s/\ //;
- $e1 =~ s/\ //;
- $pxdata->{lunchnum} = $rn;
- $pxdata->{lunchamount} = $p1 + $e1;
- }
- if ($p =~ /Participation totale de l.Etat/){
- my ($e1) = $p =~ m/.+Participation totale de l.Etat\s+([\s|\d]+,\d{1,2}).+$/;
- $e1 =~ s/,/\./;
- $e1 =~ s/\ //;
- $pxdata->{benefitamount} = $e1;
- }
- if ($p =~ /Montant\s.\sr.gler/) {
- my ($m1) = $p =~ m/.+Montant.+\s+([\s|\d]+,\d{1,2}).+$/;
- $m1 =~ s/,/\./;
- $m1 =~ s/\ //;
- $pxdata->{totalamount} = $m1;
- }
- #print Dumper(@pdata);
- }
- }
- $html->{result} = $pxdata;
- return [
- 200,
- [ 'Content-Type' => $ct,'Cache-Control' => 'no-store, no-cache, must-revalidate' , 'Access-Control-Allow-Origin'=> '*'],
- [ JSON::PP::encode_json($html) ]
- ];
-}
-
-sub parseoldinvoice(){
- my $self = shift;
- my $file = shift;
- my $html->{result} = ();
- my $ct="application/json";
- my $status=200;
- my $pxdata = ();
- if (-e $file){
- my @invoicedata = ();
- open(EXT,$file);
- while (my $l = <EXT>){
- chomp($l);
- push(@invoicedata,$l);
- }
- close(EXT);
- foreach my $p (@invoicedata){
- if ($p =~ /N. Facture/) {
- my ($tmp) = $p =~ m/.+\s(\d{4,}.\d{1,2}.\d{4,})\s.+$/;
- $pxdata->{reference} = $tmp;
- }
- if ($p =~ /Date de la/) {
- my ($d,$m,$y) = $p =~ m/.+\s(\d{1,2}).(\d{1,2}).(\d{4,})$/;
- if (length($d) == 1) { $d = "0".$d;}
- if (length($m) == 1) { $m = "0".$m;}
- $pxdata->{invoicedate} = $y.'-'.$m.'-'.$d;
- }
- if (($p =~ /facture/) && ($pxdata->{invoicedate} eq "--")) {
- my ($d,$m,$y) = $p =~ m/.+\s(\d{1,2}).(\d{1,2}).(\d{4,})$/;
- if (length($d) == 1) { $d = "0".$d;}
- if (length($m) == 1) { $m = "0".$m;}
- $pxdata->{invoicedate} = $y.'-'.$m.'-'.$d;
- }
- if ($p =~ /Carte N./) {
- my ($tmp) = $p =~ m/.+\s(\d+)$/;
- $pxdata->{checkservice} = $tmp;
- }
- if ($p =~ /Heure/) {
- my ($tmp1,$tmp2) = $p =~ m/.+\s(\d+).(\d+)+$/;
- $pxdata->{hoursamount} = $tmp1.'.'.$tmp2;
- }
- if ($p =~ /Repas/) {
- my ($tmp1,$tmp2) = $p =~ m/.+\s(\d+).(\d+)+$/;
- $pxdata->{lunchamount} = $tmp1.'.'.$tmp2;
- }
- if ($p =~ /Montant\s.\spayer/) {
- my ($tmp1,$tmp2) = $p =~ m/.+\s(\d+).(\d+)+$/;
- $pxdata->{totalamount} = $tmp1.'.'.$tmp2;
- }
- #print Dumper(@pdata);
- }
- }
- $html->{result} = $pxdata;
- return [
- 200,
- [ 'Content-Type' => $ct,'Cache-Control' => 'no-store, no-cache, must-revalidate' , 'Access-Control-Allow-Origin'=> '*'],
- [ JSON::PP::encode_json($html) ]
- ];
-}
-
-sub parsestatement(){
- my $self = shift;
- my $file = shift;
- my $html->{result} = ();
- my $ct="application/json";
- my $status=200;
- my $sxdata = ();
- my $cmonth = "none";
- my $frmonth = {"Janvier" => '01',"Février"=> '02',"Mars" => '03',"Avril" => '04', "Mai" => '05',"Juin" => '06',"Juillet" => '07',"Août" => '08',"Septembre" => '09',"Octobre" => '10',"Novembre" => '11',"Décembre" => '12'};
- if (-e $file){
- my @xstmtdata = ();
- open(EXT,$file);
- while (my $l = <EXT>){
- chomp($l);
- push(@xstmtdata,$l);
- }
- close(EXT);
- my $sxdata = ();
-
- foreach my $p (@xstmtdata){
- if ($p =~ /P.riode/) {
- my ($m1,$y1,$m2,$y2) = $p =~ m/.+\s(.+)\s+(\d+)\s+.\s+(.+)\s+(\d+)$/;
- if (($m1 eq $m2) && ($y1 eq $y2)){
- $cmonth=$y1.'-'.$frmonth->{$m1};
- }
- }
- if ($p =~ /\d{13,}/) {
- my ($csnum,$am) = $p =~ m/.+\s+(\d{13,})\s+([\d|\ |,]+)$/;
- $am =~ s/\s+//;
- $am =~ s/,/./;
- $sxdata->{$cmonth}->{$csnum}=$am;
- }
- }
- }
- $html->{result} = $sxdata;
- return [
- 200,
- [ 'Content-Type' => $ct,'Cache-Control' => 'no-store, no-cache, must-revalidate' , 'Access-Control-Allow-Origin'=> '*'],
- [ JSON::PP::encode_json($html) ]
- ];
-}
-
-
-#
-#sub importstatementdata(){
-# my $simpdata = shift;
-# my $fname = shift;
-# #print Dumper($simpdata);
-# my $n=0;
-# foreach my $m (keys(%{$simpdata})){
-# $n++;
-# if (-e dirname($fname).$sep."prestation.".$m."-".$n.".pdf"){
-# unlink(dirname($fname).$sep."prestation.".$m."-".$n.".pdf");
-# }
-# rename($fname,dirname($fname).$sep."prestation.".$m."-".$n.".pdf");
-# foreach my $csnum (keys(%{$simpdata->{$m}})){
-# $simpdata->{$m}->{fnum} = $n;
-# }
-# }
-# foreach my $m (keys(%{$simpdata})){
-# $n++;
-# if ($m =~ /\d{4,}-\d{2,}/) {
-# foreach my $csnum (keys(%{$simpdata->{$m}})){
-# print "Import Check-Service no: " + $csnum + "\n";
-# if (defined($db)){
-# my $child = $db->dbquerysorted("select uuid from childs where replace(checkservicenumber,' ','') = '".$csnum."';");
-# if (keys(%{$child}) == 1) {
-# my $accdata = $db->dbquerysorted("select accmonth,childuuid from accounting where childuuid='".$child->{0}->{uuid}."' and accmonth=date('".substr($m,0,4).'-'.substr($m,5,2)."-01');");
-# if (keys(%{$accdata}) == 1) {
-# #make update
-# my @upd = ();
-# push @upd,"benefitamount='".$simpdata->{$m}->{$csnum}."'";
-# push @upd,"benefitfile='prestation.".$m."-".$simpdata->{$m}->{fnum}.".pdf'";
-# my $sql = "update accounting set ".join(',',@upd)." where childuuid='".$child->{0}->{uuid}."' and accmonth=date('".substr($m,0,4).'-'.substr($m,5,2)."-01');";
-# #print $sql."\n";
-# my $r = $db->dbexec($sql);
-# if (($log ne "") && (-e $log)){
-# if (!defined($r)) {
-# open(LOG,">>".$log);
-# print LOG localtime().":ERROR:".$sql."\n";
-# close(LOG);
-# } else {
-# open(LOG,">>".$log);
-# print LOG localtime().":SUCCESS:".$sql."\n";
-# close(LOG);
-# }
-# }
-# }else {
-# my @ins1 = ();
-# my @ins2 = ();
-# push(@ins1,"accmonth");push (@ins2,"date('".substr($m,0,4).'-'.substr($m,5,2)."-01')");
-# push(@ins1,"childuuid");push (@ins2,"'".$child->{0}->{uuid}."'");
-# push(@ins1,"benefitamount");push (@ins2,"".$simpdata->{$m}->{$csnum}."");
-# push(@ins1,"benefitfile");push (@ins2,"'prestation.".$m."-".$simpdata->{$m}->{fnum}.".pdf'");
-#
-# #accmonth,childuuid,invoicedate,invoiceamount,reference
-# my $sql = "insert into accounting (".join(',',@ins1).") VALUES (".join(',',@ins2).");";
-# #print $sql."\n";
-# my $r = $db->dbexec($sql);
-# if (($log ne "") && (-e $log)){
-# if (!defined($r)) {
-# open(LOG,">>".$log);
-# print LOG localtime().":ERROR:".$sql."\n";
-# close(LOG);
-# } else {
-# open(LOG,">>".$log);
-# print LOG localtime().":SUCCESS:".$sql."\n";
-# close(LOG);
-# }
-# }
-# }
-# }
-# }
-# }
-# }
-# }
-#}
-
-1;
\ No newline at end of file
+++ /dev/null
-package Module::SQLite;
-
-use strict;
-use warnings;
-use parent qw(Plack::Component);
-use Plack::Request;
-#use Data::Dumper;
-use DBI;
-use DBD::SQLite;
-use Encode;
-use JSON::PP;
-use File::Copy;
-
-sub call {
- my($self, $env) = @_;
- if (($env->{REMOTE_ADDR} =~ "^127\.0\.") &&
- ($env->{REMOTE_ADDR} =~ "^10\.") &&
- ($env->{REMOTE_ADDR} =~ "^172\.16\.") &&
- ($env->{REMOTE_ADDR} =~ "^192\.168\.")) {
- return [
- 404,
- [ 'Content-Type' => "text/html",'Cache-Control' => 'no-store, no-cache, must-revalidate' ],
- [ "Sorry no remote access allowed!" ]
- ];
- }
- if ($env->{PATH_INFO} =~ /^\/createdb/){
- return $self->createdb($env);
- } elsif ($env->{PATH_INFO} =~ /^\/checkdb/){
- return $self->checkdb($env);
- }else {
- return $self->sqlite($env);
- }
- return [
- 404,
- [ 'Content-Type' => "text/html",'Cache-Control' => 'no-store, no-cache, must-revalidate' ],
- [ "no such function!" ]
- ];
-}
-
-sub sqlite {
- my $self = shift;
- my $env = shift;
- my $html->{result} = ();
- my $ct="application/json";
- my $status=200;
- my $req = Plack::Request->new($env);
- my $res = ();
- #print $req->query_parameters->{db}.":".$req->query_parameters->{type}.":".decode_base64($req->query_parameters->{sql})."\n------------------\n";
- $html->{req}->{db} = $req->query_parameters->{db};
- $html->{req}->{type} = $req->query_parameters->{type};
- $html->{req}->{sql} = $req->query_parameters->{sql};
- #$html->{req}->{sqldecoded} = $req->query_parameters->{sql};
- if (( -f $req->query_parameters->{db} ) && (exists($req->query_parameters->{sql})) && (exists($req->query_parameters->{type})) ) {
-
- $self->{dbfile} = $req->query_parameters->{db};
- #my $db = sqlite->new();
- my $q = $req->query_parameters->{sql};
- my $t = $req->query_parameters->{type};
- if ($t eq "query"){
- $res = $self->dbquery($req->query_parameters->{key},$q);
- } elsif ($t eq "querysorted"){
- $res = $self->dbquerysorted($q);
- } elsif ($t eq "queryarray"){
- $res = $self->dbqueryarray($q);
- } elsif ($t eq "exec"){
- $res = $self->dbexec($q);
- }
-
- }
- $html->{result}->{sqldata} = $res;
- return [
- 200,
- [ 'Content-Type' => $ct.'; charset=utf-8','Cache-Control' => 'no-store, no-cache, must-revalidate', 'Access-Control-Allow-Origin'=> '*' ],
- [ JSON::PP::encode_json($html) ]
- ];
-};
-
-
-
-sub strreplace(){
- my $self = shift;
- my $text = shift;
- $text =~ s/'/''/g;
- return $text;
-}
-
-sub dbquery(){
- my $self = shift;
- my $key = shift;
- my $stat = shift;
- my $retdata =();
- my $dbh = DBI->connect('DBI:SQLite:dbname='.$self->{dbfile},"","",{PrintError=>1,RaiseError=>1,AutoCommit=>1}) or return $retdata->{error} = "dbquery Connection Error!".$!;
- #$stat = encode("utf8", $stat);
-
- #open FILE,">>/tmp/sql.log";
- # print FILE "key:".$key.";$stat\n";
- # close FILE;
- my $sth = $dbh->prepare($stat);
- $sth->execute() or print "dbquery: ".$sth->errstr;
- while(my $data = $sth->fetchrow_hashref())
- {
- if (exists $data->{$key}){
- foreach my $k (keys %{$data}){
- $retdata->{$data->{$key}}{$k} = decode( "utf8", $data->{$k});
- }
- }
- }
- if (keys(%{$retdata}) == 0){
- $retdata =();
- }
- $sth->finish();
- $dbh->disconnect();
- return $retdata;
-}
-
-sub dbquerysorted(){
- my $self = shift;
- my $stat = shift;
- my $retdata = ();
- my $dbh = DBI->connect('DBI:SQLite:dbname='.$self->{dbfile},"","",{PrintError=>1,RaiseError=>1,AutoCommit=>1}) or return $retdata->{error} = "dbquery Connection Error!".$!;
- #$stat = encode("utf8", $stat);
- #open FILE,">>/tmp/sql.log";
- #print "$stat\n";
- # close FILE;
- my $sth = $dbh->prepare($stat);
-
- $sth->execute() or print "dbquery: ".$sth->errstr;
- my $count = 0;
- while(my $data = $sth->fetchrow_hashref())
- {
- foreach my $k (keys %{$data}){
- $retdata->{$count}->{$k} = decode( "utf8", $data->{$k});
- }
- $count++;
- }
-
- $sth->finish();
- $dbh->disconnect();
- #%retdata = sort {$a <=> $b} keys %retdata;
- return $retdata;
-}
-
-sub dbqueryarray(){
- my $self = shift;
- my $stat = shift;
- my @retdata = ();
- my $dbh = DBI->connect('DBI:SQLite:dbname='.$self->{dbfile},"","",{PrintError=>1,RaiseError=>1,AutoCommit=>1}) or return $retdata[0]->{error} = "dbquery Connection Error!".$!;
- #$stat = encode("utf8", $stat);
- #open FILE,">>/tmp/sql.log";
- #print "$stat\n";
- # close FILE;
- my $sth = $dbh->prepare($stat);
-
- $sth->execute() or print "dbquery: ".$sth->errstr;
- my $count = 0;
-
- while(my $valdata = $sth->fetchrow_arrayref())
- {
- if (!defined($valdata)){ last;}
- my @rdata = ();
- foreach my $k (@{$valdata}){
- push @rdata,decode( "utf8", $k);
- }
- push @retdata,\@rdata;
- }
-
- $sth->finish();
- $dbh->disconnect();
- #%retdata = sort {$a <=> $b} keys %retdata;
- return \@retdata;
-}
-
-sub dbexec(){
- my $self = shift;
- my $stat = shift;
- my $dbh = DBI->connect('DBI:SQLite:dbname='.$self->{dbfile},"","",{PrintError=>1,AutoCommit=>1}) or return "dbexec Connection Error!".$!;
- #$stat = encode("utf8", $stat);
- #print $stat."\n";
- #open FILE,">>/Users/kilian/sql.log";
- #print FILE "$stat\n";
- #close FILE;
- my $sth = $dbh->prepare($stat);
- my $rv =$dbh->do($stat) or print "Failed dbexec:\n'".$stat. "'\n\n";
- $dbh->disconnect();
- return $rv;
-}
-
-sub createdb(){
- my $self = shift;
- my $env = shift;
- my $html->{result} = 0;
- my $ct="application/json";
- my $status=200;
- my $req = Plack::Request->new($env);
- if (exists($req->query_parameters->{templatedb}) && exists($req->query_parameters->{newdb}) && (-f $req->query_parameters->{templatedb})){
- my $r = copy($req->query_parameters->{templatedb},$req->query_parameters->{newdb});
- $html->{result} = $r;
- }
- return [
- 200,
- [ 'Content-Type' => $ct.'; charset=utf-8','Cache-Control' => 'no-store, no-cache, must-revalidate', 'Access-Control-Allow-Origin'=> '*' ],
- [ JSON::PP::encode_json($html) ]
- ];
-}
-
-sub checkdb(){
- my $self = shift;
- my $env = shift;
- my $html->{result} = 1;
- my $ct="application/json";
- my $status=200;
- my $req = Plack::Request->new($env);
- if (exists($req->query_parameters->{templatedb}) && exists($req->query_parameters->{db}) && (-f $req->query_parameters->{templatedb}) && (-f $req->query_parameters->{db})){
- my $templatedb = $req->query_parameters->{templatedb};
- my $dborig = $req->query_parameters->{templatedb};
- $self->{dbfile} = $templatedb;
- my $dbdefsql = "SELECT type, name,tbl_name,sql FROM sqlite_master order by name,tbl_name,type;";
- my $defdbschemacfg = $self->dbquerysorted($dbdefsql);
- $self->{dbfile} = $dborig;
- my $tcurcfg = $self->dbquerysorted($dbdefsql);
- my $keycnt = keys(%{$defdbschemacfg});
- my $bvaccum = 0;
- my $stexec = 0;
- foreach my $pd (sort {$a <=> $b} keys(%{$defdbschemacfg})){
- if ($defdbschemacfg->{$pd}->{'type'} eq 'table') {
- my $bupdate = 0;
- my $bexists = 0;
- my $cucols = '';
- my $oldobj = ();
- foreach my $pc (keys(%{$tcurcfg})){
- if (($tcurcfg->{$pc}->{tbl_name} eq $defdbschemacfg->{$pd}->{tbl_name}) && ($tcurcfg->{$pc}->{type} eq $defdbschemacfg->{$pd}->{type})){
- #print $defdbschemacfg->{$pd}->{type}.": ".$defdbschemacfg->{$pd}->{tbl_name}. "\n";
- if ($tcurcfg->{$pc}->{sql} ne $defdbschemacfg->{$pd}->{sql}){ $bupdate = 1; $oldobj= $self->getcoldef($tcurcfg->{$pc}->{sql}); }
- $bexists = 1; last;
- }
- }
- if (($bexists==1) && ($bupdate== 1)){
- my $sql_installnew = $defdbschemacfg->{$pd}->{sql};
- my $newobj = $self->getcoldef($defdbschemacfg->{$pd}->{sql});
- my @copycols = ();
- for my $x (keys(%{$newobj})){
- if (exists($oldobj->{$x})) { push @copycols,$x; }
- }
- my @ainssql = ();
- push(@ainssql,"DROP TABLE IF EXISTS new_".$defdbschemacfg->{$pd}->{tbl_name}. ";");
- my $sql_tmptbl = $sql_installnew;
- $sql_tmptbl =~ s/CREATE\ TABLE\ /CREATE TABLE new_/;
- $sql_tmptbl =~ s/"//g;
- push(@ainssql,$sql_tmptbl);
- push(@ainssql,"INSERT INTO new_".$defdbschemacfg->{$pd}->{tbl_name}." (".join(',',@copycols).") SELECT ".join(',',@copycols)." FROM ".$defdbschemacfg->{$pd}->{tbl_name}.";");
- push(@ainssql,"DROP TABLE ".$defdbschemacfg->{$pd}->{tbl_name}.";");
- push(@ainssql,"ALTER TABLE new_".$defdbschemacfg->{$pd}->{tbl_name}. " RENAME TO ".$defdbschemacfg->{$pd}->{tbl_name}.";");
- $bvaccum = 1;
- #print Dumper(@ainssql);
- my $stexec = 0;
- for(my $s=0;$s<scalar(@ainssql);$s++){
- if (defined($stexec)) { $stexec = $self->dbexec($ainssql[$s]); }
- }
- #print "tbl done\n";
- }
- elsif ($bexists == 0){
- my $sql_installnew = $defdbschemacfg->{$pd}->{sql};
- $self->dbexec($sql_installnew);
- }
- } elsif (($defdbschemacfg->{$pd}->{'type'} eq 'trigger') || ($defdbschemacfg->{$pd}->{'type'} eq 'index')) {
- my $bexists = 0; my $bupdate = 0;
- foreach my $pc (keys(%{$tcurcfg})){
- if (($tcurcfg->{$pc}->{tbl_name} eq $defdbschemacfg->{$pd}->{tbl_name}) && ($tcurcfg->{$pc}->{type} eq $defdbschemacfg->{$pd}->{type})){
- # print $defdbschemacfg->{$pd}->{type}.": ".$defdbschemacfg->{$pd}->{tbl_name}. "\n";
- if ($tcurcfg->{$pc}->{sql} ne $defdbschemacfg->{$pd}->{sql}){ $bupdate = 1; }
- $bexists = 1; last;
- }
- }
- if (($bexists==1) && ($bupdate== 1)){
- $bvaccum = 1;
- my @ainssql = ();
- if ($defdbschemacfg->{$pd}->{type} eq 'trigger'){
- push @ainssql,"DROP TRIGGER IF EXISTS ".$defdbschemacfg->{$pd}->{'name'}.";";
- } elsif ($defdbschemacfg->{$pd}->{type} eq 'index') {
- push @ainssql,"DROP INDEX IF EXISTS ".$defdbschemacfg->{$pd}->{'name'}.";";
- }
- push @ainssql,$defdbschemacfg->{$pd}->{'sql'};
- my $stexec = 0;
- for(my $s=0;$s<scalar(@ainssql);$s++){
- if (defined($stexec)) { $stexec = $self->dbexec($ainssql[$s]); }
- }
- }elsif ($bexists == 0) {
- my $sql_installnew = $defdbschemacfg->{$pd}->{sql};
- $self->dbexec($sql_installnew); #Test check
- }
- }
- }
- if ($bvaccum == 1) { $self->dbexec("vacuum;"); }
- }
- return [
- 200,
- [ 'Content-Type' => $ct.'; charset=utf-8','Cache-Control' => 'no-store, no-cache, must-revalidate', 'Access-Control-Allow-Origin'=> '*' ],
- [ JSON::PP::encode_json($html) ]
- ];
-}
-
-
-sub getcoldef($){
- my $self = shift;
- my $strddl = shift;
- my $curddl = $strddl;
- $curddl =~ s/\s+/\ /g;
- my $bi = index($curddl,'(')+1;
- my $ei = rindex($curddl,')');
-
- $curddl = substr($curddl,$bi,length($curddl)-$bi-(length($curddl)-$ei));#curddl.substring(curddl.indexOf('(')+1,curddl.lastIndexOf(')')).trim().replace(/\s+/g," ");
- my @colsfull = split(/,/,$curddl);# curddl =curddl.replace(new RegExp("\\b(" + appdb.keywords.join("|") + ")\\b", "g"), "");
- my $tblobj = ();
- foreach my $c (@colsfull){
- $c =~ s/^\s+//;
- $c =~ s/\s+$//;
- my @coldef = split(/\ /,$c);
- my $type = uc($coldef[1]);
- if (($type =~ /^TEXT/) || ($type =~ /^REAL/) || ($type =~ /^INTEGER/) || ($type =~ /^BOOLEAN/) || ($type =~ /^DATE/) || ($type =~ /^DATETIME/)) {
- $tblobj->{$coldef[0]} = $type;
- }
- }
- return $tblobj;
-}
-
-#sub dbbackup(){
-# my $self = shift;
-# my $path = shift;
-# my $type = shift;
-#
-# my @dx = localtime();
-# $dx[5] = $dx[5] +1900;
-# $dx[4] = $dx[4] +1;
-# if ($dx[4] < 10){$dx[4] = '0'.$dx[4];}
-# if ($dx[3] < 10){$dx[3] = '0'.$dx[3];}
-# if ($dx[2] < 10){$dx[2] = '0'.$dx[2];}
-# if ($dx[1] < 10){$dx[1] = '0'.$dx[1];}
-# if ($dx[0] < 10){$dx[0] = '0'.$dx[0];}
-# my $xdd = $dx[5].$dx[4].$dx[3].'_'.$dx[2].$dx[1].$dx[0];
-# my $bfile = "";
-# if ($type eq "binary" ) {
-# $bfile = $path.'/'.basename(substr($self->{dbfile},0,rindex($self->{dbfile},'.'))).'_'.$xdd.'.sqlite';
-# my $dbh = DBI->connect('DBI:SQLite:dbname='.$self->{dbfile},"","",{PrintError=>1,RaiseError=>1,AutoCommit=>1}) or die "dbexec Connection Error!".$!;
-# $dbh->sqlite_backup_to_file($bfile);
-# $dbh->disconnect();
-# }elsif($type eq "sql"){
-# $bfile = $path.'/'.basename($self->{dbfile}).'_'.$xdd.'.sql';
-# my $st = system('sqlite3 "'.$self->{dbfile}.'" ".dump" > '.$bfile);
-# }
-# return $bfile;
-#}
-#
-#sub dbrestore(){
-# my $self = shift;
-# my $file = shift;
-# my $type = shift;
-# if ($type eq "binary" ) {
-# my $dbh = DBI->connect('DBI:SQLite:dbname='.$self->{dbfile},"","",{PrintError=>1,RaiseError=>1,AutoCommit=>1}) or die "dbexec Connection Error!".$!;
-# $dbh->sqlite_backup_from_file($file);
-# $dbh->disconnect();
-# }elsif($type eq "sql"){
-# open(REST,$file) or die "cannot open restore file $file!\n";
-# my $rsql = "";
-# while (my $l = <REST>) {
-# $rsql .= $l;
-# }
-# close(REST);
-# unlink($self->{dbfile});
-# $self->dbexec($rsql);
-# }
-#}
-#
-#sub dbrepair(){
-# my $self = shift;
-# my $bfile = $self->dbbackup($ENV{'TMPDIR'},'sql');
-# $self->dbrestore($bfile,'sql');
-# unlink($bfile);
-#}
-
-
-1;
\ No newline at end of file
+++ /dev/null
-package Module::Service;
-
-use strict;
-use warnings;
-use File::Path qw(make_path);
-use File::Basename;
-use parent qw(Plack::Component);
-
-
-sub call {
- my($self, $env) = @_;
- if (($env->{REMOTE_ADDR} =~ "^127\.0\.") &&
- ($env->{REMOTE_ADDR} =~ "^10\.") &&
- ($env->{REMOTE_ADDR} =~ "^172\.16\.") &&
- ($env->{REMOTE_ADDR} =~ "^192\.168\.")) {
- return [
- 404,
- [ 'Content-Type' => "text/html",'Cache-Control' => 'no-store, no-cache, must-revalidate' ],
- [ "Sorry no access allowed!" ]
- ];
- }
- return $self->service($env);
-}
-
-sub service() {
- my $self = shift;
- my $env = shift;
- my $html = "Unknown service!";
- my $ct="application/json";
- my $status=200;
-
- if ($env->{PATH_INFO} =~ /^\/info/){
- return $self->appinfo($env);
- }
- if ($env->{PATH_INFO} =~ /^\/preferences/){
- return $self->preferences($env);
- }
- if (($env->{PATH_INFO} =~ /^\/stop/) || ($env->{PATH_INFO} =~ /^\/unload/)){
- exit(0);
- }
- if ($env->{PATH_INFO} =~ /^\/shutdown/){
- system('sudo shudown -h now');
- $html = "shutdown launched";
- }
- if ($env->{PATH_INFO} =~ /^\/restart/){
- system('sudo shudown -r now');
- $html = "restart launched";
- }
-
- return [
- 200,
- [ 'Content-Type' => 'text/html','Cache-Control' => 'no-store, no-cache, must-revalidate' , 'Access-Control-Allow-Origin'=> '*'],
- [ $html ]
- ];
-};
-
-sub preferences(){
- my $self = shift;
- my $env =shift;
- my $name = basename($0);
- $name =~ s/srv\.pl$//;
- $name =~ s/srv\.exe$//;
- my $appcfgpath = "";
- if ($^O eq "MSWin32"){
- $appcfgpath = $ENV{APPDATA}.'/'.$name;
- } elsif ($^O eq "darwin"){
- $appcfgpath = $ENV{HOME}.'/Library/Application Support/'.$name;
- }
-
- $appcfgpath =~ s/\\/\//g;
- my $pref->{result}= ();
- my $req = Plack::Request->new($env);
- if (exists($req->query_parameters->{page})){
- if (-e $appcfgpath.'/'.$req->query_parameters->{page}.'.json'){
- open(PREF,$appcfgpath.'/'.$req->query_parameters->{page}.'.json');
- my $strpref = "";
- while (my $l = <PREF>){
- $strpref .= $l;
- }
- close(PREF);
- $pref->{result}=JSON::PP::decode_json($strpref);
- }
- if (exists($req->query_parameters->{set})){
- my $newpref = JSON::PP::decode_json($req->query_parameters->{set});
- foreach my $p (keys(%{$newpref})){
- $pref->{result}->{$p} = $newpref->{$p};
- }
- open(PREF,">".$appcfgpath.'/'.$req->query_parameters->{page}.'.json');
- print PREF JSON::PP::encode_json($pref->{result});
- close(PREF);
- }
- }
- return [
- 200,
- [ 'Content-Type' => "application/json",'Cache-Control' => 'no-store, no-cache, must-revalidate', 'Access-Control-Allow-Origin'=> '*' ],
- [ JSON::PP::encode_json($pref) ]
- ];
-}
-
-sub appinfo(){
- my $self = shift;
- my $env = shift;
- my $html->{result} = ();
- my $req = Plack::Request->new($env);
- my $name = basename($0);
- $name =~ s/srv\.pl$//;
- $name =~ s/srv\.exe$//;
- $html->{result}->{OS} = $^O;
- $html->{result}->{app} = $name;
- if ($^O eq "MSWin32"){
- $html->{result}->{home} = $ENV{USERPROFILE};
- $html->{result}->{user} = $ENV{USERNAME};
- $html->{result}->{appcfgpath} = $ENV{APPDATA}.'/'.$name;
- $html->{result}->{hostname} = $ENV{COMPUTERNAME};
- $html->{result}->{arch} = $ENV{PROCESSOR_ARCHITEW6432};
- $html->{result}->{appcfgpath} =~ s/\\/\//g;
- $html->{result}->{home} =~ s/\\/\//g;
- } else {
- $html->{result}->{home} = $ENV{HOME};
- $html->{result}->{user} = $ENV{USER};
- if ($^O eq "darwin"){
- $html->{result}->{appcfgpath} = $ENV{HOME}.'/Library/Application Support/'.$name;
- } else {
- $html->{result}->{appcfgpath} = $ENV{HOME}.'/.'.$name.'/';
- }
- $html->{result}->{hostname} = `hostname -s`;
- chomp($html->{result}->{hostname});
- $html->{result}->{arch} = `uname -m`;
- chomp($html->{result}->{arch});
- }
- if (! -e $html->{result}->{appcfgpath}){
- make_path($html->{result}->{appcfgpath});
- }
- if (-e $html->{result}->{appcfgpath}.'/service.json'){
- open(LCFG,$html->{result}->{appcfgpath}.'/service.json');
- my $strprofile = "";
- while (my $l = <LCFG>){
- $strprofile .= $l;
- }
- close(LCFG);
- if ($strprofile ne ""){
- $html->{result}->{appconfig} = JSON::PP::decode_json($strprofile);
- }
- }
- if (!exists($html->{result}->{appconfig})){
- $html->result->{appconfig} = undef;
- }
- return [
- 200,
- [ 'Content-Type' => "application/json",'Cache-Control' => 'no-store, no-cache, must-revalidate', 'Access-Control-Allow-Origin'=> '*' ],
- [ JSON::PP::encode_json($html) ]
- ];
-}
-
-1;
\ No newline at end of file
+++ /dev/null
-package Module::System;
-
-use strict;
-use warnings;
-use parent qw(Plack::Component);
-use Plack::Request;
-use Data::Dumper;
-use File::Find::Rule;
-use File::Basename;
-use JSON::PP;
-use File::Path qw(make_path remove_tree);
-use File::Copy;
-use MIME::Types;
-if ($^O eq "MSWin32"){
- eval('use Win32::File; use Win32::GUI;');
-}
-
-sub call {
- my($self, $env) = @_;
- if (($env->{REMOTE_ADDR} =~ "^127\.0\.") &&
- ($env->{REMOTE_ADDR} =~ "^10\.") &&
- ($env->{REMOTE_ADDR} =~ "^172\.16\.") &&
- ($env->{REMOTE_ADDR} =~ "^192\.168\.")) {
- return [
- 404,
- [ 'Content-Type' => "text/html",'Cache-Control' => 'no-store, no-cache, must-revalidate' ],
- [ "Sorry no remote access allowed!" ]
- ];
- }
- if ($env->{PATH_INFO} =~ /^\/search/){
- return $self->search($env);
- } elsif ($env->{PATH_INFO} =~ /^\/directory/) {
- return $self->directory($env);
- } elsif ($env->{PATH_INFO} =~ /^\/file/) {
- return $self->file($env);
- } elsif ($env->{PATH_INFO} =~ /^\/userenv/){
- return $self->userenv($env);
- }
- return [
- 404,
- [ 'Content-Type' => "text/html",'Cache-Control' => 'no-store, no-cache, must-revalidate' ],
- [ "Unknown System Request!" ]
- ];
-}
-
-sub search() {
- my $self = shift;
- my $env = shift;
- my $html->{result} = ();
- my $ct="application/json";
- my $status=200;
- my $req = Plack::Request->new($env);
- my $ff = File::Find::Rule->new;
- if (exists($req->query_parameters->{name})){
- my $namesearch = $req->query_parameters->{name};
- $ff->name($req->query_parameters->{name})
- }
- if (exists($req->query_parameters->{type})){
- if ($req->query_parameters->{type} eq 'd'){
- $ff->directory;
- } else {
- $ff->file;
- }
- }
- if (exists($req->query_parameters->{relative})){
- $ff->relative;
- }
- if (exists($req->query_parameters->{osspec})){
- $ff->canonpath;
- }
- my @data = $ff->in($req->query_parameters->{path});
- if (exists($req->query_parameters->{sorted})){
- @data = sort {$a cmp $b} @data;
- if ($req->query_parameters->{sorted} eq "desc"){
- @data = reverse(@data);
- }
- }
- $html->{result} = \@data;
- return [
- 200,
- [ 'Content-Type' => $ct,'Cache-Control' => 'no-store, no-cache, must-revalidate', 'Access-Control-Allow-Origin'=> '*' ],
- [ JSON::PP::encode_json($html) ]
- ];
-}
-
-sub directory() {
- my $self = shift;
- my $env = shift;
- my $html;
- my $ct="application/json";
- my $status=200;
-
- my $req = Plack::Request->new($env);
- if ($env->{PATH_INFO} =~ /^\/directory\/list/){
- my $mt = MIME::Types->new();
- $html->{result} = 0;
- if (exists($req->query_parameters->{path})){
- my $dir = $req->query_parameters->{path};
- #print $dir."\n";
- $html->{result} = {'path' => $dir};
- if (-d $dir){
- my @dirs = ();
- my @files = ();
- opendir(LDIR,$dir);
- while (my $f = readdir(LDIR)){
- if ($f =~ /^\./){ next; }
-
- if (-d $dir.'/'.$f){
- my $bok =1 ;
- if ($^O eq "MSWin32"){
- eval ('my $attr;
- Win32::File::GetAttributes($dir.\'/\'.$f,$attr);
- if ($attr & HIDDEN){
- $bok = 0;
- }');
- }
- if ($bok == 1){
- push(@dirs,$f);
- }
-
- } elsif (-f $dir.'/'.$f) {
- my $bok =1 ;
- if ($^O eq "MSWin32"){
- eval ('my $attr;
- Win32::File::GetAttributes($dir.\'/\'.$f,$attr);
- if ($attr & HIDDEN){
- $bok = 0;
- }');
- }
- if ($bok == 1){
- print $f."\n";
- my $fi->{name} = $f;
- my $mtf = $mt->mimeTypeOf($f);
- $fi->{mimetype} = (exists($mtf->{MT_simplified})?$mtf->{MT_simplified}:'unknown');
-
- push(@files,$fi);
- }
- }
- }
- closedir(LDIR);
- $html->{result}->{directory} = \@dirs;
- $html->{result}->{file} = \@files;
- }
- }
- }
- if ($env->{PATH_INFO} =~ /^\/directory\/exists/){
- $html->{result} = 0;
- if (exists($req->query_parameters->{path})){
- if (-d $req->query_parameters->{path}){
- $html->{result} = 1;
- }
- }
- }
- if ($env->{PATH_INFO} =~ /^\/directory\/make/){
- make_path($req->query_parameters->{path});
- $html->{result} = 0;
- if (-d $req->query_parameters->{path}){
- $html->{result} = 1;
- }
- }
- if ($env->{PATH_INFO} =~ /^\/directory\/delete/){
- my $keep_root = 0;
- if (exists($req->query_parameters->{keep_root})){
- $keep_root = 1;
- }
- $html->{result} = 0;
- if (-d $req->query_parameters->{path}){
- remove_tree( $req->query_parameters->{path}, {keep_root => $keep_root} );
- $html->{result} = 1;
- }
- }
- return [
- 200,
- [ 'Content-Type' => $ct,'Cache-Control' => 'no-store, no-cache, must-revalidate', 'Access-Control-Allow-Origin'=> '*' ],
- [ JSON::PP::encode_json($html) ]
- ];
-}
-
-sub file() {
- my $self = shift;
- my $env = shift;
- my $html->{result} = ();
- my $ct="application/json";
- my $status=200;
-
- my $req = Plack::Request->new($env);
- if ($env->{PATH_INFO} =~ /^\/file\/exists/){
- $html->{result} = 0;
- if (exists($req->query_parameters->{path})){
- if (-f $req->query_parameters->{path}){
- $html->{result} = 1;
- }
- }
- }
- if ($env->{PATH_INFO} =~ /^\/file\/write/){
- $html->{result} = 0;
- if (exists($req->query_parameters->{path})){
- if (! -d (dirname($req->query_parameters->{path}))){
- make_path(dirname($req->query_parameters->{path}))
- }
- my $fwrite = ">";
- if (exists($req->query_parameters->{append})){
- $fwrite = ">>";
- }
- my $datax = $req->body_parameters->{data};
- print $req->body_parameters->{data}."\n";
- open(WFI,$fwrite.$req->query_parameters->{path});
- print WFI $req->body_parameters->{data};
- close(WFI);
- $html->{result} = 1;
- }
- }
- if ($env->{PATH_INFO} =~ /^\/file\/read/){
- $html->{result} = "";
- if (exists($req->query_parameters->{path})){
- if (-f $req->query_parameters->{path}){
- my $rdata = "";
- open(RFI,$req->query_parameters->{path});
- while ( my $l = <RFI>){
- $rdata .= $l;
- }
- close(RFI);
- $html->{result} = $rdata;
- }
- }
- }
- if ($env->{PATH_INFO} =~ /^\/file\/copy/){
- $html->{result} = "";
- if (exists($req->query_parameters->{src})){
- if (-f $req->query_parameters->{src}){
- my $dest = $req->query_parameters->{dest};
- if (! -d dirname($req->query_parameters->{dest})){
- make_path(dirname($req->query_parameters->{dest}))
- }
- if ($req->query_parameters->{src} ne $req->query_parameters->{dest}){
- my $cp = copy($req->query_parameters->{src},$req->query_parameters->{dest});
- $html->{result} = $cp;
- } else {
- $html->{result} = 1;
- }
- }
- }
-
- }
- if ($env->{PATH_INFO} =~ /^\/file\/move/){
- $html->{result} = "";
- if (exists($req->query_parameters->{src})){
- if (-f $req->query_parameters->{src}){
- my $dest = $req->query_parameters->{dest};
- if (! -d dirname($req->query_parameters->{dest})){
- make_path(dirname($req->query_parameters->{dest}))
- }
- if ($req->query_parameters->{src} ne $req->query_parameters->{dest}){
- my $cp = move($req->query_parameters->{src},$req->query_parameters->{dest});
- $html->{result} = $cp;
- } else {
- $html->{result} = 0;
- }
- }
- }
-
- }
- if ($env->{PATH_INFO} =~ /^\/file\/dialog/){
- if ($^O eq "MSWin32"){
- my $multisel = 0;
- if (exists($req->query_parameters->{multisel})){
- $multisel = $req->query_parameters->{multisel};
- }
- my $title = "select file";
- if (exists($req->query_parameters->{title})){
- $title = $req->query_parameters->{title};
- }
- my $lastdir = $ENV{USERPROFILE};
- if (exists($req->query_parameters->{dir})){
- $lastdir = $req->query_parameters->{dir}
- }
- my @filters = ['All Files - *', '*'];
- if(exists($req->query_parameters->{filters})){
- my @newfilters = split(',',$req->query_parameters->{filters});
- push(@newfilters,'All Files - *','*');
- $filters[0] = \@newfilters;
- }
- my ( @file);
- my ( @parms );
- push (@parms,-filter => @filters,-directory => $lastdir,-title => $title,-multisel => $multisel,-filemustexist => 1,-pathmustexist => 1);
- @file = Win32::GUI::GetOpenFileName ( @parms );
- $html->{result}->{files} = \@file;
- }
- }
- if ($env->{PATH_INFO} =~ /^\/file\/open/){
- if ( (exists($req->query_parameters->{file})) && (-e $req->query_parameters->{file}) ){
- if ($^O eq "MSWin32"){
- my $st = system('start /b "" "'.$req->query_parameters->{file}.'"');
- $html->{result} = $st;
- }
- } else {
- $html->{result} = -1000;
- }
-
- }
- if ($env->{PATH_INFO} =~ /^\/file\/delete/){
- if ( (exists($req->query_parameters->{file})) && (-e $req->query_parameters->{file}) ){
- unlink($req->query_parameters->{file});
- $html->{result} = 1;
- } else {
- $html->{result} = 0;
- }
-
- }
- if ($env->{PATH_INFO} =~ /^\/file\/rename/){
- $html->{result} = "";
- if (exists($req->query_parameters->{src})){
- if (-f $req->query_parameters->{src}){
- my $dest = $req->query_parameters->{dest};
- if (! -d dirname($req->query_parameters->{dest})){
- make_path(dirname($req->query_parameters->{dest}))
- }
- if ($req->query_parameters->{src} ne $req->query_parameters->{dest}){
- my $cp = rename($req->query_parameters->{src},$req->query_parameters->{dest});
- $html->{result} = $cp;
- } else {
- $html->{result} = 1;
- }
- }
- }
-
- }
-
-
- return [
- 200,
- [ 'Content-Type' => $ct,'Cache-Control' => 'no-store, no-cache, must-revalidate', 'Access-Control-Allow-Origin'=> '*' ],
- [ JSON::PP::encode_json($html) ]
- ];
-}
-
-
-sub userenv() {
- my $self = shift;
- my $env = shift;
- my $html->{result} = ();
- my $ct="application/json";
- my $status=200;
-
- my $req = Plack::Request->new($env);
- foreach my $k (keys(%ENV)){
- $html->{result}->{$k} = $ENV{$k};
- }
-
- return [
- 200,
- [ 'Content-Type' => $ct,'Cache-Control' => 'no-store, no-cache, must-revalidate', 'Access-Control-Allow-Origin'=> '*' ],
- [ JSON::PP::encode_json($html) ]
- ];
-}
-
-#sub filedialog() {
-# my $self = shift;
-# my $env = shift;
-# my $html->{result} = ();
-# my $ct="application/json";
-# my $status=200;
-# my $req = Plack::Request->new($env);
-#
-# if ($^O eq "MSWin32"){
-# my $multisel = 0;
-# if (exists($req->query_parameters->{multisel})){
-# $multisel = $req->query_parameters->{multisel};
-# }
-# my $title = "select file";
-# if (exists($req->query_parameters->{title})){
-# $title = $req->query_parameters->{title};
-# }
-# my $lastdir = $ENV{USERPROFILE};
-# if (exists($req->query_parameters->{dir})){
-# $lastdir = $req->query_parameters->{dir}
-# }
-# my @filters = ['All Files - *', '*'];
-# if(exists($req->query_parameters->{filters})){
-# unshift(@filters,$req->query_parameters->{filters});
-# }
-# my ( @file);
-# my ( @parms );
-# push (@parms,-filter => @filters,-directory => $lastdir,-title => $title,-multisel => $multisel,-filemustexist => 1,-pathmustexist => 1,);
-# @file = Win32::GUI::GetOpenFileName ( @parms );
-# $html->{result}->{files} = \@file;
-# }
-# return [
-# 200,
-# [ 'Content-Type' => $ct,'Cache-Control' => 'no-store, no-cache, must-revalidate', 'Access-Control-Allow-Origin'=> '*' ],
-# [ JSON::PP::encode_json($html) ]
-# ];
-#}
-1;
\ No newline at end of file
+++ /dev/null
-package Module::Test;
-
-use strict;
-use warnings;
-use parent qw(Plack::Component);
-use Plack::Request;
-use Data::Dumper;
-
-sub call {
- my($self, $env) = @_;
- #$self->_app->($env);
- if (($env->{REMOTE_ADDR} =~ "^127\.0\.") &&
- ($env->{REMOTE_ADDR} =~ "^10\.") &&
- ($env->{REMOTE_ADDR} =~ "^172\.16\.") &&
- ($env->{REMOTE_ADDR} =~ "^192\.168\.")) {
- return [
- 404,
- [ 'Content-Type' => "text/html",'Cache-Control' => 'no-store, no-cache, must-revalidate' ],
- [ "Sorry no remote access allowed!" ]
- ];
- }
- return $self->test($env);
-}
-
-sub test(){
- my $self = shift;
- my $env = shift;
- my $html = "";
- my $ct="application/json";
- my $status=200;
- my $request = Plack::Request->new($env);
- $html .= "<h1>System Environement</h1>";
- foreach my $k (keys(%ENV)){
- $html.= '<strong>'.$k.':</strong>'.$ENV{$k}."<br/>\n";
- }
- $html .= "<h1>Request Header</h1>";
- foreach my $k (keys(%{$env})){
- $html .= '<strong>'.$k.':</strong>'.$env->{$k}."<br/>\n";
- }
- $html .= "<h1>GET PARAMETERS</h1>";
- $html .= Dumper($request->query_parameters);
- $html .= "<h1>POST PARAMETERS</h1>";
- $html .= Dumper($request->body_parameters);
- print "Test Called!\n";
- return [
- 200,
- [ 'Content-Type' => "text/html",'Cache-Control' => 'no-store, no-cache, must-revalidate' ],
- [ $html ]
- ];
-};
-
-
-1;
\ No newline at end of file
+++ /dev/null
-#!/usr/bin/perl
-use strict;
-use File::Basename;
-use Getopt::Long;
-use Win32::file;
-use Win32::GUI;
-use Data::Dumper;
-# A simple open file with graphic filers
-my $lastfile;
-my ( @file, $file );
-my ( @parms );
-push @parms,
- -filter =>
- [
- 'All Files - *', '*'
- ],
- -directory => "c:\\program files",
- -title => 'Select a file';
-push @parms, -file => $lastfile if $lastfile;
-@file = Win32::GUI::GetOpenFileName ( @parms );
-print Dumper(@file);
\ No newline at end of file
+++ /dev/null
-package pgsql;
-use strict;
-#use lib ($ENV{HOME}.'/perl5/lib/perl5');
-use DBI;
-use DBD::PgPP;
-use Encode;
-use JSON;
-
-sub new {
- my $class = shift;
- my $p = shift;
- my $self = bless {}, $class;
-# my $strconn = "";
-# $self->{host} = $p->{host};
-# $self->{dbname} = $p->{db};
-# $self->{dbuser} = $p->{user};
-# $self->{dbpassword} = $p->{pwd};
- $self->connect($p->{host},$p->{db},$p->{user},$p->{pwd});
- return $self;
-}
-
-
-sub connect(){
- my $self = shift;
- my $host = shift;
- my $dbname = shift;
- my $dbuser = shift;
- my $dbpwd = shift;
- $self->{dbh} = DBI->connect('DBI:PgPP:dbname='.$dbname.';host='.$host,$dbuser,$dbpwd,{PrintError=>1,RaiseError=>1,AutoCommit=>1}) or return "Connection Error";
-}
-
-sub disconnect(){
- my $self = shift;
- $self->{dbh}->disconnect();
-}
-
-sub reconnect(){
- my $self = shift;
- my $host = shift;
- my $dbname = shift;
- my $dbuser = shift;
- my $dbpwd = shift;
- $self->{dbh}->disconnect();
- $self->connect($host,$dbname,$dbuser,$dbpwd);
-}
-
-sub strreplace(){
- my $self = shift;
- my $text = shift;
- $text =~ s/'/''/g;
- return $text;
-}
-
-sub dbquery(){
- my $self = shift;
- my $key = shift;
- my $stat = shift;
- #my $retempty = shift;
- my $retdata =();
- $stat = encode("utf8", $stat);
- my $sth = $self->{dbh}->prepare($stat);
- $sth->execute() or return '{"ERROR":"'.$self->{dbh}->errstr.'"}';
- while(my $data = $sth->fetchrow_hashref())
- {
- if (exists $data->{$key}){
- foreach my $k (keys %{$data}){
- $retdata->{$data->{$key}}{$k} = encode("utf8", $data->{$k});
- }
- }
- }
-
- $sth->finish();
- return $retdata;
-}
-
-sub dbqueryarray(){
- my $self = shift;
- my $stat = shift;
- my $retdata = ();
- $stat = encode("utf8", $stat);
- my $sth = $self->{dbh}->prepare($stat) or return "Failed prepare: ".$stat;
- $sth->execute() or return "dbquery: ".$sth->errstr;
- my $count = 0;
- while(my $data = $sth->fetchrow_hashref())
- {
- my $ret = {};
- foreach my $k (keys %{$data}){
- $ret->{$k} = $data->{$k};
- }
- push @{$retdata},$ret;
- }
-
- $sth->finish();
-
- return $retdata;
-}
-
-sub dbquerysorted(){
- my $self = shift;
- my $stat = shift;
- my $retdata = ();
- $stat = encode("utf8", $stat);
-
- my $sth = $self->{dbh}->prepare($stat);
-
- $sth->execute() or return '{"ERROR":"'.$self->{dbh}->errstr.'"}';
- my $count = 0;
- while(my $data = $sth->fetchrow_hashref())
- {
- foreach my $k (keys %{$data}){
- $retdata->{$count}->{$k} = encode("utf8", $data->{$k});
- }
- $count++;
- }
-
- $sth->finish();
- return $retdata;
-}
-
-sub dbexec(){
- my $self = shift;
- my $stat = shift;
- my %retdata;
- $stat = encode("utf8", $stat);
- my $sth = $self->{dbh}->prepare($stat);
- my $rv = $self->{dbh}->do($stat) or return '{"ERROR":"'.$self->{dbh}->errstr.'"}';
- return $rv;
-}
-
-#sub getnextsequence(){
-# my $self = shift;
-# my $table= shift;
-# my $dbh = DBI->connect('DBI:Pg:dbname='.$self->{dbname}.';host='.$self->{host},$self->{dbuser},$self->{dbpassword},{PrintError=>1,RaiseError=>1,AutoCommit=>1}) or die "dbexec Connection Error!".$!;
-# my $stat = 'select nextval(\''.$table.'_id_seq\')';
-# $stat = encode("utf8", $stat);
-# my $sth = $dbh->prepare($stat);
-# $sth->execute() or die "getnextsequence: ".$sth->errstr;
-# my $val = 0;
-# while(my $data = $sth->fetchrow_hashref())
-# {
-# $val = $data->{'nextval'};
-# }
-# return $val;
-#}
-
-1;
+++ /dev/null
-#!/usr/bin/perl
-
-use strict;
-use CGI;
-use CGI::Carp qw/fatalsToBrowser/;
-use File::Basename;
-use lib (dirname($0));
-use pgsql;
-use utf8;
-use JSON;
-use POSIX 'strftime';
-
-my $param = ();
-my @p = $cgi->param();
-foreach my $pe (@p){
- $param->{$pe} = $cgi->param($pe);
-}
-my $cgi = new CGI();
+++ /dev/null
-#!C:\strawberry\perl\bin\perl.exe
-use strict;
-use PDF::API2;
-my @pdf_files = ('invJanvier.1.pdf',
-'invJanvier.2.pdf',
-'invJanvier.3.pdf',
-'invJanvier.4.pdf',
-'invJanvier.5.pdf',
-'invJanvier.6.pdf',
-'invJanvier.7.pdf',
-'invJanvier.8.pdf',
-'invJanvier.9.pdf',
-'invJanvier.10.pdf',
-'invJanvier.12.pdf',
-'invJanvier.13.pdf',
-'invJanvier.14.pdf',
-'invJanvier.15.pdf',
-'invJanvier.17.pdf',
-'invJanvier.18.pdf',
-'invJanvier.19.pdf',
-'invJanvier.20.pdf',
-'invJanvier.21.pdf',
-'invJanvier.22.pdf',
-'invJanvier.23.pdf',
-'invJanvier.24.pdf',
-'invJanvier.25.pdf',
-'invJanvier.26.pdf',
-'invJanvier.27.pdf',
-'invJanvier.28.pdf',
-'invJanvier.29.pdf',
-'invJanvier.30.pdf',
-'invJanvier.31.pdf',
-'invJanvier.32.pdf',
-'invJanvier.34.pdf',
-'invJanvier.35.pdf',
-'invJanvier.36.pdf',
-'invJanvier.37.pdf',
-'invJanvier.38.pdf',
-'invJanvier.39.pdf',
-'invJanvier.40.pdf',
-'invJanvier.41.pdf',
-'invJanvier.42.pdf',
-'invJanvier.43.pdf',
-'invJanvier.46.pdf',
-'invJanvier.47.pdf',
-'invJanvier.48.pdf',
-'invJanvier.49.pdf',
-'invJanvier.50.pdf',
-'invJanvier.53.pdf',
-'invJanvier.55.pdf',
-'invJanvier.56.pdf',
-'invJanvier.57.pdf',
-'invJanvier.60.pdf',
-'invJanvier.61.pdf',
-'invJanvier.62.pdf',
-'invJanvier.63.pdf',
-'invJanvier.64.pdf',
-'invJanvier.65.pdf',
-'invJanvier.66.pdf',
-'invJanvier.67.pdf',
-'invJanvier.69.pdf',
-'invJanvier.70.pdf',
-'invJanvier.71.pdf',
-'invJanvier.72.pdf',
-'invJanvier.73.pdf',
-'invJanvier.74.pdf');
-chdir("C:\\Users\\ksaff\\DKS\\projects\\Creorga\\Calimero\\20170302\\diff\\imports\\5531423c-b85a-4305-9372-c62a293d0c84");
-my $big_pdf = PDF::API2->new(-file => 'Janvier.pdf');
-foreach my $source_pdf (@pdf_files){
- my $pds;
- eval { $pds = PDF::API2->open( $source_pdf ) };
- if ($@) { next; }
- my $pn = $pds->pages;
- $big_pdf->importpage($pds,$_) for 1..$pn;
- }
-$big_pdf->saveas;
-$big_pdf->end;
-
-
-
+++ /dev/null
-#!/usr/bin/perl
-
-use strict;
-use POSIX 'strftime';
-
-print strftime('%d.%m.%Y %H:%M:%S',localtime());
\ No newline at end of file
+++ /dev/null
-package localconfig;
-
-use strict;
-use File::Basename;
-#use lib ($ENV{HOME}.'/perl5/lib/perl5');
-use JSON;
-
-sub new {
- my $class = shift;
- my $p = shift;
- my $self = bless {}, $class;
- if (!defined($p) || ($p eq "") || (! -e $p)){
- if ($^O eq "MSWin32"){
- $self->{cfgfile} = $ENV{APPDATA}.'/DKS/localserver.conf';
- } else {
- $self->{cfgfile} = $ENV{HOME}.'/Library/Application Support/DKS/localserver.conf';
- }
- }else {
- $self->{cfgfile} = $p;
- }
-
- return $self;
-}
-
-sub readconfig(){
- my $self = shift;
- my $strcfg = "";
- if (! -d dirname($self->{cfgfile})){
- mkdir(dirname($self->{cfgfile}))
- }
- if (! -e $self->{cfgfile}){
- open(CFG,">".$self->{cfgfile});
- close(CFG);
- }
- open(CFG,$self->{cfgfile});
- while (my $l = <CFG>){
- $strcfg .= $l;
- }
- close(CFG);
- return JSON::from_json($strcfg);
-}
-
-sub writeconfig(){
- my $self = shift;
-
-}
-
-1;
\ No newline at end of file
+++ /dev/null
-#!C:\Perl\bin\perl.exe
-
-use strict;
-use File::Basename;
-use Getopt::Long;
-use Data::Dumper;
-use utf8;
-use lib ('.');
-use sqlite;
-
-my $dbfile = "";
-my $templatedb = "";
-GetOptions("dbfile|db=s" => \$dbfile,
- "template|t=s" => \$templatedb
- );
-#-db "C:\\Test\\sqlite\\bas\\9475a95d-e2ad-4586-8432-d44a604b3fd3.sqlite" -t "C:\\Workspace\\creorga\\app\\defaults\\profile\\creorga.sqlite"
-
-sub getcoldef($){
- my $strddl = shift;
- my $curddl = $strddl;
- $curddl =~ s/\s+/\ /g;
- my $bi = index($curddl,'(')+1;
- my $ei = rindex($curddl,')');
-
- $curddl = substr($curddl,$bi,length($curddl)-$bi-(length($curddl)-$ei));#curddl.substring(curddl.indexOf('(')+1,curddl.lastIndexOf(')')).trim().replace(/\s+/g," ");
- my @colsfull = split(/,/,$curddl);# curddl =curddl.replace(new RegExp("\\b(" + appdb.keywords.join("|") + ")\\b", "g"), "");
- my $tblobj = ();
- foreach my $c (@colsfull){
- $c =~ s/^\s+//;
- $c =~ s/\s+$//;
- my @coldef = split(/\ /,$c);
- my $type = uc($coldef[1]);
- if (($type =~ /^TEXT/) || ($type =~ /^REAL/) || ($type =~ /^INTEGER/) || ($type =~ /^BOOLEAN/) || ($type =~ /^DATE/) || ($type =~ /^DATETIME/)) {
- $tblobj->{$coldef[0]} = $type;
- }
- }
- return $tblobj;
-}
-
-if ((! -e $dbfile) || (! -e $templatedb)) {
- print "incomplete input!\n";
- exit(1);
-}
-
-my $db = sqlite->new($templatedb);
-
-my $dbdefsql = "SELECT type, name,tbl_name,sql FROM sqlite_master order by name,tbl_name,type;";
-my $defdbschemacfg = $db->dbquerysorted($dbdefsql);
-#$db = undef;
-$db = sqlite->new($dbfile);
-my $tcurcfg = $db->dbquerysorted($dbdefsql);
-# var re = /(\w+).*,/;
-my $keycnt = keys(%{$defdbschemacfg});
-my $bvaccum = 0;
-my $stexec = 0;
-
-foreach my $pd (sort {$a <=> $b} keys(%{$defdbschemacfg})){
-
- if ($defdbschemacfg->{$pd}->{'type'} eq 'table') {
- my $bupdate = 0;
- my $bexists = 0;
- my $cucols = '';
- my $oldobj = ();
- foreach my $pc (keys(%{$tcurcfg})){
- if (($tcurcfg->{$pc}->{tbl_name} eq $defdbschemacfg->{$pd}->{tbl_name}) && ($tcurcfg->{$pc}->{type} eq $defdbschemacfg->{$pd}->{type})){
- print $defdbschemacfg->{$pd}->{type}.": ".$defdbschemacfg->{$pd}->{tbl_name}. "\n";
- if ($tcurcfg->{$pc}->{sql} ne $defdbschemacfg->{$pd}->{sql}){
- $bupdate = 1;
- $oldobj= getcoldef($tcurcfg->{$pc}->{sql});
- }
- $bexists = 1;
- last;
- }
- }
- if (($bexists==1) && ($bupdate== 1)){
- my $sql_installnew = $defdbschemacfg->{$pd}->{sql};
- my $newobj = getcoldef($defdbschemacfg->{$pd}->{sql});
- my @copycols = ();
- for my $x (keys(%{$newobj})){
- if (exists($oldobj->{$x})) {
- push @copycols,$x;
- }
- }
-
- my @ainssql = ();
- push(@ainssql,"DROP TABLE IF EXISTS new_".$defdbschemacfg->{$pd}->{tbl_name}. ";");
- my $sql_tmptbl = $sql_installnew;
- $sql_tmptbl =~ s/CREATE\ TABLE\ /CREATE TABLE new_/;
- $sql_tmptbl =~ s/"//g;
- push(@ainssql,$sql_tmptbl);
- push(@ainssql,"INSERT INTO new_".$defdbschemacfg->{$pd}->{tbl_name}." (".join(',',@copycols).") SELECT ".join(',',@copycols)." FROM ".$defdbschemacfg->{$pd}->{tbl_name}.";");
- push(@ainssql,"DROP TABLE ".$defdbschemacfg->{$pd}->{tbl_name}.";");
- push(@ainssql,"ALTER TABLE new_".$defdbschemacfg->{$pd}->{tbl_name}. " RENAME TO ".$defdbschemacfg->{$pd}->{tbl_name}.";");
- $bvaccum = 1;
- print Dumper(@ainssql);
- my $stexec = 0;
- for(my $s=0;$s<scalar(@ainssql);$s++){
- if (defined($stexec)) {
- #print $ainssql[$s]."\n";
- $stexec = $db->dbexec($ainssql[$s]);
- }
- }
- #print "tbl done\n";
- }
- elsif ($bexists == 0){
- my $sql_installnew = $defdbschemacfg->{$pd}->{sql};
- $db->dbexec($sql_installnew);
- }
-} elsif (($defdbschemacfg->{$pd}->{'type'} eq 'trigger') || ($defdbschemacfg->{$pd}->{'type'} eq 'index')) {
- my $bexists = 0;
- my $bupdate = 0;
- foreach my $pc (keys(%{$tcurcfg})){
- if (($tcurcfg->{$pc}->{tbl_name} eq $defdbschemacfg->{$pd}->{tbl_name}) && ($tcurcfg->{$pc}->{type} eq $defdbschemacfg->{$pd}->{type})){
- print $defdbschemacfg->{$pd}->{type}.": ".$defdbschemacfg->{$pd}->{tbl_name}. "\n";
- if ($tcurcfg->{$pc}->{sql} ne $defdbschemacfg->{$pd}->{sql}){
- $bupdate = 1;
- }
- $bexists = 1;
- last;
- }
- }
- if (($bexists==1) && ($bupdate== 1)){
- $bvaccum = 1;
- my @ainssql = ();
- if ($defdbschemacfg->{$pd}->{type} eq 'trigger'){
- push @ainssql,"DROP TRIGGER IF EXISTS ".$defdbschemacfg->{$pd}->{'name'}.";";
- } elsif ($defdbschemacfg->{$pd}->{type} eq 'index') {
- push @ainssql,"DROP INDEX IF EXISTS ".$defdbschemacfg->{$pd}->{'name'}.";";
- }
- push @ainssql,$defdbschemacfg->{$pd}->{'sql'};
- my $stexec = 0;
- for(my $s=0;$s<scalar(@ainssql);$s++){
- if (defined($stexec)) {
- #print $ainssql[$s]."\n";
- $stexec = $db->dbexec($ainssql[$s]);
- }
- }
- }elsif ($bexists == 0) {
- my $sql_installnew = $defdbschemacfg->{$pd}->{sql};
- #$tcurcfg->dbexec($sql_installnew);
- }
- }
-}
-# //dump("goto check defaults!\n");
-# appdb.check_defaultdata();
-if ($bvaccum == 1) {
- print "Exec vacuum;\n";
- $db->dbexec("vacuum;");
-}
-# check_defaultdata: function(){
-#
-# appdb.closeConnection();
-# //dump("Local DBFile: " + appdb.dbFile.path + "\n");
-# var tables = ['creche','groups','workinghours','vacancy','costs','planningtemplate'];
-# for (var t in tables) {
-# var sql = "select count(*) as cnt from "+ tables[t]+";";
-#
-# var res = appdb.dbquery(sql);
-#
-# if ((res) && (res.sqldata[0].cnt == '0')) {
-# dump(sql + " --> "+JSON.stringify(res)+ "\n");
-# var inssql = [];
-# if (tables[t] == 'creche') {
-# inssql.push("INSERT INTO creche (crechename, adress, city, country, zip, maxchilds, uuid, minage, maxage) VALUES ('"+curcfg.name+"', '', '', 'Luxembourg', '', 28, '"+ curcfg.uuid +"', 2, 84);");
-# } else if (tables[t] == 'groups') {
-# var sinssql = "INSERT INTO groups (grpname, maxchilds, minage, maxage, uuid) VALUES ";
-# sinssql += "('Groupe Bébé', 6, 2, 12, '"+ appdb.generate_uuid() +"'),";
-# sinssql += "('Groupe plus 1 an ', 6, 12, 24, '"+ appdb.generate_uuid() +"'),";
-# sinssql += "('Groupe de 2 ans à 3 ans', 8, 24, 36, '"+ appdb.generate_uuid() +"'),";
-# sinssql += "('Groupe de 3 à 4 ans ', 8, 36, 48, '"+ appdb.generate_uuid() +"'),";
-# sinssql += "('Groupe plus 4 ans ( Scolaires)', 11, 48, 84, '"+ appdb.generate_uuid() +"');"
-# inssql.push(sinssql);
-# } else if (tables[t] == 'workinghours') {
-# inssql.push("INSERT INTO workinghours (uuid, datestart, montimeopen, montimeclose, tuetimeopen, tuetimeclose, wedtimeopen, wedtimeclose, thutimeopen, thutimeclose, fritimeopen, fritimeclose, sattimeopen, sattimeclose, suntimeopen, suntimeclose, crecheuuid) VALUES ('"+appdb.generate_uuid()+"', strftime(\"%Y\",date('now','-1 year')) || '-01-01', '07:00', '19:00', '07:00', '19:00', '07:00', '19:00', '07:00', '19:00', '07:00', '19:00', null, null, null, null, '"+ curcfg.uuid+"');");
-#
-# } else if (tables[t] == 'costs') {
-# var sinssql = "INSERT INTO costs (startdate, costsperhour, weeklyhourslimit, dailylunchcosts, uuid) VALUES ";
-# sinssql += "('2015-01-01', 0.0, 0.0, 0.0, '"+ appdb.generate_uuid()+"');";
-# inssql.push(sinssql);
-# } else if (tables[t] == 'planningtemplate') {
-# //dump("Planningtemplate\n");
-# var sinssql = "INSERT INTO planningtemplate (uuid, montimebegin, montimeend, monlunch, tuetimebegin, tuetimeend, tuelunch, wedtimebegin, wedtimeend, wedlunch, thutimebegin, thutimeend, thulunch, fritimebegin, fritimeend, frilunch, templatename) VALUES ";
-# sinssql += "('"+ appdb.generate_uuid()+"', '08:00', '18:00', 1, '08:00', '18:00', 1, '08:00', '18:00', 1, '08:00', '18:00', 1, '08:00', '18:00',1, 'plain temps (60h)'),";
-# sinssql += "('"+ appdb.generate_uuid()+"', '08:00', '13:00', 1, '08:00', '13:00', 1, '08:00', '13:00', 1, '08:00', '13:00', 1, '08:00', '13:00',1,'matin (30h)'),";
-# sinssql += "('"+ appdb.generate_uuid()+"', '13:00', '18:00', 1, '13:00', '18:00', 1, '13:00', '18:00', 1, '13:00', '18:00', 1, '13:00', '18:00',1, 'après-midi (30h)');";
-# inssql.push(sinssql);
-# //dump(inssql + "\n");
-# }
-# for (var i in inssql){
-# appdb.dbexec_silent(inssql[i]);
-# }
-# //dump("Set default Data:" + inssql + "\n");
-#
-# }
-# }
-# }
-
+++ /dev/null
-#!C:\Strawberry\bin\perl.exe
-
-use strict;
-use PDF::API2;
-use Getopt::Long;
-use File::Basename;
-use File::Path qw/make_path/;
-use Data::Dumper;
-use File::Copy qw/copy/;
-use lib('.');
-use sqlite;
-use utf8;
-my $dbfile="";
-my $pdffile="";
-my $outputdir="";
-my $toolsdir="";
-my $delorig=0;
-my $totext =1;
-my $template = "";
-my $log ="";
-my $db = undef;
-my $cmonth = "none";
-my $frmonth = {"Janvier" => '01',"Février"=> '02',"Mars" => '03',"Avril" => '04', "Mai" => '05',"Juin" => '06',"Juillet" => '07',"Août" => '08',"Septembre" => '09',"Octobre" => '10',"Novembre" => '11',"Décembre" => '12'};
-
-GetOptions("dbfile|db=s" => \$dbfile,
- "pdf|p=s" => \$pdffile,
- "outdir|o=s" => \$outputdir,
- "toolsdir|t=s" => \$toolsdir,
- "type|x=s" => \$template, #template => [inv|stmt]
- "log|l=s" => \$log
- );
-my $sep = '/';
-$toolsdir = dirname($0);
-open(LOG,">>".$log);
-print LOG "DB:".$dbfile."\r\n";
-print LOG "PDF:".$pdffile."\r\n";
-print LOG "OUTPUTDIR:".$outputdir."\r\n";
-#print LOG "TOOLSDIR:".$toolsdir."\r\n";
-print LOG "TEMPLATE:".$template."\r\n";
-print LOG "LOG:".$log."\r\n";
-close(LOG);
-my $pdftotext = "";
-if ($^O eq "MSWin32") {
- $sep = "\\";
- $pdftotext=$toolsdir.$sep.'pdftotext.exe';
-}else {
- $pdftotext=$toolsdir.$sep.'pdftotext';
-}
-#if ($toolsdir eq "") {
-
-#}
-
-if (($log ne "") && (! -e $log)){
- open(LOG,">".$log);
- close(LOG);
-}
-
-#my $filename = "C:\\projects\\creorga\\calimero\\factures201512.pdf";
-if (! -d $outputdir) {
- make_path($outputdir);
-}
-if (! -e $pdftotext) {
- $totext = 0;
-}
-
-
-if ((! -e $dbfile) || (! -e $pdffile) || (! -d $outputdir) || (! -d $toolsdir)) {
- open(LOG,">>".$log);
- print LOG localtime().":ERROR:incomplete input!\n";
- close(LOG);
- exit(1);
-}
-
-print "1: Split du PDF en pages!\r\n";
-my $oldpdf = PDF::API2->open($pdffile);
-#1.split pdffile
-$template = lc($template);
-my @nfiles = ();
-my $xx = $oldpdf->pages;
-for my $page_nb (1..$xx) {
- my $newpdf = PDF::API2->new;
- my $page = $newpdf->importpage($oldpdf, $page_nb);
- my $npdfname = $outputdir.'/'.$template.substr(basename($pdffile),0,-4).".".$page_nb.".pdf";
- push @nfiles,$npdfname;
- if (-e $npdfname){
- unlink($npdfname);
- }
- $newpdf->saveas($npdfname);
-}
-#2.convert pdftotxt & get data
-if (-e $dbfile) {
- #$dbfile =~ s/\\\\/\\/g;
- $db = sqlite->new($dbfile);
-}
-if ($totext == 1) {
- foreach my $n (@nfiles){
- if (-e $n.'.txt'){
- unlink($n.'.txt');
- }
- unlink($n.'.txt');
- print "Lire des donnees de la page: ".basename($n)."\n";
-
- my $cmd = '"'.$pdftotext.'" -q -table -eol unix "'.$n.'" "'.$n.'.txt"';
- my $st = system($cmd);
- if (($st == 0) && (-e "$n.txt")){
- my @pdata = ();
- open(PDFDATA,"$n.txt");
- while (my $l = <PDFDATA>) {
- chomp($l);
- if ($l ne "") {
- push @pdata,$l;
- }
- }
- close(PDFDATA);
- if (lc($template) eq "inv") {
- my $childdata = &parseinvoicedata(\@pdata);
- print "Import des donnees Check-Service No.: ".$childdata->{checkservice}."\n";
- &importinvoicedata($childdata,$n);
- }elsif (lc($template eq "stmt")){
- my $stmtdata = &parsestatementdata(\@pdata);
- print "Import des données Page: ".basename($n)."\n";
- &importstatementdata($stmtdata,$n);
- }
- unlink("$n.txt");
- }
- }
-}
-
-sub parseinvoicedata(){
- my $tmpdata = shift;
- my @invoicedata = @{$tmpdata};
- my $pxdata = ();
- foreach my $p (@invoicedata){
- if ($p =~ /N. Facture/) {
- my ($tmp) = $p =~ m/.+\s(\d{4,}.\d{1,2}.\d{4,})\s.+$/;
- $pxdata->{reference} = $tmp;
- }
- if ($p =~ /Date de la/) {
- my ($d,$m,$y) = $p =~ m/.+\s(\d{1,2}).(\d{1,2}).(\d{4,})$/;
- if (length($d) == 1) { $d = "0".$d;}
- if (length($m) == 1) { $m = "0".$m;}
- $pxdata->{invoicedate} = $y.'-'.$m.'-'.$d;
- }
- if (($p =~ /facture/) && ($pxdata->{invoicedate} eq "--")) {
- my ($d,$m,$y) = $p =~ m/.+\s(\d{1,2}).(\d{1,2}).(\d{4,})$/;
- if (length($d) == 1) { $d = "0".$d;}
- if (length($m) == 1) { $m = "0".$m;}
- $pxdata->{invoicedate} = $y.'-'.$m.'-'.$d;
- }
- if ($p =~ /Carte N./) {
- my ($tmp) = $p =~ m/.+\s(\d+)$/;
- $pxdata->{checkservice} = $tmp;
- }
- if ($p =~ /Heure/) {
- my ($tmp1,$tmp2) = $p =~ m/.+\s(\d+).(\d+)+$/;
- $pxdata->{hoursamount} = $tmp1.'.'.$tmp2;
- }
- if ($p =~ /Repas/) {
- my ($tmp1,$tmp2) = $p =~ m/.+\s(\d+).(\d+)+$/;
- $pxdata->{lunchamount} = $tmp1.'.'.$tmp2;
- }
- if ($p =~ /Montant\s.\spayer/) {
- my ($tmp1,$tmp2) = $p =~ m/.+\s(\d+).(\d+)+$/;
- $pxdata->{totalamount} = $tmp1.'.'.$tmp2;
- }
- #print Dumper(@pdata);
- }
- return $pxdata;
-}
-
-sub parsestatementdata(){
- my $tmpdata = shift;
- my @xstmtdata = @{$tmpdata};
- my $sxdata = ();
-
- foreach my $p (@xstmtdata){
- if ($p =~ /P.riode/) {
- my ($m1,$y1,$m2,$y2) = $p =~ m/.+\s(.+)\s+(\d+)\s+.\s+(.+)\s+(\d+)$/;
- if (($m1 eq $m2) && ($y1 eq $y2)){
- $cmonth=$y1.'-'.$frmonth->{$m1};
- }
- }
- if ($p =~ /\d{13,}/) {
- my ($csnum,$am) = $p =~ m/.+\s+(\d{13,})\s+([\d|\ |,]+)$/;
- $am =~ s/\s+//;
- $am =~ s/,/./;
- $sxdata->{$cmonth}->{$csnum}=$am;
- }
- #print $p."\n";
- }
- return $sxdata;
-}
-
-sub importinvoicedata(){
- my $impdata = shift;
- my $fname = shift;
- if (defined($db)){
- my $child = $db->dbquerysorted("select uuid from childs where replace(checkservicenumber,' ','') = '".$impdata->{checkservice}."';");
- if (keys(%{$child}) == 1) {
- my @refx = split(/\./,$impdata->{reference});
- if (length($refx[1]) == 1) {
- $refx[1] = '0'.$refx[1];
- }
- my $accdata = $db->dbquerysorted("select accmonth,childuuid from accounting where childuuid='".$child->{0}->{uuid}."' and accmonth=date('".$refx[0].'-'.$refx[1]."-01');");
-
- if (keys(%{$accdata}) == 1) {
- #make update
- my @upd = ();
- if (exists($impdata->{reference})) {
- push @upd,"reference='".$impdata->{reference}."'";
- my $nfname = dirname($fname).$sep.$template.'_'.$impdata->{checkservice}.'_'.$impdata->{reference}.".pdf";
- if (-e $nfname){
- unlink($nfname);
- }
- copy($fname,$nfname);
- print "Copy file to new name: ".$nfname."\n";
- my $insfname = basename($nfname);
- if (-e $nfname){
- unlink($fname);
- print "remove file: ".$fname."\n";
- } else{
- $insfname = basename($fname);
- }
- #rename($fname,$nfname);
- push @upd,"invoicefile='".$insfname."'";
- }
- if (exists($impdata->{totalamount})) {
- push @upd,"invoiceamount=".$impdata->{totalamount}."";
- }
- if (exists($impdata->{invoicedate})) {
- push @upd,"invoicedate=date('".$impdata->{invoicedate}."')";
- }
- my $sql = "update accounting set ".join(',',@upd)." where childuuid='".$child->{0}->{uuid}."' and accmonth=date('".$refx[0].'-'.$refx[1]."-01');";
- #print $sql."\n";
- my $r = $db->dbexec($sql);
-
- if (($log ne "") && (-e $log)){
- if (!defined($r)) {
- open(LOG,">>".$log);
- print LOG localtime().":ERROR:".$sql."\n";
- close(LOG);
- } else {
- open(LOG,">>".$log);
- print LOG localtime().":SUCCESS:".$sql."\n";
- close(LOG);
- }
- }
- }else {
- my @ins1 = ();
- my @ins2 = ();
- if (exists($impdata->{invoicedate}) && (length($impdata->{invoicedate})== 10 )){
- #my @refx = split(/\./,$impdata->{reference});
- #if (length($refx[1]) == 1) {
- # $refx[1] = '0'.$refx[1];
- #}
- push(@ins1,"accmonth");push (@ins2,"date('".$refx[0].'-'.$refx[1]."-01')");
- push(@ins1,"childuuid");push (@ins2,"'".$child->{0}->{uuid}."'");
- push(@ins1,"invoicedate");push (@ins2,"date('".$impdata->{invoicedate}."')");
- if (exists($impdata->{totalamount})) {
- push(@ins1,"invoiceamount");push (@ins2,"".$impdata->{totalamount}."");
- }
- if (exists($impdata->{reference})) {
- push(@ins1,"reference");push (@ins2,"'".$impdata->{reference}."'");
- my $nfname = dirname($fname).$sep.$template.'_'.$impdata->{checkservice}.'_'.$impdata->{reference}.".pdf";
- if (-e $nfname){
- unlink($nfname);
- }
- rename($fname,$nfname);
-
- push(@ins1,"invoicefile");push (@ins2,"'".basename($nfname)."'");
- }
- }
- #accmonth,childuuid,invoicedate,invoiceamount,reference
- my $sql = "insert into accounting (".join(',',@ins1).") VALUES (".join(',',@ins2).");";
- #print $sql."\n";
- my $r = $db->dbexec($sql);
- if (($log ne "") && (-e $log)){
- if (!defined($r)) {
- open(LOG,">>".$log);
- print LOG localtime().":ERROR:".$sql."\n";
- close(LOG);
- } else {
- open(LOG,">>".$log);
- print LOG localtime().":SUCCESS:".$sql."\n";
- close(LOG);
- }
- }
-
- }
- }
- }
-}
-
-sub importstatementdata(){
- my $simpdata = shift;
- my $fname = shift;
- #print Dumper($simpdata);
- my $n=0;
- foreach my $m (keys(%{$simpdata})){
- $n++;
- if (-e dirname($fname).$sep."prestation.".$m."-".$n.".pdf"){
- unlink(dirname($fname).$sep."prestation.".$m."-".$n.".pdf");
- }
- rename($fname,dirname($fname).$sep."prestation.".$m."-".$n.".pdf");
- foreach my $csnum (keys(%{$simpdata->{$m}})){
- $simpdata->{$m}->{fnum} = $n;
- }
- }
- foreach my $m (keys(%{$simpdata})){
- $n++;
- if ($m =~ /\d{4,}-\d{2,}/) {
- foreach my $csnum (keys(%{$simpdata->{$m}})){
- print "Import Check-Service no: " + $csnum + "\n";
- if (defined($db)){
- my $child = $db->dbquerysorted("select uuid from childs where replace(checkservicenumber,' ','') = '".$csnum."';");
- if (keys(%{$child}) == 1) {
- my $accdata = $db->dbquerysorted("select accmonth,childuuid from accounting where childuuid='".$child->{0}->{uuid}."' and accmonth=date('".substr($m,0,4).'-'.substr($m,5,2)."-01');");
- if (keys(%{$accdata}) == 1) {
- #make update
- my @upd = ();
- push @upd,"benefitamount='".$simpdata->{$m}->{$csnum}."'";
- push @upd,"benefitfile='prestation.".$m."-".$simpdata->{$m}->{fnum}.".pdf'";
- my $sql = "update accounting set ".join(',',@upd)." where childuuid='".$child->{0}->{uuid}."' and accmonth=date('".substr($m,0,4).'-'.substr($m,5,2)."-01');";
- #print $sql."\n";
- my $r = $db->dbexec($sql);
- if (($log ne "") && (-e $log)){
- if (!defined($r)) {
- open(LOG,">>".$log);
- print LOG localtime().":ERROR:".$sql."\n";
- close(LOG);
- } else {
- open(LOG,">>".$log);
- print LOG localtime().":SUCCESS:".$sql."\n";
- close(LOG);
- }
- }
- }else {
- my @ins1 = ();
- my @ins2 = ();
- push(@ins1,"accmonth");push (@ins2,"date('".substr($m,0,4).'-'.substr($m,5,2)."-01')");
- push(@ins1,"childuuid");push (@ins2,"'".$child->{0}->{uuid}."'");
- push(@ins1,"benefitamount");push (@ins2,"".$simpdata->{$m}->{$csnum}."");
- push(@ins1,"benefitfile");push (@ins2,"'prestation.".$m."-".$simpdata->{$m}->{fnum}.".pdf'");
-
- #accmonth,childuuid,invoicedate,invoiceamount,reference
- my $sql = "insert into accounting (".join(',',@ins1).") VALUES (".join(',',@ins2).");";
- #print $sql."\n";
- my $r = $db->dbexec($sql);
- if (($log ne "") && (-e $log)){
- if (!defined($r)) {
- open(LOG,">>".$log);
- print LOG localtime().":ERROR:".$sql."\n";
- close(LOG);
- } else {
- open(LOG,">>".$log);
- print LOG localtime().":SUCCESS:".$sql."\n";
- close(LOG);
- }
- }
- }
- }
- }
- }
- }
- }
-}
\ No newline at end of file
+++ /dev/null
-package sqlite;
-use strict;
-use DBI;
-use DBD::SQLite;
-use Encode;
-use File::Basename;
-
-sub new {
- my $class = shift;
- my $p = shift;
- my $self = bless {}, $class;
- $self->{dbfile} =$p;
- return $self;
-}
-
-sub strreplace(){
- my $self = shift;
- my $text = shift;
- $text =~ s/'/''/g;
- return $text;
-}
-
-sub dbquery(){
- my $self = shift;
- my $key = shift;
- my $stat = shift;
- my $retdata =();
- my $dbh = DBI->connect('DBI:SQLite:dbname='.$self->{dbfile},"","",{PrintError=>1,RaiseError=>1,AutoCommit=>1}) or die "dbquery Connection Error!".$!;
- $stat = encode("utf8", $stat);
-
- #open FILE,">>/tmp/sql.log";
- # print FILE "key:".$key.";$stat\n";
- # close FILE;
- my $sth = $dbh->prepare($stat);
- $sth->execute() or print "dbquery: ".$sth->errstr;
- while(my $data = $sth->fetchrow_hashref())
- {
- if (exists $data->{$key}){
- foreach my $k (keys %{$data}){
- $retdata->{$data->{$key}}{$k} = $data->{$k};
- }
- }
- }
- if (keys(%{$retdata}) == 0){
- $retdata =();
- }
- $sth->finish();
- $dbh->disconnect();
- return $retdata;
-}
-
-sub dbquerysorted(){
- my $self = shift;
- my $stat = shift;
- my $retdata = ();
- my $dbh = DBI->connect('DBI:SQLite:dbname='.$self->{dbfile},"","",{PrintError=>1,RaiseError=>1,AutoCommit=>1}) or die "dbquery Connection Error!".$!;
- $stat = encode("utf8", $stat);
- #open FILE,">>/tmp/sql.log";
- #print "$stat\n";
- # close FILE;
- my $sth = $dbh->prepare($stat);
-
- $sth->execute() or print "dbquery: ".$sth->errstr;
- my $count = 0;
- while(my $data = $sth->fetchrow_hashref())
- {
- foreach my $k (keys %{$data}){
- $retdata->{$count}->{$k} = $data->{$k};
- }
- $count++;
- }
-
- $sth->finish();
- $dbh->disconnect();
- #%retdata = sort {$a <=> $b} keys %retdata;
- return $retdata;
-}
-
-sub dbexec(){
- my $self = shift;
- my $stat = shift;
- my $dbh = DBI->connect('DBI:SQLite:dbname='.$self->{dbfile},"","",{PrintError=>1,AutoCommit=>1}) or die "dbexec Connection Error!".$!;
- $stat = encode("utf8", $stat);
- #print $stat."\n";
- #open FILE,">>/Users/kilian/sql.log";
- #print FILE "$stat\n";
- #close FILE;
- my $sth = $dbh->prepare($stat);
- my $rv =$dbh->do($stat) or print "Failed dbexec:\n'".$stat. "'\n\n";
- $dbh->disconnect();
- return $rv;
-}
-
-
-#sub dbbackup(){
-# my $self = shift;
-# my $path = shift;
-# my $type = shift;
-#
-# my @dx = localtime();
-# $dx[5] = $dx[5] +1900;
-# $dx[4] = $dx[4] +1;
-# if ($dx[4] < 10){$dx[4] = '0'.$dx[4];}
-# if ($dx[3] < 10){$dx[3] = '0'.$dx[3];}
-# if ($dx[2] < 10){$dx[2] = '0'.$dx[2];}
-# if ($dx[1] < 10){$dx[1] = '0'.$dx[1];}
-# if ($dx[0] < 10){$dx[0] = '0'.$dx[0];}
-# my $xdd = $dx[5].$dx[4].$dx[3].'_'.$dx[2].$dx[1].$dx[0];
-# my $bfile = "";
-# if ($type eq "binary" ) {
-# $bfile = $path.'/'.basename(substr($self->{dbfile},0,rindex($self->{dbfile},'.'))).'_'.$xdd.'.sqlite';
-# my $dbh = DBI->connect('DBI:SQLite:dbname='.$self->{dbfile},"","",{PrintError=>1,RaiseError=>1,AutoCommit=>1}) or die "dbexec Connection Error!".$!;
-# $dbh->sqlite_backup_to_file($bfile);
-# $dbh->disconnect();
-# }elsif($type eq "sql"){
-# $bfile = $path.'/'.basename($self->{dbfile}).'_'.$xdd.'.sql';
-# my $st = system('sqlite3 "'.$self->{dbfile}.'" ".dump" > '.$bfile);
-# }
-# return $bfile;
-#}
-#
-#sub dbrestore(){
-# my $self = shift;
-# my $file = shift;
-# my $type = shift;
-# if ($type eq "binary" ) {
-# my $dbh = DBI->connect('DBI:SQLite:dbname='.$self->{dbfile},"","",{PrintError=>1,RaiseError=>1,AutoCommit=>1}) or die "dbexec Connection Error!".$!;
-# $dbh->sqlite_backup_from_file($file);
-# $dbh->disconnect();
-# }elsif($type eq "sql"){
-# open(REST,$file) or die "cannot open restore file $file!\n";
-# my $rsql = "";
-# while (my $l = <REST>) {
-# $rsql .= $l;
-# }
-# close(REST);
-# unlink($self->{dbfile});
-# $self->dbexec($rsql);
-# }
-#}
-#
-#sub dbrepair(){
-# my $self = shift;
-# my $bfile = $self->dbbackup($ENV{'TMPDIR'},'sql');
-# $self->dbrestore($bfile,'sql');
-# unlink($bfile);
-#}
-
-
-1;
+++ /dev/null
-#!C:\Strawberry\perl\bin\perl.exe
-
-use strict;
-use File::Basename;
-
-use Sys::Hostname;
-use File::Path qw/make_path remove_tree/;
-use lib (dirname($0));
-use sqlite;
-use Net::FTP;
-use Data::Dumper;
-my $cfg = ();
-my $profilepath = "";
-my $localhostname = hostname;
-my $ftp;
-if ($localhostname =~ /\./){
- $localhostname = substr($localhostname,0,index($localhostname,'.'));
-}
-
-if ($^O eq "MSWin32"){
- $profilepath = $ENV{APPDATA}."\\Creorga\\Profiles";
-}else {
- $profilepath = $ENV{HOME}."/Library/Application Support/Creorga/Profiles";
-}
-if (! -e $profilepath.'/sync.conf'){
- exit(0);
-}
-
-if (! -d $profilepath."/syncdown"){
- make_path($profilepath."/syncdown");
-}
-if (! -d $profilepath."/syncup"){
- make_path($profilepath."/syncup");
-}
-
-&readconfig();
-if (!exists($cfg->{LASTSYNCUP})){
- $cfg->{LASTSYNCUP} = 0;
- $cfg->{LASTSYNCDOWN} = 0;
- &writeconfig();
- }
-while(1){
- #compare variables lastsyncup,lastsyncdown
- my $t = opendir(SUPG,$profilepath."/syncup");
- &ftpconnect();
- while(my $dbdir = readdir(SUPG)){
- if ($dbdir =~ /^\./){next;}
- if (-d $profilepath."/syncup/".$dbdir){
- print $dbdir."\n";
- my $locallogs = &locallist($profilepath."/syncup/".$dbdir,".log");
- my $remotelogs = &ftplist($dbdir,".log");
- foreach my $f (keys(%{$locallogs})){
- if ($locallogs->{$f}->{size} > 0){
- if (!exists($remotelogs->{$f}) || ($remotelogs->{$f}->{size} < $locallogs->{$f}->{size})){
- print "Upload file:".$f."\n";
- my $res = &ftpsyncup($profilepath."/syncup/".$dbdir.'/'.$f);
- if ($res eq $f){
- unlink($profilepath."/syncup/".$dbdir.'/'.$f);
- }
- }
- } else {
- unlink($profilepath."/syncup/".$dbdir.'/'.$f)
- }
- }
- }
- }
- closedir(SUPG);
- opendir(SDOWNG,$profilepath."/syncdown");
- while(my $dbdir = readdir(SDOWNG)){
- if ($dbdir =~ /^\./){next;}
- if (-d $profilepath."/syncdown/".$dbdir){
- my $locallogs = &locallist($profilepath."/syncdown/".$dbdir,".log");
- my $remotelogs = &ftplist($dbdir,".log");
- foreach my $f (keys(%{$remotelogs})){
- if ( $f !~ /^$localhostname/){
- my @fnparts = split("_",substr($f,0,-4));
- if ($fnparts[1] > $cfg->{LASTSYNCDOWN}){
- &ftpsyncdown($f,$profilepath."/syncdown/".$dbdir.'/'.$f);
- }
- }
- }
- }
- }
- closedir(SDOWNG);
- &ftpdisconnect();
- opendir(SDOWNG,$profilepath."/syncdown");
- while(my $dbdir = readdir(SDOWNG)){
- if ($dbdir =~ /^\./){next;}
- if (-d $profilepath."/syncdown/".$dbdir){
- my $locallogs = &locallist($profilepath."/syncdown/".$dbdir,".log");
- foreach my $f (keys(%{$locallogs})){
- my @sqlcmd = "";
- open(DLOG,$profilepath."/syncdown/".$dbdir.'/'.$f);
- while (my $l = <DLOG>){
- chomp($l);
- my @pdat = split(";;",$l);
- if (($pdat[1] > $cfg->{LASTSYNCDOWN}) && ($pdat[2] eq $dbdir)){
- push(@sqlcmd,$pdat[3]);
- }
- }
- close(DLOG);
-
- }
- #get list of localfiles
- #foreach local syncdownfile
- #openfile
- #parse lines
- #if line timestamp > lastsyncdown then execute stamtement
- #set lastsyncdown to current timestamp
- #closefile
- #remove file
- }
- }
- closedir(SDOWNG);
- #foreach localsyncdownfiles
- #openfile
-# my @localsyncupfiles = File::Find::Rule... (with stat)
-#
-# get own remoteownsyncfiles with stat
-# foreach localsyncupfiles
-# if (!exists remotesynupfile or stat remotesynupfile ne stat localsyncupfile) and filename of localsyncup > lastsync
-# then upload
-# if uploaded then delete file -> keep only last (current)
-
-# get foreign remotesyncfiles with stat
-# if (foreign remotesyncfiles > lastsync)
-# download syncdownfile
-# ftp_disconnect
-# foreach foreign syncdownfile do
-# get sqls where lastsync > execdate
-# sqlhash -> db->file->num->sqlstmt
-# foreach sqls execute stmt
-# if stmt-file is executed then delete
-
-# #my $ftpopts = { Port => 21, Passive => 1 };
-# #my $ftp = Net::FTP->new($cfg->{HOST},%{$ftpopts}) or die "not correct host! $@\n";
-# #$ftp->login($cfg->{USER},$cfg->{PASSWORD}) or die "false login!\n";
-# #$ftp->binary();
-# #$ftp->pasv();
-# #remove all files from syncup
-# # find last tstmp from files in $profilepath."/syncup/"
-# # if lastparsed = "" then -> $lastparsed = $lastsync
-# #get syncup data
-# #remove_tree($profilepath."/syncup",{keep_root => 1});
-# opendir(SYUP,$profilepath);
-# while(my $d = readdir(SYUP)){
-# if ($d =~ /\d\d\d\d-\d\d-\d\d\.log$/){
-# my $lsync = ();
-# my $lcnt = 0;
-# open (LSYUP,$profilepath.'/'.$d);
-# while(my $l = <LSYUP>){
-# if ($l =~ /^SQL;;/){
-# chomp($l);
-# my @localdata = split(";;",$l);
-# if ($localdata[1] >= $cfg->{LASTSYNC}){
-# $lsync->{$localdata[2]}->{$lcnt} = $localdata[1].';;'.$localdata[3];
-# $lcnt++;
-# }
-# }
-# }
-# close(LSYUP);
-# foreach my $db (keys(%{$lsync})){
-# if (! -d $profilepath."/syncup/".$db){
-# make_path($profilepath."/syncup/".$db);
-# }
-# my $minsynctimestamp = "";
-# open(RSYNCUP,$profilepath."/syncup/".$db."/nextsync.txt");
-# my @csyncdata = ();
-# foreach my $dx (sort {$a cmp $b} keys(%{$lsync}->{$db})){
-# @csyncdata = split(";;",$lsync->{$db}->{$dx});
-# if ($minsynctimestamp eq ""){
-# $minsynctimestamp = split(";;",$lsync->{$db}->{$dx});
-# $minsynctimestamp =~ s/\ /_/;
-# }
-# print RSYNCUP $lsync->{$db}->{$dx}."\n";
-# }
-# if (scalar(@csyncdata) > 0){
-# $cfg->{LASTSYNC} = $csyncdata[0];
-# }
-#
-# close(RSYNCUP);
-# rename($profilepath."/syncup/".$db."/nextsync.txt",$profilepath."/syncup/".$db."/".$localhostname.'.'.$minsynctimestamp.".txt");
-# }
-# }
-# }
-# closedir(SYUP);
-# #get syncdown data
-# #if ($dld == 1) {
-# # $ftp->get($rpath,basename($rpath)) or die "cannot download file '".$rpath."'!\n";
-# #}elsif($upl == 1){
-# # $ftp->put($file,$rpath.'/'.basename($file)) or die "cannot upload file '".$file."'!\n";
-# #}
-# #print "File-transfer finished\n";
-# #$ftp->quit();
- sleep($cfg->{INTERVAL});
-}
-
-sub readconfig(){
- open(CFG,$profilepath.'/sync.conf');
- while (my $l = <CFG>){
- chomp($l);
- my ($k,$v) = $l =~ m/(.*)=(.*)$/;
- $cfg->{$k} = $v;
- }
- close(CFG);
- if (!exists($cfg->{INTERVAL}) || $cfg->{INTERVAL} gt "60"){
- $cfg->{INTERVAL} = "60";
- }
- if (-e $profilepath.'/lastsync.conf'){
- open(CFG2,$profilepath.'/lastsync.conf');
- while (my $l = <CFG2>){
- chomp($l);
- my ($k,$v) = $l =~ m/(.*)=(.*)$/;
- $cfg->{$k} = $v;
- }
- close(CFG2);
- }
-}
-
-sub writeconfig(){
- open(CFG,'>'.$profilepath.'/lastsync.conf');
- print CFG "LASTSYNCUP=".$cfg->{LASTSYNCUP}."\n";
- print CFG "LASTSYNCDOWN=".$cfg->{LASTSYNCDOWN}."\n";
- close(CFG);
-}
-
-sub ftpsyncup($lfile,$rfilename){
- my $lfile = shift;
- my $ret = $ftp->put($lfile);
- return $ret;
-}
-
-sub ftpsyncdown(){
- my $rfile =shift;
- my $lfile = shift;
- my $ret = $ftp->get($rfile,$lfile);
- return $ret;
-}
-
-sub ftplist(){
- my $dbfolder = shift;
- my $suffix=shift;
-
- my $ret = ();
- $ftp->cwd($cfg->{FOLDER});
- if ($dbfolder ne ""){
- my @flx = $ftp->ls();
- my @test = grep { /$dbfolder/ } @flx;
- if (scalar(@test) == 0){
- $ftp->mkdir($dbfolder);
- }
- $ftp->cwd($dbfolder);
- }
- my @rtxt = $ftp->ls();
- foreach my $r (@rtxt){
- if ($r =~ /$suffix$/){
- my $t = $ftp->mdtm($r);
- $ret->{$r}->{mtime} = $t;
- my $s = $ftp->size($r);
- $ret->{$r}->{size} = $s;
- }
- }
- return $ret;
-}
-
-sub ftpconnect(){
- $ftp = Net::FTP->new($cfg->{HOST},'Timeout' => 30, 'Passive' => 1);
- if (defined($ftp)){
- $ftp->login($cfg->{USER},$cfg->{PASSWORD});
- $ftp->binary;
- }
-
-}
-
-sub ftpdisconnect(){
- $ftp->quit();
-}
-
-sub locallist(){
- my $cdir = shift;
- my $suffix = shift;
- my $ret = ();
- opendir(XX,$cdir) or return $ret;
- while (my $d = readdir(XX)){
- #print $d."\n";
- if (substr($d,0,1) eq "."){ next; }
- if ((-f $cdir.'/'.$d) && ($d =~ /$suffix$/)){
- my @stat = stat($cdir.'/'.$d);
- $ret->{$d}->{mtime} = $stat[9];
- $ret->{$d}->{size} = $stat[7];
- }
- }
- closedir(XX);
- return $ret;
-}
\ No newline at end of file
projects / creorga.git / commitdiff