+++ /dev/null
-#!/usr/bin/perl\r
-use strict;\r
-use File::Basename;\r
-use Getopt::Long;\r
-use Time::HiRes;\r
-use Data::Dumper;\r
-#if ($^O ne "MSWin32" ){\r
-# eval("use lib (dirname($0));\r
-# use lib ($ENV{HOME}.'/perl5/lib/perl5');\r
-# use lib ('C:/USers/ksaff/Workspace/DKSService');");\r
-# \r
-#}\r
-use lib (dirname($0));\r
-if ($^O eq "darwin"){\r
- eval("use lib ($ENV{HOME}.'/perl5/lib/perl5');");\r
-}\r
-use Plack::Builder;\r
-use Plack::App::File;\r
-use Plack::App::WrapCGI;\r
-use Plack::Middleware::Auth::Basic;\r
-use Plack::Request; \r
-use Plack::Runner;\r
-use Module::Service;\r
-use Module::Test;\r
-use Module::SQLite;\r
-use Module::PDFExtract;\r
-#use Module::Audio; \r
-use Module::System; \r
-use Module::OpenVPN;\r
-#use Module::SSH; \r
-#use JSON::PP;\r
-\r
-print $^O."\n";\r
-\r
-\r
-my @match = grep { /par-.*inc$/} @INC;\r
-\r
-my $basedir = dirname($0);\r
-if (scalar(@match) > 0){\r
- $basedir = $match[0];\r
-}\r
-\r
-my $cfgpath = "";\r
-#print "BASEDIR:".$basedir."\n";\r
-\r
-\r
-sub version {\r
- require Twiggy;\r
- print "Twiggy $Twiggy::VERSION\n";\r
-}\r
-\r
-#sub authen_cb {\r
-# my($username, $password, $env) = @_;\r
-# return $username eq 'admin' && $password eq 'admin';\r
-# }\r
-#my $name = basename($0);\r
-#$name =~ s/srv\.pl$//;\r
-#$name =~ s/srv\.exe$//;\r
-#my $appcfgpath = ""; \r
-#if ($^O eq "MSWin32"){\r
-# $appcfgpath = $ENV{APPDATA}.'/'.$name;\r
-#}else {\r
-# $appcfgpath = $ENV{HOME}.'/Library/Application Support/'.$name;\r
-#}\r
-\r
-\r
-my $allapp = builder {\r
- mount "/app" => Module::Service->new(); \r
- mount "/system" => Module::System->new();\r
- mount "/test" => Module::Test->new();\r
- mount "/openvpn" => Module::OpenVPN->new();\r
- mount "/sqlite" => Module::SQLite->new();\r
- mount "/pdfextract" => Module::PDFExtract->new();\r
-};\r
-\r
-\r
-my @args = ("-p","6060");\r
-my $runner = Plack::Runner->new(server => 'Twiggy', env => 'deployment', version_cb => \&version);#env => development, test \r
-$runner->parse_options(@args);\r
-$runner->run($allapp);\r
-\r
-print "Started\n";\r
-\r
-\r
+++ /dev/null
-package Module::OpenVPN;\r
-\r
-use strict;\r
-use warnings;\r
-use parent qw(Plack::Component);\r
-use Plack::Request;\r
-use Data::Dumper;\r
-use File::Find::Rule;\r
-use File::Basename;\r
-use JSON::PP;\r
-use File::Copy;\r
-use File::Path qw(make_path);\r
-\r
-sub call {\r
- my($self, $env) = @_;\r
- #$self->_app->($env);\r
- if (($env->{REMOTE_ADDR} =~ "^127\.0\.") && \r
- ($env->{REMOTE_ADDR} =~ "^10\.") && \r
- ($env->{REMOTE_ADDR} =~ "^172\.16\.") && \r
- ($env->{REMOTE_ADDR} =~ "^192\.168\.")) {\r
- return [\r
- 404,\r
- [ 'Content-Type' => "text/html",'Cache-Control' => 'no-store, no-cache, must-revalidate' ], \r
- [ "Sorry no remote access allowed!" ]\r
- ];\r
- }\r
- if ($env->{PATH_INFO} =~ /^\/connect/){\r
- return $self->vpnconnect($env);\r
- } elsif ($env->{PATH_INFO} =~ /^\/disconnect/){\r
- return $self->vpndisconnect($env);\r
- } elsif ($env->{PATH_INFO} =~ /^\/installprofile/){\r
- return $self->vpninstallprofile($env);\r
- } elsif ($env->{PATH_INFO} =~ /^\/listprofiles/){\r
- return $self->vpnprofilelist($env);\r
- }\r
- return [\r
- 404,\r
- [ 'Content-Type' => "text/html",'Cache-Control' => 'no-store, no-cache, must-revalidate' ], \r
- [ "Unknown System Request!" ]\r
- ];\r
-}\r
-\r
-sub vpnconnect(){\r
- my $self = shift;\r
- my $env = shift;\r
- my $html->{result} = 0;\r
- my $req = Plack::Request->new($env);\r
- my $uprofile = "";\r
- #is gui or vpn running\r
- \r
- if (exists($req->query_parameters->{vpnprofile})){\r
- my $status = $self->vpnstatus();\r
- if (!exists($status->{active}->{$req->query_parameters->{vpnprofile}})){\r
- if ($^O eq "MSWin32"){\r
- if (exists($status->{gui})){\r
- system('taskkill.exe /F /IM openvpn.exe');\r
- system('taskkill.exe /F /IM openvpn-gui.exe');\r
- sleep(1);\r
- }\r
- my $st = system(1,'start /b "" "C:\Program Files\OpenVPN\bin\openvpn-gui.exe" --connect "'.$req->query_parameters->{vpnprofile}.'.ovpn"');\r
- if ($st == 0){\r
- \r
- my $bconn = 0;\r
- my $i = 30;\r
- while ($bconn == 0 || $i > 0){\r
- $status = $self->vpnstatus();\r
- if (exists($status->{active}->{$req->query_parameters->{vpnprofile}})){\r
- $html->{result} = $status;\r
- $bconn = 1;\r
- }\r
- $i--;\r
- sleep(1);\r
- }\r
- }\r
- } \r
- } else {\r
- $html->{result} = $status;\r
- }\r
- }\r
- return [\r
- 200,\r
- [ 'Content-Type' => "application/json",'Cache-Control' => 'no-store, no-cache, must-revalidate', 'Access-Control-Allow-Origin'=> '*' ], \r
- [ JSON::PP::encode_json($html) ]\r
- ];\r
-}\r
-\r
-sub vpnstatus(){\r
- my $self = shift;\r
- my $status = ();\r
- if ($^O eq "MSWin32"){\r
- \r
- my $tasklist = `tasklist`;\r
- my @task = split("\n",$tasklist);\r
- my @ovpntasks = grep(/openvpn-gui\.exe/,@task);\r
- if (scalar(@ovpntasks) > 0){\r
- $status->{gui} = "running";\r
- }\r
- @ovpntasks = grep(/openvpn.exe/,@task);\r
- #$status->{active_connections} = scalar(@ovpntasks);\r
- if (scalar(@ovpntasks) > 0){\r
- my $ff = File::Find::Rule->new();\r
- $ff->file;\r
- $ff->name('*.log');\r
- my @loglist =$ff->in($ENV{USERPROFILE}.'/OpenVPN/log');\r
- foreach my $c (@loglist){\r
- open(CLOG,$c);\r
- my @data = <CLOG>;\r
- close(CLOG);\r
- my $laststate=$data[scalar(@data)-1];\r
- chomp($laststate);\r
- if ($laststate =~ /CONNECTED/){\r
- my ($time,$ip,$server,$port) = $laststate =~ /.+MANAGEMENT:\s>STATE:(\d+),CONNECTED,SUCCESS,(.+),(.+),(.+),,$/;\r
- if (!exists($status->{connection}->{$ip})){\r
- $status->{connection}->{$ip}->{config} = substr(basename($c),0,-4);;\r
- $status->{connection}->{$ip}->{server} = $server; \r
- $status->{connection}->{$ip}->{port} = $port;\r
- $status->{connection}->{$ip}->{connected_since} = $time;\r
- }else {\r
- if ($time >= $status->{connection}->{$ip}->{connected_since}){\r
- $status->{connection}->{$ip}->{config} = substr(basename($c),0,-4);\r
- $status->{connection}->{$ip}->{server}= $server; \r
- $status->{connection}->{$ip}->{port} = $port;\r
- $status->{connection}->{$ip}->{connected_since} = $time;\r
- }\r
- }\r
- }\r
- }\r
- my @notactive = ();\r
- my $active = ();\r
- foreach my $c (keys(%{$status->{connection}})){\r
- my $routeslist = `route print -4`; \r
- my @routes = split("\n",$routeslist);\r
- my @activetest = grep(/$c/,@routes);\r
- if (scalar(@activetest) == 0){\r
- push @notactive,$c;\r
- } else {\r
- $active->{$status->{connection}->{$c}->{config}} = $c;\r
- }\r
- }\r
- foreach my $na (@notactive){\r
- delete $status->{connection}->{$na};\r
- }\r
- $status->{active} = $active;\r
- }\r
- }\r
- return $status;\r
-}\r
-\r
-sub vpndisconnect(){\r
- my $self = shift;\r
- my $env = shift;\r
- my $html->{result} = 1;\r
- if ($^O eq "MSWin32"){\r
- system('taskkill.exe /F /IM openvpn.exe');\r
- system('taskkill.exe /F /IM openvpn-gui.exe');\r
- }\r
- return [\r
- 200,\r
- [ 'Content-Type' => "application/json",'Cache-Control' => 'no-store, no-cache, must-revalidate', 'Access-Control-Allow-Origin'=> '*' ], \r
- [ JSON::PP::encode_json($html) ]\r
- ];\r
-}\r
-\r
-sub vpninstallprofile(){\r
- my $self = shift;\r
- my $env = shift;\r
- my $req = Plack::Request->new($env);\r
- my $html->{result} = 0;\r
- if ($^O eq "MSWin32"){\r
- if ( ! -d $ENV{USERPROFILE}.'/OpenVPN'){\r
- make_path($ENV{USERPROFILE}.'/OpenVPN');\r
- }\r
- if (exists($req->query_parameters->{vpnprofile}) && (-e $req->query_parameters->{vpnprofile}) && ($req->query_parameters->{vpnprofile} =~ /\.ovpn$/)){\r
- copy(req->query_parameters->{vpnprofile},$ENV{USERPROFILE}.'/OpenVPN/'.basename($req->query_parameters->{vpnprofile}));\r
- $html->{result} = 1;\r
- }\r
- }\r
- return [\r
- 200,\r
- [ 'Content-Type' => "application/json",'Cache-Control' => 'no-store, no-cache, must-revalidate', 'Access-Control-Allow-Origin'=> '*' ], \r
- [ JSON::PP::encode_json($html) ]\r
- ];\r
-}\r
-\r
-sub vpnprofilelist(){\r
- my $self = shift;\r
- my $env = shift;\r
- my $html->{result} = ();\r
- if ($^O eq "MSWin32"){\r
- my $ff = File::Find::Rule->new();\r
- $ff->file;\r
- $ff->name('*.ovpn');\r
- my @vpnlist =$ff->in($ENV{USERPROFILE}.'/OpenVPN');\r
- foreach (my $p=0;$p<scalar(@vpnlist);$p++){\r
- $vpnlist[$p] = substr(basename($vpnlist[$p]),0,-5);\r
- } \r
- $html->{result} = \@vpnlist;\r
- }\r
- return [\r
- 200,\r
- [ 'Content-Type' => "application/json",'Cache-Control' => 'no-store, no-cache, must-revalidate', 'Access-Control-Allow-Origin'=> '*' ], \r
- [ JSON::PP::encode_json($html) ]\r
- ];\r
-}\r
-\r
-\r
-1;
\ No newline at end of file
+++ /dev/null
-package Module::PDFExtract;\r
-\r
-use strict;\r
-use warnings;\r
-use parent qw(Plack::Component);\r
-use Plack::Request;\r
-use File::Basename;\r
-use Data::Dumper;\r
-use PDF::API2;\r
-use File::Path qw/make_path/;\r
-\r
-sub call {\r
- my($self, $env) = @_;\r
- #$self->_app->($env);\r
- my $html->{result} = "unknown function";\r
- if (($env->{REMOTE_ADDR} =~ "^127\.0\.") && \r
- ($env->{REMOTE_ADDR} =~ "^10\.") && \r
- ($env->{REMOTE_ADDR} =~ "^172\.16\.") && \r
- ($env->{REMOTE_ADDR} =~ "^192\.168\.")) {\r
- return [\r
- 404,\r
- [ 'Content-Type' => "text/html",'Cache-Control' => 'no-store, no-cache, must-revalidate' ], \r
- [ "Sorry no remote access allowed!" ]\r
- ];\r
- }\r
- if ($env->{PATH_INFO} =~ /^\/pdfsplit/){\r
- return $self->pdfsplit($env);\r
- }\r
- if ($env->{PATH_INFO} =~ /^\/pdfpagenumbers/){\r
- return $self->pdfpagesnumbers($env);\r
- }\r
-# if ($env->{PATH_INFO} =~ /^\/pdfextract/){\r
-# return $self->pdfextract($env);\r
-# }\r
- if ($env->{PATH_INFO} =~ /^\/parsedata/){\r
- return $self->parsedata($env);\r
- }\r
- if ($env->{PATH_INFO} =~ /^\/parsestatement/){\r
- return $self->parsestatement($env);\r
- }\r
- return [\r
- 404,\r
- [ 'Content-Type' => 'text/html','Cache-Control' => 'no-store, no-cache, must-revalidate' , 'Access-Control-Allow-Origin'=> '*'], \r
- [ "unknown function" ]\r
- ];\r
-}\r
-\r
-sub pdfpagesnumbers(){\r
- my $self = shift;\r
- my $env = shift;\r
- my $ct="application/json";\r
- my $status=200;\r
- my $req = Plack::Request->new($env);\r
- my $html->{result}->{pagenumbers} = 0;\r
- if (exists($req->query_parameters->{file}) && ($req->query_parameters->{file} =~ /\.pdf$/)){\r
- my $pdf = PDF::API2->open($req->query_parameters->{file});\r
- $html->{result}->{pagenumbers} = $pdf->pages;\r
- }\r
- return [\r
- 200,\r
- [ 'Content-Type' => $ct,'Cache-Control' => 'no-store, no-cache, must-revalidate' , 'Access-Control-Allow-Origin'=> '*'], \r
- [ JSON::PP::encode_json($html) ]\r
- ];\r
-}\r
-\r
-sub pdfsplit(){\r
- my $self = shift;\r
- my $env = shift;\r
- my $html->{result} = ();\r
- my $ct="application/json";\r
- my $status=200;\r
- my $req = Plack::Request->new($env);\r
- my @nfiles = ();\r
- my $outputdir = $ENV{TEMP};\r
- if (exists($req->query_parameters->{file}) && exists($req->query_parameters->{prefix})){\r
- my $basepdf = basename($req->query_parameters->{file});\r
- $outputdir =~ s/\\/\//g;\r
- \r
- my $oldpdf = PDF::API2->open($req->query_parameters->{file});\r
- my $xx = $oldpdf->pages;\r
- for my $page_nb (1..$xx) {\r
- my $newpdf = PDF::API2->new;\r
- my $page = $newpdf->importpage($oldpdf, $page_nb);\r
- \r
- my $npdfname = $outputdir.'/'.$req->query_parameters->{prefix}.substr($basepdf,0,-4).".".$page_nb.".pdf"; \r
- push @nfiles,$npdfname;\r
- if (-e $npdfname){ unlink($npdfname); }\r
- $newpdf->saveas($npdfname);\r
- }\r
- }\r
- foreach my $n (@nfiles){\r
- my $r = $self->pdfextract($n);\r
- }\r
- $html->{result}->{files} = \@nfiles;\r
- return [\r
- 200,\r
- [ 'Content-Type' => $ct,'Cache-Control' => 'no-store, no-cache, must-revalidate' , 'Access-Control-Allow-Origin'=> '*'], \r
- [ JSON::PP::encode_json($html) ]\r
- ];\r
-};\r
-\r
-sub pdfextract(){\r
- my $self = shift;\r
- my $file = shift;\r
-# my $html->{result} = ();\r
-# my $ct="application/json";\r
-# my $status=200;\r
-# my $req = Plack::Request->new($env);\r
- my $pdftotext;\r
- my $sep = "/";\r
- if ($^O eq "MSWin32") {\r
- $sep = "\\";\r
- $pdftotext=dirname($0).$sep.'pdftotext.exe';\r
- }else {\r
- $pdftotext=dirname($0).$sep.'pdftotext';\r
- }\r
- if (-e $file.'.txt'){\r
- unlink($file.'.txt');\r
- }\r
- my $cmd = 'start /b "" "'.$pdftotext.'" -q -table -eol unix "'.$file.'" "'.$file.'.txt"';\r
- my $st = `$cmd`;#'system(1,$cmd)' ;\r
- #print $cmd."->".$st."\n";\r
- return $st;\r
-}\r
-\r
-sub parsedata(){\r
- my $self = shift;\r
- my $env = shift;\r
- my $req = Plack::Request->new($env);\r
- if (exists($req->query_parameters->{type}) && exists($req->query_parameters->{file})){\r
- if ($req->query_parameters->{type} eq "inv"){\r
- return $self->parseinvoice($req->query_parameters->{file});\r
- } elsif ($req->query_parameters->{type} eq "invold"){\r
- return $self->parseoldinvoice($req->query_parameters->{file});\r
- } elsif ($req->query_parameters->{type} eq "stmt") {\r
- return $self->parsestatement($req->query_parameters->{file});\r
- } else {\r
- return [\r
- 404,\r
- [ 'Content-Type' => 'text/html','Cache-Control' => 'no-store, no-cache, must-revalidate' , 'Access-Control-Allow-Origin'=> '*'], \r
- [ "unknown function" ]\r
- ];\r
- }\r
- }\r
-}\r
-\r
-sub parseinvoice(){\r
- my $self = shift;\r
- my $file = shift;\r
- my $html->{result} = ();\r
- my $ct="application/json";\r
- my $status=200;\r
- my $pxdata = ();\r
- if (-e $file){\r
- my @invoicedata = ();\r
- open(EXT,$file);\r
- while (my $l = <EXT>){\r
- chomp($l);\r
- push(@invoicedata,$l);\r
- }\r
- close(EXT);\r
- foreach my $p (@invoicedata){\r
- if ($p =~ /^N. Facture/) {\r
- my ($tmp) = $p =~ m/.+\s(\d{4,}.\d{1,2}.\d{4,})\s.+$/;\r
- $pxdata->{reference} = $tmp;\r
- }\r
- if ($p =~ /^Date de la facture/) {\r
- my ($d,$m,$y) = $p =~ m/.+\s(\d{1,2}).(\d{1,2}).(\d{4,}).+$/;\r
- if (length($d) == 1) { $d = "0".$d;}\r
- if (length($m) == 1) { $m = "0".$m;}\r
- $pxdata->{invoicedate} = $y.'-'.$m.'-'.$d;\r
- }\r
-# if (($p =~ /facture/) && ($pxdata->{invoicedate} eq "--")) {\r
-# my ($d,$m,$y) = $p =~ m/.+\s(\d{1,2}).(\d{1,2}).(\d{4,})$/;\r
-# if (length($d) == 1) { $d = "0".$d;}\r
-# if (length($m) == 1) { $m = "0".$m;}\r
-# $pxdata->{invoicedate} = $y.'-'.$m.'-'.$d;\r
-# }\r
- if ($p =~ /^Enfant/) {\r
- my ($tmp) = $p =~ m/.+\s\((\d+)\).+$/;\r
- $pxdata->{checkservice} = $tmp;\r
- }\r
- if (($p =~ /^\s+\(\d+\)$/) && (!defined($pxdata->{checkservice}))) {\r
- my ($tmp) = $p =~ m/\s+\((\d+)\)$/;\r
- $pxdata->{checkservice} = $tmp;\r
- }\r
- if ($p =~ /Heures.+\sh\s/) {\r
- 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}).+$/;\r
- $p1 =~ s/,/\./;\r
- $e1 =~ s/,/\./;\r
- $p1 =~ s/\ //;\r
- $e1 =~ s/\ //;\r
- if (exists($pxdata->{hoursamount})){\r
- $pxdata->{hoursamount} = $pxdata->{hoursamount} + $p1 + $e1;\r
- } else {\r
- $pxdata->{hoursamount} = $p1 + $e1; \r
- }\r
- \r
- }\r
- if ($p =~ /Repas/) {\r
- my ($rn,$p1,$e1) = $p =~ m/.+Repas.+\s+(\d+)\s+([\s|\d]+,\d{1,2})\s+([\s|\d]+,\d{1,2}).+$/;\r
- $p1 =~ s/,/\./;\r
- $e1 =~ s/,/\./;\r
- $p1 =~ s/\ //;\r
- $e1 =~ s/\ //;\r
- $pxdata->{lunchnum} = $rn;\r
- $pxdata->{lunchamount} = $p1 + $e1;\r
- }\r
- if ($p =~ /Participation totale de l.Etat/){\r
- my ($e1) = $p =~ m/.+Participation totale de l.Etat\s+([\s|\d]+,\d{1,2}).+$/;\r
- $e1 =~ s/,/\./;\r
- $e1 =~ s/\ //;\r
- $pxdata->{benefitamount} = $e1;\r
- }\r
- if ($p =~ /Montant\s.\sr.gler/) {\r
- my ($m1) = $p =~ m/.+Montant.+\s+([\s|\d]+,\d{1,2}).+$/;\r
- $m1 =~ s/,/\./;\r
- $m1 =~ s/\ //;\r
- $pxdata->{totalamount} = $m1;\r
- }\r
- #print Dumper(@pdata);\r
- }\r
- }\r
- $html->{result} = $pxdata;\r
- return [\r
- 200,\r
- [ 'Content-Type' => $ct,'Cache-Control' => 'no-store, no-cache, must-revalidate' , 'Access-Control-Allow-Origin'=> '*'], \r
- [ JSON::PP::encode_json($html) ]\r
- ];\r
-}\r
-\r
-sub parseoldinvoice(){\r
- my $self = shift;\r
- my $file = shift;\r
- my $html->{result} = ();\r
- my $ct="application/json";\r
- my $status=200;\r
- my $pxdata = ();\r
- if (-e $file){\r
- my @invoicedata = ();\r
- open(EXT,$file);\r
- while (my $l = <EXT>){\r
- chomp($l);\r
- push(@invoicedata,$l);\r
- }\r
- close(EXT);\r
- foreach my $p (@invoicedata){\r
- if ($p =~ /N. Facture/) {\r
- my ($tmp) = $p =~ m/.+\s(\d{4,}.\d{1,2}.\d{4,})\s.+$/;\r
- $pxdata->{reference} = $tmp;\r
- }\r
- if ($p =~ /Date de la/) {\r
- my ($d,$m,$y) = $p =~ m/.+\s(\d{1,2}).(\d{1,2}).(\d{4,})$/;\r
- if (length($d) == 1) { $d = "0".$d;}\r
- if (length($m) == 1) { $m = "0".$m;}\r
- $pxdata->{invoicedate} = $y.'-'.$m.'-'.$d;\r
- }\r
- if (($p =~ /facture/) && ($pxdata->{invoicedate} eq "--")) {\r
- my ($d,$m,$y) = $p =~ m/.+\s(\d{1,2}).(\d{1,2}).(\d{4,})$/;\r
- if (length($d) == 1) { $d = "0".$d;}\r
- if (length($m) == 1) { $m = "0".$m;}\r
- $pxdata->{invoicedate} = $y.'-'.$m.'-'.$d;\r
- }\r
- if ($p =~ /Carte N./) {\r
- my ($tmp) = $p =~ m/.+\s(\d+)$/;\r
- $pxdata->{checkservice} = $tmp;\r
- }\r
- if ($p =~ /Heure/) {\r
- my ($tmp1,$tmp2) = $p =~ m/.+\s(\d+).(\d+)+$/;\r
- $pxdata->{hoursamount} = $tmp1.'.'.$tmp2;\r
- }\r
- if ($p =~ /Repas/) {\r
- my ($tmp1,$tmp2) = $p =~ m/.+\s(\d+).(\d+)+$/;\r
- $pxdata->{lunchamount} = $tmp1.'.'.$tmp2;\r
- }\r
- if ($p =~ /Montant\s.\spayer/) {\r
- my ($tmp1,$tmp2) = $p =~ m/.+\s(\d+).(\d+)+$/;\r
- $pxdata->{totalamount} = $tmp1.'.'.$tmp2;\r
- }\r
- #print Dumper(@pdata);\r
- }\r
- }\r
- $html->{result} = $pxdata;\r
- return [\r
- 200,\r
- [ 'Content-Type' => $ct,'Cache-Control' => 'no-store, no-cache, must-revalidate' , 'Access-Control-Allow-Origin'=> '*'], \r
- [ JSON::PP::encode_json($html) ]\r
- ];\r
-}\r
-\r
-sub parsestatement(){\r
- my $self = shift;\r
- my $file = shift;\r
- my $html->{result} = ();\r
- my $ct="application/json";\r
- my $status=200;\r
- my $sxdata = ();\r
- my $cmonth = "none";\r
- 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'}; \r
- if (-e $file){\r
- my @xstmtdata = ();\r
- open(EXT,$file);\r
- while (my $l = <EXT>){\r
- chomp($l);\r
- push(@xstmtdata,$l);\r
- }\r
- close(EXT);\r
- my $sxdata = ();\r
- \r
- foreach my $p (@xstmtdata){\r
- if ($p =~ /P.riode/) {\r
- my ($m1,$y1,$m2,$y2) = $p =~ m/.+\s(.+)\s+(\d+)\s+.\s+(.+)\s+(\d+)$/;\r
- if (($m1 eq $m2) && ($y1 eq $y2)){\r
- $cmonth=$y1.'-'.$frmonth->{$m1};\r
- }\r
- }\r
- if ($p =~ /\d{13,}/) {\r
- my ($csnum,$am) = $p =~ m/.+\s+(\d{13,})\s+([\d|\ |,]+)$/;\r
- $am =~ s/\s+//;\r
- $am =~ s/,/./;\r
- $sxdata->{$cmonth}->{$csnum}=$am; \r
- }\r
- }\r
- }\r
- $html->{result} = $sxdata;\r
- return [\r
- 200,\r
- [ 'Content-Type' => $ct,'Cache-Control' => 'no-store, no-cache, must-revalidate' , 'Access-Control-Allow-Origin'=> '*'], \r
- [ JSON::PP::encode_json($html) ]\r
- ];\r
-}\r
-\r
-\r
-#\r
-#sub importstatementdata(){\r
-# my $simpdata = shift;\r
-# my $fname = shift;\r
-# #print Dumper($simpdata);\r
-# my $n=0;\r
-# foreach my $m (keys(%{$simpdata})){\r
-# $n++;\r
-# if (-e dirname($fname).$sep."prestation.".$m."-".$n.".pdf"){\r
-# unlink(dirname($fname).$sep."prestation.".$m."-".$n.".pdf");\r
-# }\r
-# rename($fname,dirname($fname).$sep."prestation.".$m."-".$n.".pdf");\r
-# foreach my $csnum (keys(%{$simpdata->{$m}})){\r
-# $simpdata->{$m}->{fnum} = $n;\r
-# }\r
-# }\r
-# foreach my $m (keys(%{$simpdata})){\r
-# $n++;\r
-# if ($m =~ /\d{4,}-\d{2,}/) {\r
-# foreach my $csnum (keys(%{$simpdata->{$m}})){\r
-# print "Import Check-Service no: " + $csnum + "\n";\r
-# if (defined($db)){\r
-# my $child = $db->dbquerysorted("select uuid from childs where replace(checkservicenumber,' ','') = '".$csnum."';");\r
-# if (keys(%{$child}) == 1) {\r
-# 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');");\r
-# if (keys(%{$accdata}) == 1) {\r
-# #make update\r
-# my @upd = ();\r
-# push @upd,"benefitamount='".$simpdata->{$m}->{$csnum}."'";\r
-# push @upd,"benefitfile='prestation.".$m."-".$simpdata->{$m}->{fnum}.".pdf'";\r
-# my $sql = "update accounting set ".join(',',@upd)." where childuuid='".$child->{0}->{uuid}."' and accmonth=date('".substr($m,0,4).'-'.substr($m,5,2)."-01');";\r
-# #print $sql."\n";\r
-# my $r = $db->dbexec($sql);\r
-# if (($log ne "") && (-e $log)){\r
-# if (!defined($r)) {\r
-# open(LOG,">>".$log);\r
-# print LOG localtime().":ERROR:".$sql."\n";\r
-# close(LOG);\r
-# } else {\r
-# open(LOG,">>".$log);\r
-# print LOG localtime().":SUCCESS:".$sql."\n";\r
-# close(LOG);\r
-# }\r
-# }\r
-# }else {\r
-# my @ins1 = ();\r
-# my @ins2 = ();\r
-# push(@ins1,"accmonth");push (@ins2,"date('".substr($m,0,4).'-'.substr($m,5,2)."-01')");\r
-# push(@ins1,"childuuid");push (@ins2,"'".$child->{0}->{uuid}."'");\r
-# push(@ins1,"benefitamount");push (@ins2,"".$simpdata->{$m}->{$csnum}."");\r
-# push(@ins1,"benefitfile");push (@ins2,"'prestation.".$m."-".$simpdata->{$m}->{fnum}.".pdf'");\r
-# \r
-# #accmonth,childuuid,invoicedate,invoiceamount,reference\r
-# my $sql = "insert into accounting (".join(',',@ins1).") VALUES (".join(',',@ins2).");";\r
-# #print $sql."\n";\r
-# my $r = $db->dbexec($sql);\r
-# if (($log ne "") && (-e $log)){\r
-# if (!defined($r)) {\r
-# open(LOG,">>".$log);\r
-# print LOG localtime().":ERROR:".$sql."\n";\r
-# close(LOG);\r
-# } else {\r
-# open(LOG,">>".$log);\r
-# print LOG localtime().":SUCCESS:".$sql."\n";\r
-# close(LOG);\r
-# }\r
-# }\r
-# }\r
-# }\r
-# }\r
-# }\r
-# }\r
-# }\r
-#}\r
-\r
-1;
\ No newline at end of file
+++ /dev/null
-package Module::SQLite;\r
-\r
-use strict;\r
-use warnings;\r
-use parent qw(Plack::Component);\r
-use Plack::Request;\r
-#use Data::Dumper;\r
-use DBI;\r
-use DBD::SQLite;\r
-use Encode;\r
-use JSON::PP;\r
-use File::Copy;\r
-\r
-sub call {\r
- my($self, $env) = @_;\r
- if (($env->{REMOTE_ADDR} =~ "^127\.0\.") && \r
- ($env->{REMOTE_ADDR} =~ "^10\.") && \r
- ($env->{REMOTE_ADDR} =~ "^172\.16\.") && \r
- ($env->{REMOTE_ADDR} =~ "^192\.168\.")) {\r
- return [\r
- 404,\r
- [ 'Content-Type' => "text/html",'Cache-Control' => 'no-store, no-cache, must-revalidate' ], \r
- [ "Sorry no remote access allowed!" ]\r
- ];\r
- }\r
- if ($env->{PATH_INFO} =~ /^\/createdb/){\r
- return $self->createdb($env);\r
- } elsif ($env->{PATH_INFO} =~ /^\/checkdb/){\r
- return $self->checkdb($env);\r
- }else {\r
- return $self->sqlite($env); \r
- }\r
- return [\r
- 404,\r
- [ 'Content-Type' => "text/html",'Cache-Control' => 'no-store, no-cache, must-revalidate' ], \r
- [ "no such function!" ]\r
- ];\r
-}\r
-\r
-sub sqlite {\r
- my $self = shift;\r
- my $env = shift;\r
- my $html->{result} = ();\r
- my $ct="application/json";\r
- my $status=200;\r
- my $req = Plack::Request->new($env);\r
- my $res = ();\r
- #print $req->query_parameters->{db}.":".$req->query_parameters->{type}.":".decode_base64($req->query_parameters->{sql})."\n------------------\n";\r
- $html->{req}->{db} = $req->query_parameters->{db};\r
- $html->{req}->{type} = $req->query_parameters->{type};\r
- $html->{req}->{sql} = $req->query_parameters->{sql};\r
- #$html->{req}->{sqldecoded} = $req->query_parameters->{sql}; \r
- if (( -f $req->query_parameters->{db} ) && (exists($req->query_parameters->{sql})) && (exists($req->query_parameters->{type})) ) {\r
- \r
- $self->{dbfile} = $req->query_parameters->{db};\r
- #my $db = sqlite->new();\r
- my $q = $req->query_parameters->{sql};\r
- my $t = $req->query_parameters->{type};\r
- if ($t eq "query"){\r
- $res = $self->dbquery($req->query_parameters->{key},$q);\r
- } elsif ($t eq "querysorted"){\r
- $res = $self->dbquerysorted($q);\r
- } elsif ($t eq "queryarray"){\r
- $res = $self->dbqueryarray($q);\r
- } elsif ($t eq "exec"){\r
- $res = $self->dbexec($q);\r
- } \r
- \r
- }\r
- $html->{result}->{sqldata} = $res;\r
- return [\r
- 200,\r
- [ 'Content-Type' => $ct.'; charset=utf-8','Cache-Control' => 'no-store, no-cache, must-revalidate', 'Access-Control-Allow-Origin'=> '*' ], \r
- [ JSON::PP::encode_json($html) ]\r
- ];\r
-};\r
-\r
-\r
-\r
-sub strreplace(){\r
- my $self = shift;\r
- my $text = shift;\r
- $text =~ s/'/''/g;\r
- return $text;\r
-}\r
-\r
-sub dbquery(){\r
- my $self = shift;\r
- my $key = shift;\r
- my $stat = shift;\r
- my $retdata =();\r
- my $dbh = DBI->connect('DBI:SQLite:dbname='.$self->{dbfile},"","",{PrintError=>1,RaiseError=>1,AutoCommit=>1}) or return $retdata->{error} = "dbquery Connection Error!".$!;\r
- #$stat = encode("utf8", $stat);\r
-\r
- #open FILE,">>/tmp/sql.log";\r
- # print FILE "key:".$key.";$stat\n";\r
- # close FILE;\r
- my $sth = $dbh->prepare($stat);\r
- $sth->execute() or print "dbquery: ".$sth->errstr;\r
- while(my $data = $sth->fetchrow_hashref())\r
- {\r
- if (exists $data->{$key}){\r
- foreach my $k (keys %{$data}){\r
- $retdata->{$data->{$key}}{$k} = decode( "utf8", $data->{$k});\r
- }\r
- }\r
- }\r
- if (keys(%{$retdata}) == 0){\r
- $retdata =();\r
- }\r
- $sth->finish();\r
- $dbh->disconnect();\r
- return $retdata;\r
-}\r
-\r
-sub dbquerysorted(){\r
- my $self = shift;\r
- my $stat = shift;\r
- my $retdata = ();\r
- my $dbh = DBI->connect('DBI:SQLite:dbname='.$self->{dbfile},"","",{PrintError=>1,RaiseError=>1,AutoCommit=>1}) or return $retdata->{error} = "dbquery Connection Error!".$!;\r
- #$stat = encode("utf8", $stat);\r
- #open FILE,">>/tmp/sql.log";\r
- #print "$stat\n";\r
- # close FILE;\r
- my $sth = $dbh->prepare($stat);\r
-\r
- $sth->execute() or print "dbquery: ".$sth->errstr;\r
- my $count = 0;\r
- while(my $data = $sth->fetchrow_hashref())\r
- {\r
- foreach my $k (keys %{$data}){\r
- $retdata->{$count}->{$k} = decode( "utf8", $data->{$k});\r
- }\r
- $count++;\r
- }\r
-\r
- $sth->finish();\r
- $dbh->disconnect();\r
- #%retdata = sort {$a <=> $b} keys %retdata;\r
- return $retdata;\r
-}\r
-\r
-sub dbqueryarray(){\r
- my $self = shift;\r
- my $stat = shift;\r
- my @retdata = ();\r
- my $dbh = DBI->connect('DBI:SQLite:dbname='.$self->{dbfile},"","",{PrintError=>1,RaiseError=>1,AutoCommit=>1}) or return $retdata[0]->{error} = "dbquery Connection Error!".$!;\r
- #$stat = encode("utf8", $stat);\r
- #open FILE,">>/tmp/sql.log";\r
- #print "$stat\n";\r
- # close FILE;\r
- my $sth = $dbh->prepare($stat);\r
-\r
- $sth->execute() or print "dbquery: ".$sth->errstr;\r
- my $count = 0;\r
- \r
- while(my $valdata = $sth->fetchrow_arrayref())\r
- {\r
- if (!defined($valdata)){ last;}\r
- my @rdata = ();\r
- foreach my $k (@{$valdata}){\r
- push @rdata,decode( "utf8", $k);\r
- }\r
- push @retdata,\@rdata;\r
- }\r
-\r
- $sth->finish();\r
- $dbh->disconnect();\r
- #%retdata = sort {$a <=> $b} keys %retdata;\r
- return \@retdata;\r
-}\r
-\r
-sub dbexec(){\r
- my $self = shift;\r
- my $stat = shift;\r
- my $dbh = DBI->connect('DBI:SQLite:dbname='.$self->{dbfile},"","",{PrintError=>1,AutoCommit=>1}) or return "dbexec Connection Error!".$!;\r
- #$stat = encode("utf8", $stat);\r
- #print $stat."\n";\r
- #open FILE,">>/Users/kilian/sql.log";\r
- #print FILE "$stat\n";\r
- #close FILE;\r
- my $sth = $dbh->prepare($stat);\r
- my $rv =$dbh->do($stat) or print "Failed dbexec:\n'".$stat. "'\n\n";\r
- $dbh->disconnect();\r
- return $rv;\r
-}\r
-\r
-sub createdb(){\r
- my $self = shift;\r
- my $env = shift;\r
- my $html->{result} = 0;\r
- my $ct="application/json";\r
- my $status=200;\r
- my $req = Plack::Request->new($env);\r
- if (exists($req->query_parameters->{templatedb}) && exists($req->query_parameters->{newdb}) && (-f $req->query_parameters->{templatedb})){\r
- my $r = copy($req->query_parameters->{templatedb},$req->query_parameters->{newdb});\r
- $html->{result} = $r;\r
- }\r
- return [\r
- 200,\r
- [ 'Content-Type' => $ct.'; charset=utf-8','Cache-Control' => 'no-store, no-cache, must-revalidate', 'Access-Control-Allow-Origin'=> '*' ], \r
- [ JSON::PP::encode_json($html) ]\r
- ];\r
-}\r
-\r
-sub checkdb(){\r
- my $self = shift;\r
- my $env = shift;\r
- my $html->{result} = 1;\r
- my $ct="application/json";\r
- my $status=200;\r
- my $req = Plack::Request->new($env);\r
- if (exists($req->query_parameters->{templatedb}) && exists($req->query_parameters->{db}) && (-f $req->query_parameters->{templatedb}) && (-f $req->query_parameters->{db})){\r
- my $templatedb = $req->query_parameters->{templatedb};\r
- my $dborig = $req->query_parameters->{templatedb};\r
- $self->{dbfile} = $templatedb;\r
- my $dbdefsql = "SELECT type, name,tbl_name,sql FROM sqlite_master order by name,tbl_name,type;";\r
- my $defdbschemacfg = $self->dbquerysorted($dbdefsql);\r
- $self->{dbfile} = $dborig; \r
- my $tcurcfg = $self->dbquerysorted($dbdefsql);\r
- my $keycnt = keys(%{$defdbschemacfg});\r
- my $bvaccum = 0;\r
- my $stexec = 0;\r
- foreach my $pd (sort {$a <=> $b} keys(%{$defdbschemacfg})){\r
- if ($defdbschemacfg->{$pd}->{'type'} eq 'table') {\r
- my $bupdate = 0;\r
- my $bexists = 0;\r
- my $cucols = '';\r
- my $oldobj = ();\r
- foreach my $pc (keys(%{$tcurcfg})){\r
- if (($tcurcfg->{$pc}->{tbl_name} eq $defdbschemacfg->{$pd}->{tbl_name}) && ($tcurcfg->{$pc}->{type} eq $defdbschemacfg->{$pd}->{type})){\r
- #print $defdbschemacfg->{$pd}->{type}.": ".$defdbschemacfg->{$pd}->{tbl_name}. "\n";\r
- if ($tcurcfg->{$pc}->{sql} ne $defdbschemacfg->{$pd}->{sql}){ $bupdate = 1; $oldobj= $self->getcoldef($tcurcfg->{$pc}->{sql}); }\r
- $bexists = 1; last;\r
- }\r
- }\r
- if (($bexists==1) && ($bupdate== 1)){\r
- my $sql_installnew = $defdbschemacfg->{$pd}->{sql}; \r
- my $newobj = $self->getcoldef($defdbschemacfg->{$pd}->{sql});\r
- my @copycols = ();\r
- for my $x (keys(%{$newobj})){\r
- if (exists($oldobj->{$x})) { push @copycols,$x; }\r
- } \r
- my @ainssql = ();\r
- push(@ainssql,"DROP TABLE IF EXISTS new_".$defdbschemacfg->{$pd}->{tbl_name}. ";");\r
- my $sql_tmptbl = $sql_installnew;\r
- $sql_tmptbl =~ s/CREATE\ TABLE\ /CREATE TABLE new_/;\r
- $sql_tmptbl =~ s/"//g;\r
- push(@ainssql,$sql_tmptbl);\r
- push(@ainssql,"INSERT INTO new_".$defdbschemacfg->{$pd}->{tbl_name}." (".join(',',@copycols).") SELECT ".join(',',@copycols)." FROM ".$defdbschemacfg->{$pd}->{tbl_name}.";"); \r
- push(@ainssql,"DROP TABLE ".$defdbschemacfg->{$pd}->{tbl_name}.";");\r
- push(@ainssql,"ALTER TABLE new_".$defdbschemacfg->{$pd}->{tbl_name}. " RENAME TO ".$defdbschemacfg->{$pd}->{tbl_name}.";");\r
- $bvaccum = 1;\r
- #print Dumper(@ainssql);\r
- my $stexec = 0;\r
- for(my $s=0;$s<scalar(@ainssql);$s++){\r
- if (defined($stexec)) { $stexec = $self->dbexec($ainssql[$s]); }\r
- }\r
- #print "tbl done\n";\r
- }\r
- elsif ($bexists == 0){\r
- my $sql_installnew = $defdbschemacfg->{$pd}->{sql};\r
- $self->dbexec($sql_installnew);\r
- }\r
- } elsif (($defdbschemacfg->{$pd}->{'type'} eq 'trigger') || ($defdbschemacfg->{$pd}->{'type'} eq 'index')) {\r
- my $bexists = 0; my $bupdate = 0;\r
- foreach my $pc (keys(%{$tcurcfg})){\r
- if (($tcurcfg->{$pc}->{tbl_name} eq $defdbschemacfg->{$pd}->{tbl_name}) && ($tcurcfg->{$pc}->{type} eq $defdbschemacfg->{$pd}->{type})){\r
- # print $defdbschemacfg->{$pd}->{type}.": ".$defdbschemacfg->{$pd}->{tbl_name}. "\n";\r
- if ($tcurcfg->{$pc}->{sql} ne $defdbschemacfg->{$pd}->{sql}){ $bupdate = 1; }\r
- $bexists = 1; last;\r
- }\r
- }\r
- if (($bexists==1) && ($bupdate== 1)){\r
- $bvaccum = 1;\r
- my @ainssql = ();\r
- if ($defdbschemacfg->{$pd}->{type} eq 'trigger'){\r
- push @ainssql,"DROP TRIGGER IF EXISTS ".$defdbschemacfg->{$pd}->{'name'}.";";\r
- } elsif ($defdbschemacfg->{$pd}->{type} eq 'index') {\r
- push @ainssql,"DROP INDEX IF EXISTS ".$defdbschemacfg->{$pd}->{'name'}.";";\r
- }\r
- push @ainssql,$defdbschemacfg->{$pd}->{'sql'};\r
- my $stexec = 0;\r
- for(my $s=0;$s<scalar(@ainssql);$s++){\r
- if (defined($stexec)) { $stexec = $self->dbexec($ainssql[$s]); }\r
- }\r
- }elsif ($bexists == 0) {\r
- my $sql_installnew = $defdbschemacfg->{$pd}->{sql};\r
- $self->dbexec($sql_installnew); #Test check\r
- }\r
- }\r
- }\r
- if ($bvaccum == 1) { $self->dbexec("vacuum;"); }\r
- }\r
- return [\r
- 200,\r
- [ 'Content-Type' => $ct.'; charset=utf-8','Cache-Control' => 'no-store, no-cache, must-revalidate', 'Access-Control-Allow-Origin'=> '*' ], \r
- [ JSON::PP::encode_json($html) ]\r
- ];\r
-}\r
-\r
-\r
-sub getcoldef($){\r
- my $self = shift;\r
- my $strddl = shift;\r
- my $curddl = $strddl;\r
- $curddl =~ s/\s+/\ /g;\r
- my $bi = index($curddl,'(')+1;\r
- my $ei = rindex($curddl,')');\r
- \r
- $curddl = substr($curddl,$bi,length($curddl)-$bi-(length($curddl)-$ei));#curddl.substring(curddl.indexOf('(')+1,curddl.lastIndexOf(')')).trim().replace(/\s+/g," ");\r
- my @colsfull = split(/,/,$curddl);# curddl =curddl.replace(new RegExp("\\b(" + appdb.keywords.join("|") + ")\\b", "g"), "");\r
- my $tblobj = ();\r
- foreach my $c (@colsfull){\r
- $c =~ s/^\s+//;\r
- $c =~ s/\s+$//;\r
- my @coldef = split(/\ /,$c);\r
- my $type = uc($coldef[1]);\r
- if (($type =~ /^TEXT/) || ($type =~ /^REAL/) || ($type =~ /^INTEGER/) || ($type =~ /^BOOLEAN/) || ($type =~ /^DATE/) || ($type =~ /^DATETIME/)) {\r
- $tblobj->{$coldef[0]} = $type;\r
- } \r
- }\r
- return $tblobj;\r
-}\r
-\r
-#sub dbbackup(){\r
-# my $self = shift;\r
-# my $path = shift;\r
-# my $type = shift;\r
-# \r
-# my @dx = localtime();\r
-# $dx[5] = $dx[5] +1900;\r
-# $dx[4] = $dx[4] +1;\r
-# if ($dx[4] < 10){$dx[4] = '0'.$dx[4];}\r
-# if ($dx[3] < 10){$dx[3] = '0'.$dx[3];}\r
-# if ($dx[2] < 10){$dx[2] = '0'.$dx[2];}\r
-# if ($dx[1] < 10){$dx[1] = '0'.$dx[1];}\r
-# if ($dx[0] < 10){$dx[0] = '0'.$dx[0];}\r
-# my $xdd = $dx[5].$dx[4].$dx[3].'_'.$dx[2].$dx[1].$dx[0];\r
-# my $bfile = "";\r
-# if ($type eq "binary" ) {\r
-# $bfile = $path.'/'.basename(substr($self->{dbfile},0,rindex($self->{dbfile},'.'))).'_'.$xdd.'.sqlite';\r
-# my $dbh = DBI->connect('DBI:SQLite:dbname='.$self->{dbfile},"","",{PrintError=>1,RaiseError=>1,AutoCommit=>1}) or die "dbexec Connection Error!".$!;\r
-# $dbh->sqlite_backup_to_file($bfile);\r
-# $dbh->disconnect();\r
-# }elsif($type eq "sql"){\r
-# $bfile = $path.'/'.basename($self->{dbfile}).'_'.$xdd.'.sql';\r
-# my $st = system('sqlite3 "'.$self->{dbfile}.'" ".dump" > '.$bfile);\r
-# }\r
-# return $bfile;\r
-#}\r
-#\r
-#sub dbrestore(){\r
-# my $self = shift;\r
-# my $file = shift;\r
-# my $type = shift;\r
-# if ($type eq "binary" ) {\r
-# my $dbh = DBI->connect('DBI:SQLite:dbname='.$self->{dbfile},"","",{PrintError=>1,RaiseError=>1,AutoCommit=>1}) or die "dbexec Connection Error!".$!;\r
-# $dbh->sqlite_backup_from_file($file);\r
-# $dbh->disconnect();\r
-# }elsif($type eq "sql"){\r
-# open(REST,$file) or die "cannot open restore file $file!\n";\r
-# my $rsql = "";\r
-# while (my $l = <REST>) {\r
-# $rsql .= $l;\r
-# }\r
-# close(REST);\r
-# unlink($self->{dbfile});\r
-# $self->dbexec($rsql);\r
-# }\r
-#}\r
-#\r
-#sub dbrepair(){\r
-# my $self = shift;\r
-# my $bfile = $self->dbbackup($ENV{'TMPDIR'},'sql');\r
-# $self->dbrestore($bfile,'sql');\r
-# unlink($bfile);\r
-#}\r
-\r
-\r
-1;
\ No newline at end of file
+++ /dev/null
-package Module::Service;\r
-\r
-use strict;\r
-use warnings;\r
-use File::Path qw(make_path);\r
-use File::Basename;\r
-use parent qw(Plack::Component);\r
-\r
-\r
-sub call {\r
- my($self, $env) = @_;\r
- if (($env->{REMOTE_ADDR} =~ "^127\.0\.") && \r
- ($env->{REMOTE_ADDR} =~ "^10\.") && \r
- ($env->{REMOTE_ADDR} =~ "^172\.16\.") && \r
- ($env->{REMOTE_ADDR} =~ "^192\.168\.")) {\r
- return [\r
- 404,\r
- [ 'Content-Type' => "text/html",'Cache-Control' => 'no-store, no-cache, must-revalidate' ], \r
- [ "Sorry no access allowed!" ]\r
- ];\r
- }\r
- return $self->service($env);\r
-}\r
-\r
-sub service() {\r
- my $self = shift;\r
- my $env = shift;\r
- my $html = "Unknown service!";\r
- my $ct="application/json";\r
- my $status=200;\r
- \r
- if ($env->{PATH_INFO} =~ /^\/info/){\r
- return $self->appinfo($env);\r
- }\r
- if ($env->{PATH_INFO} =~ /^\/preferences/){\r
- return $self->preferences($env);\r
- }\r
- if (($env->{PATH_INFO} =~ /^\/stop/) || ($env->{PATH_INFO} =~ /^\/unload/)){\r
- exit(0); \r
- }\r
- if ($env->{PATH_INFO} =~ /^\/shutdown/){\r
- system('sudo shudown -h now');\r
- $html = "shutdown launched";\r
- }\r
- if ($env->{PATH_INFO} =~ /^\/restart/){\r
- system('sudo shudown -r now');\r
- $html = "restart launched";\r
- }\r
- \r
- return [\r
- 200,\r
- [ 'Content-Type' => 'text/html','Cache-Control' => 'no-store, no-cache, must-revalidate' , 'Access-Control-Allow-Origin'=> '*'], \r
- [ $html ]\r
- ];\r
-};\r
-\r
-sub preferences(){\r
- my $self = shift;\r
- my $env =shift;\r
- my $name = basename($0);\r
- $name =~ s/srv\.pl$//;\r
- $name =~ s/srv\.exe$//;\r
- my $appcfgpath = "";\r
- if ($^O eq "MSWin32"){\r
- $appcfgpath = $ENV{APPDATA}.'/'.$name;\r
- } elsif ($^O eq "darwin"){\r
- $appcfgpath = $ENV{HOME}.'/Library/Application Support/'.$name;\r
- }\r
- \r
- $appcfgpath =~ s/\\/\//g;\r
- my $pref->{result}= ();\r
- my $req = Plack::Request->new($env);\r
- if (exists($req->query_parameters->{page})){\r
- if (-e $appcfgpath.'/'.$req->query_parameters->{page}.'.json'){\r
- open(PREF,$appcfgpath.'/'.$req->query_parameters->{page}.'.json');\r
- my $strpref = "";\r
- while (my $l = <PREF>){\r
- $strpref .= $l;\r
- }\r
- close(PREF);\r
- $pref->{result}=JSON::PP::decode_json($strpref); \r
- }\r
- if (exists($req->query_parameters->{set})){\r
- my $newpref = JSON::PP::decode_json($req->query_parameters->{set});\r
- foreach my $p (keys(%{$newpref})){\r
- $pref->{result}->{$p} = $newpref->{$p};\r
- }\r
- open(PREF,">".$appcfgpath.'/'.$req->query_parameters->{page}.'.json');\r
- print PREF JSON::PP::encode_json($pref->{result});\r
- close(PREF); \r
- }\r
- }\r
- return [\r
- 200,\r
- [ 'Content-Type' => "application/json",'Cache-Control' => 'no-store, no-cache, must-revalidate', 'Access-Control-Allow-Origin'=> '*' ], \r
- [ JSON::PP::encode_json($pref) ]\r
- ]; \r
-}\r
-\r
-sub appinfo(){\r
- my $self = shift;\r
- my $env = shift;\r
- my $html->{result} = ();\r
- my $req = Plack::Request->new($env);\r
- my $name = basename($0);\r
- $name =~ s/srv\.pl$//;\r
- $name =~ s/srv\.exe$//;\r
- $html->{result}->{OS} = $^O;\r
- $html->{result}->{app} = $name;\r
- if ($^O eq "MSWin32"){\r
- $html->{result}->{home} = $ENV{USERPROFILE}; \r
- $html->{result}->{user} = $ENV{USERNAME}; \r
- $html->{result}->{appcfgpath} = $ENV{APPDATA}.'/'.$name;\r
- $html->{result}->{hostname} = $ENV{COMPUTERNAME};\r
- $html->{result}->{arch} = $ENV{PROCESSOR_ARCHITEW6432};\r
- $html->{result}->{appcfgpath} =~ s/\\/\//g; \r
- $html->{result}->{home} =~ s/\\/\//g; \r
- } else {\r
- $html->{result}->{home} = $ENV{HOME}; \r
- $html->{result}->{user} = $ENV{USER}; \r
- if ($^O eq "darwin"){\r
- $html->{result}->{appcfgpath} = $ENV{HOME}.'/Library/Application Support/'.$name;\r
- } else {\r
- $html->{result}->{appcfgpath} = $ENV{HOME}.'/.'.$name.'/';\r
- } \r
- $html->{result}->{hostname} = `hostname -s`;\r
- chomp($html->{result}->{hostname});\r
- $html->{result}->{arch} = `uname -m`;\r
- chomp($html->{result}->{arch});\r
- }\r
- if (! -e $html->{result}->{appcfgpath}){\r
- make_path($html->{result}->{appcfgpath});\r
- }\r
- if (-e $html->{result}->{appcfgpath}.'/service.json'){\r
- open(LCFG,$html->{result}->{appcfgpath}.'/service.json');\r
- my $strprofile = "";\r
- while (my $l = <LCFG>){\r
- $strprofile .= $l;\r
- }\r
- close(LCFG);\r
- if ($strprofile ne ""){\r
- $html->{result}->{appconfig} = JSON::PP::decode_json($strprofile);\r
- }\r
- }\r
- if (!exists($html->{result}->{appconfig})){\r
- $html->result->{appconfig} = undef;\r
- }\r
- return [\r
- 200,\r
- [ 'Content-Type' => "application/json",'Cache-Control' => 'no-store, no-cache, must-revalidate', 'Access-Control-Allow-Origin'=> '*' ], \r
- [ JSON::PP::encode_json($html) ]\r
- ];\r
-}\r
-\r
-1;
\ No newline at end of file
+++ /dev/null
-package Module::System;\r
-\r
-use strict;\r
-use warnings;\r
-use parent qw(Plack::Component);\r
-use Plack::Request;\r
-use Data::Dumper;\r
-use File::Find::Rule;\r
-use File::Basename;\r
-use JSON::PP;\r
-use File::Path qw(make_path remove_tree);\r
-use File::Copy;\r
-use MIME::Types;\r
-if ($^O eq "MSWin32"){\r
- eval('use Win32::File; use Win32::GUI;');\r
-}\r
-\r
-sub call {\r
- my($self, $env) = @_;\r
- if (($env->{REMOTE_ADDR} =~ "^127\.0\.") && \r
- ($env->{REMOTE_ADDR} =~ "^10\.") && \r
- ($env->{REMOTE_ADDR} =~ "^172\.16\.") && \r
- ($env->{REMOTE_ADDR} =~ "^192\.168\.")) {\r
- return [\r
- 404,\r
- [ 'Content-Type' => "text/html",'Cache-Control' => 'no-store, no-cache, must-revalidate' ], \r
- [ "Sorry no remote access allowed!" ]\r
- ];\r
- }\r
- if ($env->{PATH_INFO} =~ /^\/search/){\r
- return $self->search($env); \r
- } elsif ($env->{PATH_INFO} =~ /^\/directory/) {\r
- return $self->directory($env);\r
- } elsif ($env->{PATH_INFO} =~ /^\/file/) {\r
- return $self->file($env);\r
- } elsif ($env->{PATH_INFO} =~ /^\/userenv/){\r
- return $self->userenv($env);\r
- } \r
- return [\r
- 404,\r
- [ 'Content-Type' => "text/html",'Cache-Control' => 'no-store, no-cache, must-revalidate' ], \r
- [ "Unknown System Request!" ]\r
- ];\r
-}\r
-\r
-sub search() {\r
- my $self = shift;\r
- my $env = shift;\r
- my $html->{result} = ();\r
- my $ct="application/json";\r
- my $status=200;\r
- my $req = Plack::Request->new($env);\r
- my $ff = File::Find::Rule->new;\r
- if (exists($req->query_parameters->{name})){\r
- my $namesearch = $req->query_parameters->{name};\r
- $ff->name($req->query_parameters->{name})\r
- }\r
- if (exists($req->query_parameters->{type})){\r
- if ($req->query_parameters->{type} eq 'd'){\r
- $ff->directory; \r
- } else {\r
- $ff->file;\r
- }\r
- }\r
- if (exists($req->query_parameters->{relative})){\r
- $ff->relative;\r
- }\r
- if (exists($req->query_parameters->{osspec})){\r
- $ff->canonpath;\r
- }\r
- my @data = $ff->in($req->query_parameters->{path});\r
- if (exists($req->query_parameters->{sorted})){\r
- @data = sort {$a cmp $b} @data;\r
- if ($req->query_parameters->{sorted} eq "desc"){\r
- @data = reverse(@data);\r
- } \r
- }\r
- $html->{result} = \@data;\r
- return [\r
- 200,\r
- [ 'Content-Type' => $ct,'Cache-Control' => 'no-store, no-cache, must-revalidate', 'Access-Control-Allow-Origin'=> '*' ], \r
- [ JSON::PP::encode_json($html) ]\r
- ];\r
-}\r
-\r
-sub directory() {\r
- my $self = shift;\r
- my $env = shift;\r
- my $html;\r
- my $ct="application/json";\r
- my $status=200;\r
- \r
- my $req = Plack::Request->new($env);\r
- if ($env->{PATH_INFO} =~ /^\/directory\/list/){\r
- my $mt = MIME::Types->new();\r
- $html->{result} = 0;\r
- if (exists($req->query_parameters->{path})){\r
- my $dir = $req->query_parameters->{path};\r
- #print $dir."\n";\r
- $html->{result} = {'path' => $dir};\r
- if (-d $dir){\r
- my @dirs = ();\r
- my @files = ();\r
- opendir(LDIR,$dir);\r
- while (my $f = readdir(LDIR)){\r
- if ($f =~ /^\./){ next; }\r
- \r
- if (-d $dir.'/'.$f){\r
- my $bok =1 ;\r
- if ($^O eq "MSWin32"){\r
- eval ('my $attr;\r
- Win32::File::GetAttributes($dir.\'/\'.$f,$attr);\r
- if ($attr & HIDDEN){\r
- $bok = 0;\r
- }');\r
- }\r
- if ($bok == 1){\r
- push(@dirs,$f); \r
- }\r
- \r
- } elsif (-f $dir.'/'.$f) {\r
- my $bok =1 ;\r
- if ($^O eq "MSWin32"){\r
- eval ('my $attr;\r
- Win32::File::GetAttributes($dir.\'/\'.$f,$attr);\r
- if ($attr & HIDDEN){\r
- $bok = 0;\r
- }');\r
- }\r
- if ($bok == 1){\r
- print $f."\n";\r
- my $fi->{name} = $f;\r
- my $mtf = $mt->mimeTypeOf($f);\r
- $fi->{mimetype} = (exists($mtf->{MT_simplified})?$mtf->{MT_simplified}:'unknown'); \r
- \r
- push(@files,$fi);\r
- }\r
- }\r
- }\r
- closedir(LDIR);\r
- $html->{result}->{directory} = \@dirs;\r
- $html->{result}->{file} = \@files;\r
- }\r
- }\r
- }\r
- if ($env->{PATH_INFO} =~ /^\/directory\/exists/){\r
- $html->{result} = 0;\r
- if (exists($req->query_parameters->{path})){\r
- if (-d $req->query_parameters->{path}){\r
- $html->{result} = 1;\r
- }\r
- }\r
- }\r
- if ($env->{PATH_INFO} =~ /^\/directory\/make/){\r
- make_path($req->query_parameters->{path});\r
- $html->{result} = 0;\r
- if (-d $req->query_parameters->{path}){\r
- $html->{result} = 1;\r
- }\r
- }\r
- if ($env->{PATH_INFO} =~ /^\/directory\/delete/){\r
- my $keep_root = 0;\r
- if (exists($req->query_parameters->{keep_root})){\r
- $keep_root = 1;\r
- }\r
- $html->{result} = 0;\r
- if (-d $req->query_parameters->{path}){\r
- remove_tree( $req->query_parameters->{path}, {keep_root => $keep_root} );\r
- $html->{result} = 1;\r
- }\r
- }\r
- return [\r
- 200,\r
- [ 'Content-Type' => $ct,'Cache-Control' => 'no-store, no-cache, must-revalidate', 'Access-Control-Allow-Origin'=> '*' ], \r
- [ JSON::PP::encode_json($html) ]\r
- ];\r
-}\r
-\r
-sub file() {\r
- my $self = shift;\r
- my $env = shift;\r
- my $html->{result} = ();\r
- my $ct="application/json";\r
- my $status=200;\r
- \r
- my $req = Plack::Request->new($env);\r
- if ($env->{PATH_INFO} =~ /^\/file\/exists/){\r
- $html->{result} = 0;\r
- if (exists($req->query_parameters->{path})){\r
- if (-f $req->query_parameters->{path}){\r
- $html->{result} = 1;\r
- }\r
- }\r
- }\r
- if ($env->{PATH_INFO} =~ /^\/file\/write/){\r
- $html->{result} = 0;\r
- if (exists($req->query_parameters->{path})){\r
- if (! -d (dirname($req->query_parameters->{path}))){\r
- make_path(dirname($req->query_parameters->{path}))\r
- }\r
- my $fwrite = ">";\r
- if (exists($req->query_parameters->{append})){\r
- $fwrite = ">>"; \r
- }\r
- my $datax = $req->body_parameters->{data};\r
- print $req->body_parameters->{data}."\n";\r
- open(WFI,$fwrite.$req->query_parameters->{path});\r
- print WFI $req->body_parameters->{data};\r
- close(WFI);\r
- $html->{result} = 1;\r
- }\r
- }\r
- if ($env->{PATH_INFO} =~ /^\/file\/read/){\r
- $html->{result} = "";\r
- if (exists($req->query_parameters->{path})){\r
- if (-f $req->query_parameters->{path}){\r
- my $rdata = "";\r
- open(RFI,$req->query_parameters->{path});\r
- while ( my $l = <RFI>){\r
- $rdata .= $l; \r
- } \r
- close(RFI);\r
- $html->{result} = $rdata;\r
- }\r
- }\r
- }\r
- if ($env->{PATH_INFO} =~ /^\/file\/copy/){\r
- $html->{result} = "";\r
- if (exists($req->query_parameters->{src})){ \r
- if (-f $req->query_parameters->{src}){\r
- my $dest = $req->query_parameters->{dest};\r
- if (! -d dirname($req->query_parameters->{dest})){\r
- make_path(dirname($req->query_parameters->{dest}))\r
- }\r
- if ($req->query_parameters->{src} ne $req->query_parameters->{dest}){\r
- my $cp = copy($req->query_parameters->{src},$req->query_parameters->{dest});\r
- $html->{result} = $cp; \r
- } else {\r
- $html->{result} = 1;\r
- }\r
- }\r
- }\r
- \r
- }\r
- if ($env->{PATH_INFO} =~ /^\/file\/move/){\r
- $html->{result} = "";\r
- if (exists($req->query_parameters->{src})){ \r
- if (-f $req->query_parameters->{src}){\r
- my $dest = $req->query_parameters->{dest};\r
- if (! -d dirname($req->query_parameters->{dest})){\r
- make_path(dirname($req->query_parameters->{dest}))\r
- }\r
- if ($req->query_parameters->{src} ne $req->query_parameters->{dest}){\r
- my $cp = move($req->query_parameters->{src},$req->query_parameters->{dest});\r
- $html->{result} = $cp; \r
- } else {\r
- $html->{result} = 0;\r
- }\r
- }\r
- }\r
- \r
- }\r
- if ($env->{PATH_INFO} =~ /^\/file\/dialog/){\r
- if ($^O eq "MSWin32"){\r
- my $multisel = 0;\r
- if (exists($req->query_parameters->{multisel})){\r
- $multisel = $req->query_parameters->{multisel};\r
- }\r
- my $title = "select file";\r
- if (exists($req->query_parameters->{title})){\r
- $title = $req->query_parameters->{title};\r
- } \r
- my $lastdir = $ENV{USERPROFILE};\r
- if (exists($req->query_parameters->{dir})){\r
- $lastdir = $req->query_parameters->{dir}\r
- }\r
- my @filters = ['All Files - *', '*'];\r
- if(exists($req->query_parameters->{filters})){\r
- my @newfilters = split(',',$req->query_parameters->{filters});\r
- push(@newfilters,'All Files - *','*');\r
- $filters[0] = \@newfilters;\r
- }\r
- my ( @file);\r
- my ( @parms );\r
- push (@parms,-filter => @filters,-directory => $lastdir,-title => $title,-multisel => $multisel,-filemustexist => 1,-pathmustexist => 1);\r
- @file = Win32::GUI::GetOpenFileName ( @parms );\r
- $html->{result}->{files} = \@file;\r
- }\r
- }\r
- if ($env->{PATH_INFO} =~ /^\/file\/open/){\r
- if ( (exists($req->query_parameters->{file})) && (-e $req->query_parameters->{file}) ){\r
- if ($^O eq "MSWin32"){\r
- my $st = system('start /b "" "'.$req->query_parameters->{file}.'"');\r
- $html->{result} = $st; \r
- }\r
- } else {\r
- $html->{result} = -1000;\r
- }\r
- \r
- }\r
- if ($env->{PATH_INFO} =~ /^\/file\/delete/){\r
- if ( (exists($req->query_parameters->{file})) && (-e $req->query_parameters->{file}) ){\r
- unlink($req->query_parameters->{file});\r
- $html->{result} = 1; \r
- } else {\r
- $html->{result} = 0;\r
- }\r
- \r
- }\r
- if ($env->{PATH_INFO} =~ /^\/file\/rename/){\r
- $html->{result} = "";\r
- if (exists($req->query_parameters->{src})){ \r
- if (-f $req->query_parameters->{src}){\r
- my $dest = $req->query_parameters->{dest};\r
- if (! -d dirname($req->query_parameters->{dest})){\r
- make_path(dirname($req->query_parameters->{dest}))\r
- }\r
- if ($req->query_parameters->{src} ne $req->query_parameters->{dest}){\r
- my $cp = rename($req->query_parameters->{src},$req->query_parameters->{dest});\r
- $html->{result} = $cp; \r
- } else {\r
- $html->{result} = 1;\r
- }\r
- }\r
- }\r
- \r
- }\r
- \r
-\r
- return [\r
- 200,\r
- [ 'Content-Type' => $ct,'Cache-Control' => 'no-store, no-cache, must-revalidate', 'Access-Control-Allow-Origin'=> '*' ], \r
- [ JSON::PP::encode_json($html) ]\r
- ];\r
-}\r
-\r
-\r
-sub userenv() {\r
- my $self = shift;\r
- my $env = shift;\r
- my $html->{result} = ();\r
- my $ct="application/json";\r
- my $status=200;\r
- \r
- my $req = Plack::Request->new($env);\r
- foreach my $k (keys(%ENV)){\r
- $html->{result}->{$k} = $ENV{$k};\r
- }\r
- \r
- return [\r
- 200,\r
- [ 'Content-Type' => $ct,'Cache-Control' => 'no-store, no-cache, must-revalidate', 'Access-Control-Allow-Origin'=> '*' ], \r
- [ JSON::PP::encode_json($html) ]\r
- ];\r
-}\r
-\r
-#sub filedialog() {\r
-# my $self = shift;\r
-# my $env = shift;\r
-# my $html->{result} = ();\r
-# my $ct="application/json";\r
-# my $status=200;\r
-# my $req = Plack::Request->new($env);\r
-# \r
-# if ($^O eq "MSWin32"){\r
-# my $multisel = 0;\r
-# if (exists($req->query_parameters->{multisel})){\r
-# $multisel = $req->query_parameters->{multisel};\r
-# }\r
-# my $title = "select file";\r
-# if (exists($req->query_parameters->{title})){\r
-# $title = $req->query_parameters->{title};\r
-# } \r
-# my $lastdir = $ENV{USERPROFILE};\r
-# if (exists($req->query_parameters->{dir})){\r
-# $lastdir = $req->query_parameters->{dir}\r
-# }\r
-# my @filters = ['All Files - *', '*'];\r
-# if(exists($req->query_parameters->{filters})){\r
-# unshift(@filters,$req->query_parameters->{filters});\r
-# }\r
-# my ( @file);\r
-# my ( @parms );\r
-# push (@parms,-filter => @filters,-directory => $lastdir,-title => $title,-multisel => $multisel,-filemustexist => 1,-pathmustexist => 1,);\r
-# @file = Win32::GUI::GetOpenFileName ( @parms );\r
-# $html->{result}->{files} = \@file;\r
-# }\r
-# return [\r
-# 200,\r
-# [ 'Content-Type' => $ct,'Cache-Control' => 'no-store, no-cache, must-revalidate', 'Access-Control-Allow-Origin'=> '*' ], \r
-# [ JSON::PP::encode_json($html) ]\r
-# ];\r
-#}\r
-1;
\ No newline at end of file
+++ /dev/null
-package Module::Test;\r
-\r
-use strict;\r
-use warnings;\r
-use parent qw(Plack::Component);\r
-use Plack::Request;\r
-use Data::Dumper;\r
-\r
-sub call {\r
- my($self, $env) = @_;\r
- #$self->_app->($env);\r
- if (($env->{REMOTE_ADDR} =~ "^127\.0\.") && \r
- ($env->{REMOTE_ADDR} =~ "^10\.") && \r
- ($env->{REMOTE_ADDR} =~ "^172\.16\.") && \r
- ($env->{REMOTE_ADDR} =~ "^192\.168\.")) {\r
- return [\r
- 404,\r
- [ 'Content-Type' => "text/html",'Cache-Control' => 'no-store, no-cache, must-revalidate' ], \r
- [ "Sorry no remote access allowed!" ]\r
- ];\r
- }\r
- return $self->test($env);\r
-}\r
-\r
-sub test(){\r
- my $self = shift;\r
- my $env = shift;\r
- my $html = "";\r
- my $ct="application/json";\r
- my $status=200;\r
- my $request = Plack::Request->new($env);\r
- $html .= "<h1>System Environement</h1>";\r
- foreach my $k (keys(%ENV)){\r
- $html.= '<strong>'.$k.':</strong>'.$ENV{$k}."<br/>\n";\r
- }\r
- $html .= "<h1>Request Header</h1>";\r
- foreach my $k (keys(%{$env})){\r
- $html .= '<strong>'.$k.':</strong>'.$env->{$k}."<br/>\n";\r
- }\r
- $html .= "<h1>GET PARAMETERS</h1>";\r
- $html .= Dumper($request->query_parameters);\r
- $html .= "<h1>POST PARAMETERS</h1>";\r
- $html .= Dumper($request->body_parameters);\r
- print "Test Called!\n";\r
- return [\r
- 200,\r
- [ 'Content-Type' => "text/html",'Cache-Control' => 'no-store, no-cache, must-revalidate' ], \r
- [ $html ]\r
- ];\r
-};\r
-\r
-\r
-1;
\ No newline at end of file
projects / creorga.git / commitdiff