From: Kilian Saffran <ksaffran@dks.lu>
Date: Sat, 16 Mar 2019 08:05:50 +0000 (+0100)
Subject: sqlite cgi
X-Git-Url: http://cloud.dks.lu/git/?a=commitdiff_plain;h=95e2bdc8d2dc055c0372c9102feae17a1cf12f8d;p=dks_server.git

sqlite cgi
---

diff --git a/bin/pdftest.pdf b/bin/pdftest.pdf
deleted file mode 100644
index 97151b5..0000000
Binary files a/bin/pdftest.pdf and /dev/null differ
diff --git a/bin/pdftextblock.pl b/bin/pdftextblock.pl
new file mode 100644
index 0000000..c4e548b
--- /dev/null
+++ b/bin/pdftextblock.pl
@@ -0,0 +1,29 @@
+#!/usr/bin/env perl
+use strict;
+use PDF::API2;
+use PDF::TextBlock;
+
+my $pdf = PDF::API2->new( -file => "40-demo.pdf" );
+my $tb  = PDF::TextBlock->new({
+   
+   pdf       => $pdf,
+   fonts     => {
+      b => PDF::TextBlock::Font->new({
+         pdf  => $pdf,
+         font => $pdf->corefont( 'Helvetica-Bold', -encoding => 'latin1' ),
+      }),
+      i => PDF::TextBlock::Font->new({
+        pdf => $pdf,
+        font => $pdf->corefont('Helvetica-Oblique')
+      })
+   },
+});
+$tb->text(
+   ' <b>This fairly lengthy</b>, rather <i>verbose sentence</i> <b>is tagged</b> to appear ' .
+   ' <href="http://www.dks.lu">Click here to visit Omni Hotels.</href> ' . "\n\n" .
+   "New paragraph.\n\n" .
+   "Another paragraph."
+);
+$tb->apply;
+$pdf->save;
+$pdf->end;
\ No newline at end of file
diff --git a/bin/qrcode.bmp b/bin/qrcode.bmp
new file mode 100644
index 0000000..3c10cff
Binary files /dev/null and b/bin/qrcode.bmp differ
diff --git a/bin/qrcode.pl b/bin/qrcode.pl
new file mode 100644
index 0000000..fb02cdf
--- /dev/null
+++ b/bin/qrcode.pl
@@ -0,0 +1,13 @@
+#!/user/bin/env perl
+
+use Imager::QRCode;
+ 
+my $qrcode = Imager::QRCode->new(
+    lightcolor    => Imager::Color->new(255, 255, 255),
+    darkcolor     => Imager::Color->new(0, 0, 0),
+);
+my $img = $qrcode->plot("http://www.hand-hand-afrika.lu");
+$img->write(file => "qrcode.jpg")
+  or die "Failed to write: " . $img->errstr;
+
+ 
diff --git a/cgi/sqlite.cgi b/cgi/sqlite.cgi
new file mode 100644
index 0000000..2af46ea
--- /dev/null
+++ b/cgi/sqlite.cgi
@@ -0,0 +1,139 @@
+#!/usr/bin/env perl
+
+use strict;
+use CGI;
+use CGI::Carp;
+use File::Basename;
+use DBI;
+use lib (dirname($0).'/lib');
+use DBD::sqlite;
+use JSON::PP;
+
+my $cgi = new CGI();
+
+my $p = ();
+my @params = $cgi->param();
+foreach my $pe (@params){
+  $p->{$pe} = $cgi->param($pe);
+}
+print $cgi->header(-type=>"application/json", -charset => "utf-8");
+my $html = ();
+if (exists($p->{db}) && (-e dirname($0).'/db/'.$p->{db}.'.sqlite')){
+  if (exists($p->{type}) && exists($p->{sql})){
+    
+    if (($p->{type} eq "query") && (exists($p->{key}))){
+      $html->{sqldata} = &dbquery($p->{key},$p->{sql});
+    } elsif ($p->{type} eq "querysorted"){
+      $html->{sqldata} = &dbquerysorted($p->{sql});
+    } elsif ($p->{type} eq "queryarray"){
+      $html->{sqldata} = &dbqueryarray($p->{sql});
+    } elsif ($p->{type} eq "exec"){
+      $html->{sqldata} = &dbexec($p->{sql});
+    }
+    print JSON::PP::encode_json($html);
+  }
+}
+
+# sub strreplace(){
+#     my $self = shift;
+#     my $text = shift;
+#     $text =~ s/'/''/g;
+#     return $text;
+# }
+
+sub dbquery(){
+    my $key = shift;
+    my $stat = shift;
+    my $retdata =();
+    my $dbh = DBI->connect('DBI:SQLite:dbname='.$dirname($0).'/db/'.$p->{db}.'.sqlite',"","",{PrintError=>1,RaiseError=>1,AutoCommit=>1}) or return ();
+    #$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 return (); #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 $stat = shift;
+    my $retdata = ();
+     my $dbh = DBI->connect('DBI:SQLite:dbname='.$dirname($0).'/db/'.$p->{db}.'.sqlite',"","",{PrintError=>1,RaiseError=>1,AutoCommit=>1})  or return (); #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 return (); #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 $stat = shift;
+    my @retdata = ();
+     my $dbh = DBI->connect('DBI:SQLite:dbname='.$dirname($0).'/db/'.$p->{db}.'.sqlite',"","",{PrintError=>1,RaiseError=>1,AutoCommit=>1})  or return (); #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 return (); #print "dbquery: ".$sth->errstr;
+   my $count = 0;
+   
+   while(my $valdata = $sth->fetchrow_arrayref())
+   {
+   		if ($valdata == undef){ 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 $stat = shift;
+    my $dbh = DBI->connect('DBI:SQLite:dbname='.$dirname($0).'/db/'.$p->{db}.'.sqlite',"","",{PrintError=>1,AutoCommit=>1})  or return (); #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 return (); #or print "Failed dbexec:\n'".$stat. "'\n\n";
+   $dbh->disconnect();
+   return $rv;
+}
\ No newline at end of file