#!/usr/bin/perl -w
# file KLEIDER/web/src/pinw/pival.pl
# Wert einer Verarbeitungs-Anweisung
# 2020-05-24 Herbert Schiemann <h.schiemann@herbaer.de>

use utf8;                # Dieser Quelltext ist utf-8-kodiert
use Herbaer::Readargs;   # read_args ()

binmode (STDERR, ":encoding(utf-8)");
binmode (STDOUT, ":encoding(utf-8)");

my $args = {
   "[cnt]verbose" => 0,
   "pi"           => "install",
   "key"          => "location",
   "mode"         => "auto",
   "maxlines"     => 10,
};

# gibt die Version nach STDOUT aus
sub version {
   print << 'VERSION';
KLEIDER/web/src/pinw/pival.pl
Wert einer Verarbeitungs-Anweisung
2020-05-24 Herbert Schiemann <h.schiemann@herbaer.de>
VERSION
};
$args -> {"[sr]version"} = sub { version (); exit 0; };

$args -> {"[sr]help"} = sub {
   version ();
   print_message_with_values (<<"HELP", $args);
usage
$0 [option] ... < file

$0 --help     zeigt diese Hilfe an
$0 --version  zeigt die Programm-Version an

$0 [option]...
--[no_]verbose       Meldungen nach STDERR ausgeben \${[cnt]verbose}
--pi       PI        Name der Verarbeitungsanweisung \${pi}
--key      KEY       Name der Pseudo-Attributs \${key}
--mode     MOD       Art der Kommentierung: auto | xml | script | c | sql | lisp
                     \${mode}
--maxlines MAXLINES  die ersten MAXLINES Zeilen werden durchsucht \${maxlines}
HELP
   exit 0;
}; # help

read_args   ($args);

my $line;
my $ln = 0;
my $maxln = $args -> {"maxlines"};
my $mode  = $args -> {"mode"};
my $pi    = quotemeta ($args -> {"pi"});
my $key   = quotemeta ($args -> {"key"});
my $verb  = $args -> {"[cnt]verbose"};

$pi = 
   "<\\?$pi"
   . "(?>\\s+[a-zA-Z0-9_-]+\\s*=\\s*\"[^\"]*\")*?"
   . "(?>\\s+$key\\s*=\\s*\"([^\"]*)\")"
   . "(?>\\s+[a-zA-Z0-9_-]+\\s*=\\s*\"[^\"]*\")*"
   . "\\s*\\?>";

my $re;
while (defined ($line = <STDIN>) && $ln++ < $maxln) {
   if ($ln == 1) {
      if ($mode eq "auto") {
         $mode =
            $line =~ /^<?xml\b/                                  ? "xml"    :
            $line =~ /^#!\s*\S*?\/(?:perl|bash|sh)\b/            ? "script" :
            $line =~ /^#!\s*\S*?\/(?:lisp|elisp|guile|scheme)\b/ ? "lisp"   :
            $line =~ /^#/                                        ? "script" :
            $line =~ /^\/\*.*\*\/$/                              ? "c"      :
            $line =~ /^--\s/                                     ? "sql"    :
            "auto"   ;
      }
      $re =
         $mode eq "script" ? qr/^\s*#+\s*$pi\s*$/o          :
         $mode eq "lisp"   ? qr/^\s*;+\s*$pi\s*$/o          :
         $mode eq "c"      ? qr/^\s*\/\*\s*$pi\s*\*\/\s*$/o :
         $mode eq "sql"    ? qr/^\s*--+\s*$pi\s*$/o         :
         $mode eq "xml"    ? qr/^\s*$pi\s*$/o               :
         $mode eq "strict" ? qr/^$pi$/o                     :
         qr/$pi/o ;
      if ($verb) {
         print STDERR "MODE $mode\n";
         print STDERR "REGEX ";
         print STDERR $re;
         print STDERR "\n";
      }
   }
   print STDERR "LINE $line" if $verb;
   if ($line =~ $re) {
      print STDERR "MATCH\n" if $verb;
      print $1;
      exit;
   }
}

# end of file KLEIDER/web/src/pinw/pival.pl