CREATE OR REPLACE FUNCTION ext.rfile(varchar) RETURNS text AS $$
   local $/;  open FILE, $_[0]; 
   my $cntn = <FILE>; close FILE;
   return $cntn;
$$ LANGUAGE plperlu;
SELECT ext.rfile('/proc/sys/kernel/random/uuid');

CREATE OR REPLACE FUNCTION ext.rtab(varchar, varchar) RETURNS SETOF RECORD AS $$
   open FILE, $_[0]; my @cntn = ();
   while (<FILE>) { chop; 
      my @items = map {s/^\s+|\s+$//g; $_;}  split ($_[1]);
      my %iitems; @iitems{map 'col'.$_, 0..$#items} = @items;
      push @cntn, \%iitems; }
   close FILE;
   return \@cntn; 
$$ LANGUAGE plperlu;
CREATE VIEW ext.passwd AS SELECT col0 AS account, col1 AS passwd, col2 AS uid,
       col3 AS gid, col4 AS description, col5 AS home,
       col6 AS shell FROM ext.rtab('/etc/passwd',':') 
  AS (col0  varchar, col1 varchar, col2 integer,
      col3 integer, col4 varchar, col5 varchar,
      col6 varchar) limit 10;
CREATE VIEW ext.cpu AS SELECT col0 AS name, col1 AS value 
  FROM ext.rtab('/proc/cpuinfo',':') AS
    (col0 varchar, col1 varchar);
SELECT col0 AS name, col1 AS value 
  FROM ext.rtab('/proc/self/status',':') AS
    (col0 varchar, col1 varchar);

CREATE OR REPLACE FUNCTION ext.rre(varchar, varchar) RETURNS SETOF RECORD AS $$
   my $re = $_[1]; my @cntn = (); open FILE, $_[0]; 
   while (<FILE>) { chop; 
      my @items = ($_ =~ m/$re/o);	
      my %iitems; @iitems{map 'col'.$_, 0..$#items} = @items;
      push @cntn, \%iitems; }
   close FILE;
   return \@cntn; 
$$ LANGUAGE plperlu;
SELECT col0 AS host, col1 AS rfc931, col2 AS user,
       col3 AS date, col4 AS request, col5 AS url,
       col6 AS status, col7 AS bytes FROM ext.rre('/usr/local/apache/logs/elog',
  '(\\S+) (\\S+) (\\S+) \\[([^]]+)\\] "(\\w+) (\\S+).*" (\\d+) (\\S+)') AS
  (col0 inet, col1 varchar, col2 varchar, 
   col3 timestamp(0), col4 varchar, col5 varchar, 
   col6 integer, col7 varchar) limit 10;

CREATE OR REPLACE FUNCTION ext.rmysql(varchar, varchar, varchar, varchar) RETURNS SETOF RECORD AS $$
   use DBI;
   my $dbh = DBI->connect('dbi:mysql:'.$_[0],$_[1],$_[2], 
      { RaiseError => 1, AutoCommit => 1 });
   $dbh->do("set character_set_results='latin2'");
   my $sth = $dbh->prepare($_[3]);
   $sth->execute(); my $myref; 
   while ($dat = $sth->fetchrow_hashref) {push @$myref, $dat; }
   $sth->finish(); $dbh->disconnect();
   return $myref;
$$ LANGUAGE plperlu;

CREATE VIEW ext.jmena AS SELECT * FROM ext.rmysql('databaze:smudla','uzivatel','*****',
  'SELECT ixkontakt, jmeno, prijmeni, titul, email, tel1 FROM kontakt') AS
  (ixkontakt integer, jmeno varchar, prijmeni varchar, 
   titul varchar, email varchar, tel1 varchar);

CREATE OR REPLACE FUNCTION ext.xml(varchar, varchar) RETURNS text AS $$
   use DBI;
   use XML::Generator::DBI;
   use XML::Handler::YAWriter;
   my $rv = spi_exec_query("SELECT current_setting('client_encoding'), " .
                           "current_database()", 1);
   my $encoding = lc($rv->{rows}[0]->{current_setting[5~});
   my $cdb = $rv->{rows}[0]->{current_database};
   my $dbh = DBI->connect ("DBI:Pg:dbname=$cdb", "", "", { RaiseError => 1, PrintError => 0});
   my $ya = XML::Handler::YAWriter->new (Encoding=>$encoding, 
        Pretty => {PrettyWhiteNewline => 1, PrettyWhiteIndent => 1,});
   my $gen = XML::Generator::DBI->new (Handler => $ya, dbh => $dbh,
                                       ByColumnName => 1, ShowColumns => 1,
				       Stylesheet => $_[1],);
   $gen->execute ($_[0]);
   $dbh->disconnect ();
   return join('',@{$ya->{Strings}});
$$ LANGUAGE plperlu;
SELECT ext.xml('SELECT * FROM ext.jmena LIMIT 10','x01.xsl');

-- Expat pouziva pouze iso-8859-2 nebo windows-1250 kodovani
-- a nezna synonyma, napr. latin2 (encmap jsem sice generoval
-- ale neuspesne: prikazy make_encmap a compile_encoding

CREATE OR REPLACE FUNCTION ext.rxml(varchar) RETURNS SETOF RECORD AS $$
   use XML::Parser; use Encode;
   my %rec; my @tref = ();
   my $parser = new XML::Parser (
      Handlers => {
         Start => sub {
	    my ($p, $tag) = @_; 
            if ($tag eq "row" && $p->depth==2) { %rec = ();}},
         End   => sub {
            my ($p, $tag) = @_;
	    if ($tag eq 'row') {push @tref, +{ %rec }; }},
         Char  => sub {
            my ($p, $data) = @_; 
            my $tag = $p->current_element ();
	    if ($p->depth == 4) {
	       chomp $data; $data =~ s/\^s+|\s+$//g;
	       $rec{$tag} .= encode("iso-8859-2", $data) if $data ne "";}}, 
      });
   $parser->parsefile ($_[0]);
   return \@tref;
$$ LANGUAGE plperlu;

CREATE VIEW ext.xmlj AS SELECT * FROM ext.rxml('/tmp/jmena.xml') AS (
  ixkontakt integer, jmeno varchar, prijmeni varchar, 
  titul varchar, email varchar, tel1 varchar);

CREATE OR REPLACE FUNCTION ext.amazon_search(varchar) RETURNS SETOF ext.amazon_lst AS $$
   my $dev_token='insert developer token';
   my $af_tag='insert associate tag';
   my $amazon_wdsl = "http://soap.amazon.com/schemas2/AmazonWebServices.wsdl";
   use strict;
   use SOAP::Lite;
   my $amazon_search = SOAP::Lite->service("$amazon_wdsl");
   my $results = $amazon_search -> 
      KeywordSearchRequest(SOAP::Data->name("KeywordSearchRequest")
         ->type("KeywordRequest")
            ->value(\SOAP::Data->value(
				      SOAP::Data->name("keyword" => $_[0]),
				      SOAP::Data->name("page" => "1"),
				      SOAP::Data->name("mode" => "books"),
				      SOAP::Data->name("tag" => $af_tag),
				      SOAP::Data->name("type" => "lite"),
				      SOAP::Data->name("devtag" => $dev_token),
        ))
   );
   my @listbooks = (); 
   foreach my $result (@{$results->{Details}}){
      $result->{UsedPrice} =~ s/\$//g;
      push @listbooks, {
         productname => $result->{ProductName}|| "no title", 
         authors => "{".join (', ', @{$result->{Authors}}) . "}",
         price => $result->{UsedPrice},
         asin => $result->{Asin}}
   }
   return \@listbooks;
$$ LANGUAGE plperlu;
select * from ext.amazon_search('xml perl');