diff options
author | Norbert Preining <norbert@preining.info> | 2022-02-05 03:00:59 +0000 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2022-02-05 03:00:59 +0000 |
commit | 08ccf305ee79ab8e5ba9d1a8f3d22e74dccedd80 (patch) | |
tree | 814254dfa55b15022a4361ba4e12cccdcdac1f2a /support/SQLTeX/SQLTeX.pl | |
parent | b7a48c5e229d2c195b6a32bfd73a1036a31f2df3 (diff) |
CTAN sync 202202050300
Diffstat (limited to 'support/SQLTeX/SQLTeX.pl')
-rwxr-xr-x | support/SQLTeX/SQLTeX.pl | 1001 |
1 files changed, 0 insertions, 1001 deletions
diff --git a/support/SQLTeX/SQLTeX.pl b/support/SQLTeX/SQLTeX.pl deleted file mode 100755 index e1adfa0767..0000000000 --- a/support/SQLTeX/SQLTeX.pl +++ /dev/null @@ -1,1001 +0,0 @@ -################################################################################ -# -# SQLTeX - SQL preprocessor for Latex -# -# File: SQLTeX -# ===== -# -# Purpose: This script is a preprocessor for LaTeX. It reads a LaTeX file -# ======== containing SQL commands, and replaces them their values. -# -# This software is subject to the terms of the LaTeX Project Public License; -# see http://www.ctan.org/tex-archive/help/Catalogue/licenses.lppl.html. -# -# Copyright: (c) 2001-2016, Oscar van Eijk, Oveas Functionality Provider -# ========== oscar@oveas.com -# -# History: -# ======== -# v1.3 Mar 16, 2001 (Initial release) -# v1.4 May 2, 2002 -# v1.4.1 Feb 15, 2005 -# v1.5 Nov 23, 2007 -# v2.0 Jan 12, 2016 -# Refer to the documentation for changes per release -# -# TODO: -# ===== -# Code is getting messy - too many globals: rewrite required -# -################################################################################ -# -use strict; -use DBI; -use Getopt::Std; - -##### -# Find out if any command-line options have been given -# Parse them using 'Getopt' -# -sub parse_options { - - $main::NULLallowed = 0; - - if (!getopts ('c:E:NPU:Ve:fhmMo:p:r:qs:u', \%main::options)) { - print (&short_help (1)); - exit(1); - } - - if (defined $main::options{'h'}) { - &print_help; - exit(0); - } - if (defined $main::options{'V'}) { - &print_version; - exit(0); - } - - my $optcheck = 0; - $optcheck++ if (defined $main::options{'E'}); - $optcheck++ if (defined $main::options{'e'}); - $optcheck++ if (defined $main::options{'o'}); - die ("options \"-E\", \"-e\" and \"-o\" cannot be combined\n") if ($optcheck > 1); - - $optcheck = 0; - $optcheck++ if (defined $main::options{'m'}); - $optcheck++ if (defined $main::options{'M'}); - $optcheck++ if (defined $main::options{'o'}); - die ("options \"-m\", \"-M\" and \"-o\" cannot be combined\n") if ($optcheck > 1); - - $main::NULLallowed = 1 if (defined $main::options{'N'}); - $main::configuration{'cmd_prefix'} = $main::options{'p'} if (defined $main::options{'p'}); - - $main::multidoc_cnt = 0; - $main::multidoc = (defined $main::options{'m'} || defined $main::options{'M'}); - $main::multidoc_id = ''; - - if ($main::multidoc) { - $main::multidoc_id = '_#M#'; - if (defined $main::options{'M'}) { - $main::multidoc_id = '_#P#' - } - } - -} - -##### -# Print the Usage: line on errors and after the '-h' switch -# -sub short_help ($) { - my $onerror = shift; - my $helptext = "usage: $main::myself [-cENPUVefhmopqs] <file[.$main::configuration{'texex'}]> [parameter...]\n"; - $helptext .= " type \"$main::myself -h\" for help\n" if ($onerror); - return ($helptext); -} - - -##### -# Print full help and after the '-h' switch -# -sub print_help { - my $helptext = &short_help (0); - $helptext .= " Options:\n"; - $helptext .= " -c file SQLTeX configuration file.\n"; - $helptext .= " Default is \'$main::my_location/SQLTeX.cfg\'.\n"; - $helptext .= " -E string replace input file extension in outputfile:\n"; - $helptext .= " \'input.tex\' will be \'input.string\'\n"; - $helptext .= " For further notes, see option \'-e\' below\n"; - $helptext .= " -N NULL return values allowed. By default SQLTeX\n"; - $helptext .= " exits if a query returns an empty set\n"; - $helptext .= " -P prompt for database password\n"; - $helptext .= " -U user database username\n"; - $helptext .= " -V print version number and exit\n"; - $helptext .= " -e string add string to the output filename:\n"; - $helptext .= " \'input.tex\' will be \"inputstring.tex\"\n"; - $helptext .= " In \'string\', the values between curly braces \{\}\n"; - $helptext .= " will be substituted:\n"; - $helptext .= " Pn parameter n\n"; - $helptext .= " M current monthname (Mon)\n"; - $helptext .= " W current weekday (Wdy)\n"; - $helptext .= " D current date (yyyymmdd)\n"; - $helptext .= " DT current date and time (yyyymmddhhmmss)\n"; - $helptext .= " T current time (hhmmss)\n"; - $helptext .= " e.g., the command \'$main::myself -e _{P1}_{W} my_file code\'\n"; - $helptext .= " will read \'my_file.tex\' and write \'myfile_code_Tue.tex\'\n"; - $helptext .= " The same command, but with option \'-E\' would create the\n"; - $helptext .= " outputfile \'myfile._code_Tuesday\'\n"; - $helptext .= " By default (without \'-e\' or \'-E\') the outputfile\n"; - $helptext .= " \'myfile_stx.tex\' would have been written.\n"; - $helptext .= " The options \'-E\' and \'-e\' cannot be used together or with \'-o\'.\n"; - $helptext .= " -f force overwrite of existing files\n"; - $helptext .= " -h print this help message and exit\n"; - $helptext .= " -m Multidocument mode; create one document for each parameter that is\n"; - $helptext .= " retrieved from the database in the input document (see documentation)\n"; - $helptext .= " This option cannot be used with \'-o\'.\n"; - $helptext .= " -M Same as -m, but with the parameter in the filename i.s.o. a serial number\n"; - $helptext .= " -o file specify an output file. Cannot be used with \'-E\' or \'-e\'\n"; - $helptext .= " This option cannot be used with \'-m\'.\n"; - $helptext .= " -p prefix prefix used in the SQLTeX file. Default is \'sql\'\n"; - $helptext .= " (e.g. \\sqldb[user]{database}), but this can be overwritten\n"; - $helptext .= " if it conflicts with other user-defined commands.\n"; - $helptext .= " -q run in quiet mode\n"; - $helptext .= " -r file specify a file that contains replace characters. This is a list with\n"; - $helptext .= " two tab- seperated fields per line. The first field holds a string\n"; - $helptext .= " that will be replaced in the SQL output by the second string.\n"; - $helptext .= " By default the file \'$main::my_location/SQLTeX_r.dat\' is used.\n"; - $helptext .= " -rn do not use a replace file. -r file and -rn are handled in the same\n"; - $helptext .= " as they where specified on the command line.\n"; - $helptext .= " -s server SQL server to connect to. Default is \'localhost\'\n"; - $helptext .= " -u If the input file contains updates, execute them.\n"; - - $helptext .= "\n file is the input file that should be read. By default,\n"; - $helptext .= " $main::myself looks for a file with extension \'.$main::configuration{'texex'}\'.\n"; - $helptext .= "\n parameter(s) are substituted in the SQL statements if they contain\n"; - $helptext .= " the string \$PAR[x] somewhere in the statement, where\n"; - $helptext .= " \'x\' is the number of the parameter.\n"; - - if ($main::configuration{'less_av'}) { - system ("echo \"$helptext\" | less"); - } elsif ($main::configuration{'more_av'}) { - system ("echo \"$helptext\" | more"); - } else { - print $helptext; - } -} - -##### -# Print the version number -# -sub print_version { - print "$main::myself v$main::version - $main::rdate\n"; -} - -##### -# If we're not running in quiet mode (-q), this routine prints a message telling -# the user what's going on. -# -sub print_message ($) { - my $message = shift; - print "$message\n" unless (defined $main::options{'q'}); -} - - -##### -# If we have to prompt for a password, disable terminal echo, get the password -# and return it to the caller -# -sub get_password ($$) { - my ($usr, $srv) = @_; - - print "Password for $usr\@$srv : "; - - system('stty -echo'); - my $pwd = <STDIN>; - chomp $pwd; - system('stty echo'); - print "\n"; - - return $pwd; -} - -####### -# Find the file extension for the outputfile -# -sub file_extension ($) { - my $subst = shift; - - my %mn = ('Jan','01', 'Feb','02', 'Mar','03', 'Apr','04', - 'May','05', 'Jun','06', 'Jul','07', 'Aug','08', - 'Sep','09', 'Oct','10', 'Nov','11', 'Dec','12' ); - my $sydate = localtime (time); - my ($wday, $mname, $dnum, $time, $year) = split(/\s+/,$sydate); - $dnum = "0$dnum" if ($dnum < 10); - while ($subst =~ /\{[a-zA-Z0-9]+\}/) { - my $s1 = $`; - my $sub = $&; - my $s2 = $'; - $sub =~ s/[\{\}]//g; - if ($sub =~ /P[0-9]/) { - $sub =~ s/P//; - die ("insufficient parameters to substitute \{P$sub\}\n") if ($sub > $#ARGV); - $sub = $ARGV[$sub]; - } elsif ($sub eq 'M') { - $sub = $mname; - } elsif ($sub eq 'W') { - $sub = $wday; - } elsif ($sub eq 'D') { - $sub = "$year$mn{$mname}$dnum"; - } elsif ($sub eq 'DT') { - $sub = "$year$mn{$mname}$dnum$time"; - $sub =~ s/://g; - } elsif ($sub eq 'T') { - $sub = $time; - $sub =~ s/://g; - } else { - die ("unknown substitution code \{$sub\}\n"); - } - $subst = "$s1$sub$s2"; - } - return ($subst); -} - -##### -# Declare the filenames to use in this run. -# If a file has been entered -# -sub get_filenames { - $main::inputfile = $ARGV[0] || die "no input file specified\n"; - - $main::path = ''; - while ($main::inputfile =~ /\//) { - $main::path .= "$`/"; - $main::inputfile =~ s/$`\///; - } - if ($main::inputfile =~/\./) { - if ((!-e "$main::path$main::inputfile") && (-e "$main::path$main::inputfile.$main::configuration{'texex'}")) { - $main::inputfile .= ".$main::configuration{'texex'}"; - } - } else { - $main::inputfile .= ".$main::configuration{'texex'}" - } - die "File $main::path$main::inputfile does not exist\n" if (!-e "$main::path$main::inputfile"); - - if (!defined $main::options{'o'}) { - $main::inputfile =~ /\./; - $main::outputfile = "$`"; - my $lastext = "$'"; - while ($' =~ /\./) { - $main::outputfile .= ".$`"; - $lastext = "$'"; - } - if (defined $main::options{'E'} || defined $main::options{'e'}) { - $main::configuration{'stx'} = &file_extension ($main::options{'E'} || $main::options{'e'}); - } - if (defined $main::options{'E'}) { - $main::outputfile .= "$main::multidoc_id.$main::configuration{'stx'}"; - } else { - $main::outputfile .= "$main::configuration{'stx'}$main::multidoc_id\.$lastext"; - } - } else { - $main::outputfile = $main::options{'o'}; - } - - if (defined $main::options{'c'}) { - $main::configurationfile = $main::options{'c'}; - } else { - $main::configurationfile = "$main::my_location/SQLTeX.cfg"; - } - if (!-e $main::configurationfile) { - die ("Configfile $main::configurationfile does not exist\n"); - } - - if (defined $main::options{'r'}) { - $main::replacefile = $main::options{'r'}; - } else { - $main::replacefile = "$main::my_location/SQLTeX_r.dat"; - } - if (!-e $main::replacefile) { - warn ("replace file $main::replacefile does not exist\n") unless ($main::replacefile eq "n"); - undef $main::replacefile; - } - - - return; -} - -####### -# Connect to the database -# -sub db_connect($$) { - my ($up, $db) = @_; - my $data_source; - - $main::line =~ s/\[?$up\]?\{$db\}//; - - my $un = ''; - my $pw = ''; - my $hn = ''; - my @opts = split(',', $up); - for(my $idx = 0; $idx <= $#opts; $idx++) { - my $opt = $opts[$idx]; - if ($opt =~ /=/) { - if ($` eq 'user') { - $un = $'; - } elsif ($` eq 'passwd') { - $pw = $'; - } elsif ($` eq 'host') { - $hn = $'; - } - } else { - if ($idx == 0) { - $un = $opt; - } elsif ($idx == 1) { - $pw = $opt; - } elsif ($idx == 2) { - $hn = $opt; - } - } - } - - $un = $main::options{'U'} if (defined $main::options{'U'}); - $pw = &get_password ($un, $main::options{'s'} || 'localhost') if (defined $main::options{'P'}); - $hn = $main::options{'s'} if (defined $main::options{'s'}); - - if ($main::configuration{'dbdriver'} eq "Pg") { - $data_source = "DBI:$main::configuration{'dbdriver'}:dbname=$db"; - $data_source .= ";host=$hn" unless ($hn eq ""); - } elsif ($main::configuration{'dbdriver'} eq "Oracle") { - $data_source = "DBI:$main::configuration{'dbdriver'}:$db"; - $data_source .= ";host=$hn;sid=$main::configuration{'oracle_sid'}" unless ($hn eq ""); - $data_source .= ";sid=$main::configuration{'oracle_sid'}"; - } elsif ($main::configuration{'dbdriver'} eq "Ingres") { - $data_source = "DBI:$main::configuration{'dbdriver'}"; - $data_source .= ":$hn" unless ($hn eq ""); - $data_source .= ":$db"; - } elsif ($main::configuration{'dbdriver'} eq "Sybase") { - $data_source = "DBI:$main::configuration{'dbdriver'}:$db"; - $data_source .= ";server=$hn" unless ($hn eq ""); - } else { # MySQL, mSQL, ... - $data_source = "DBI:$main::configuration{'dbdriver'}:database=$db"; - $data_source .= ";host=$hn" unless ($hn eq ""); - } - - if (!defined $main::options{'q'}) { - my $msg = "Connect to database $db on "; - $msg .= $hn|| 'localhost'; - $msg .= " as user $un" unless ($un eq ''); - $msg .= " using a password" unless ($pw eq ''); - &print_message ($msg); - } - $main::db_handle = DBI->connect ($data_source, $un, $pw, { RaiseError => 0, PrintError => 1 }) || &just_died (1); - return; -} - -##### -# Execute the SQL query and return the result in an array -# -sub execute_query ($) { - my $query = shift; - my (@result, @res); - return @result; -} - -##### -# Check if the SQL statement contains options -# Supported options are: -# setvar=<i>, where <i> is the list location to store the variable. -# setarr=<i> -# -sub check_options ($) { - my $options = shift; - return if ($options eq ''); - $options =~ s/\[//; - $options =~ s/\]//; - - my @optionlist = split /,/, $options; - while (@optionlist) { - my $opt = shift @optionlist; - if ($opt =~ /^setvar=/i) { - $main::var_no = $'; - $main::setvar = 1; - } - if ($opt =~ /^setarr=/i) { - $main::arr_no = $'; - $main::setarr = 1; - } - if ($opt =~ /^fldsep=/i) { - $main::fldsep = qq{$'}; - if ($main::fldsep eq 'NEWLINE') { - $main::fldsep = "\n"; - } - } - if ($opt =~ /^rowsep=/i) { - $main::rowsep = qq{$'}; - if ($main::rowsep eq 'NEWLINE') { - $main::rowsep = "\n"; - } - } - } -} - -##### -# Replace values from the query result as specified in the replace files. -# This is done in two steps, to prevent characters from being replaces again -# if they occus both as key and as value. -# -sub replace_values ($) { - my $sqlresult = shift; - my $rk; - - foreach $rk (@main::repl_order) { - my ($begin, $end) = split /\Q$main::configuration{'rfile_regexploc'}\E/,$main::configuration{'rfile_regexp'}; - if ($rk =~ /^\Q$begin\E(.*)\Q$end\E$/) { - $sqlresult =~ s/$1/$main::repl_key{$rk}/g; - } else { - $sqlresult =~ s/\Q$rk\E/$main::repl_key{$rk}/g; - } - } - - foreach $rk (keys %main::repl_key) { - $sqlresult =~ s/$main::repl_key{$rk}/$main::repl_val{$main::repl_key{$rk}}/g; - } - return ($sqlresult); -} - -##### -# Select multiple rows from the database. This function can have -# the [fldsep=s] and [rowsep=s] options to define the string which -# should be used to seperate the fields and rows. -# By default, fields are seperated with a comma and blank (', '), and rows -# are seperated with a newline character ('\\') -# -sub sql_row ($$) { - my ($options, $query) = @_; - local $main::fldsep = ', '; - local $main::rowsep = "\\\\"; - local $main::setarr = 0; - my (@values, @return_values, $rc, $fc); - - &check_options ($options); - - &print_message ("Retrieving row(s) with \"$query\""); - $main::sql_statements++; - my $stat_handle = $main::db_handle->prepare ($query); - $stat_handle->execute (); - - if ($main::setarr) { - &just_died (7) if (defined $main::arr[$main::arr_no]); - @main::arr[$main::arr_no] = (); - while (my $ref = $stat_handle->fetchrow_hashref()) { - foreach my $k (keys %$ref) { - $ref->{$k} = replace_values ($ref->{$k}); - } - push @{$main::arr[$main::arr_no]},$ref; - } - $stat_handle->finish (); - return (); - } - - while (@values = $stat_handle->fetchrow_array ()) { - $fc = $#values + 1; - if (defined $main::replacefile) { - my $list_cnt = 0; - foreach (@values) { - $values[$list_cnt] = replace_values ($values[$list_cnt]); - $list_cnt++; - } - } - push @return_values, (join "$main::fldsep", @values); - } - $stat_handle->finish (); - - if ($#return_values < 0) { - &just_died (4); - } - - $rc = $#return_values + 1; - if ($rc == 1) { - &print_message ("Found $rc row with $fc field(s)"); - } else { - &print_message ("Found $rc rows with $fc fields each"); - } - - return (join "$main::rowsep", @return_values); - -} - - -##### -# Select a single field from the database. This function can have -# the [setvar=n] option to define an internal variable -# -sub sql_field ($$) { - my ($options, $query) = @_; - local $main::setvar = 0; - - &check_options ($options); - - $main::sql_statements++; - - &print_message ("Retrieving field with \"$query\""); - my $stat_handle = $main::db_handle->prepare ($query); - $stat_handle->execute (); - my @result = $stat_handle->fetchrow_array (); - $stat_handle->finish (); - - if ($#result < 0) { - &just_died (4); - } elsif ($#result > 0) { - &just_died (5); - } else { - &print_message ("Found 1 value: \"$result[0]\""); - if ($main::setvar) { - &just_died (7) if (defined $main::var[$main::var_no]); - $main::var[$main::var_no] = $result[0]; - return ''; - } else { - if (defined $main::replacefile) { - return (replace_values ($result[0])); - } else { - return ($result[0]); - } - } - } -} - -##### -# Start a section that will be repeated for evey row that is on stack -# -sub sql_start ($) { - my $arr_no = shift; - &just_died (11) if (!defined $main::arr[$arr_no]); - if (@main::current_array) { - @main::current_array = (); - } - @main::loop_data = (); - push @main::current_array,$arr_no; -} - -##### -# Use a named variable from the stack -# -sub sql_use ($$) { - my ($field, $loop) = @_; - return $main::arr[$#main::current_array][$loop]->{$field}; -} - - -##### -# Stop processing the current array -# -sub sql_end () { - my $result = ''; - - for (my $cnt = 0; $cnt <= $#{$main::arr[$#main::current_array]}; $cnt++) { - for (my $lines = 0; $lines < $#{$main::loop_data[$#main::current_array]}; $lines++) { - my $buffered_line = ${$main::loop_data[$#main::current_array]}[$lines]; - my $cmdPrefix = $main::configuration{'alt_cmd_prefix'}; - while (($buffered_line =~ /\\$cmdPrefix[a-z]+(\[|\{)/) && !($buffered_line =~ /\\\\$cmdPrefix[a-z]+(\[|\{)/)) { - my $cmdfound = $&; - $cmdfound =~ s/\\//; - - $buffered_line =~ /\\$cmdfound/; - my $lin1 = $`; - $buffered_line = $'; - $buffered_line =~ /\}/; - my $statement = $`; - my $lin2 = $'; - if ($cmdfound =~ /$main::configuration{'sql_use'}/) { - $buffered_line = $lin1 . &sql_use($statement, $cnt) . $lin2; - } - } - $result .= $buffered_line; - } - } - - pop @main::current_array; - return $result; -} - - - -##### -# Select a (list of) single field(s) from the database. This list is used in -# multidocument mode as the first parameter in all queries. -# Currently, only 1 parameter per run is supported. -# -sub sql_setparams ($$) { - my ($options, $query) = @_; - my (@values, @return_values, $rc); - - &check_options ($options); - - &print_message ("Retrieving parameter list with \"$query\""); - $main::sql_statements++; - my $stat_handle = $main::db_handle->prepare ($query); - $stat_handle->execute (); - - while (@values = $stat_handle->fetchrow_array ()) { - &just_died (9) if ($#values > 0); # Only one allowed - push @return_values, @values; - } - $stat_handle->finish (); - - if ($#return_values < 0) { - &just_died (8); - } - - $rc = $#return_values + 1; - &print_message ("Multidocument parameters found; $rc documents will be created: handle document $main::multidoc_cnt"); - - return (@return_values); -} - - -##### -# Select a (list of) single field(s) from the database. This list is used in -# multidocument mode as the first parameter in all queries. -# Currently, only 1 parameter per run is supported. -# -sub sql_update ($$) { - my ($options, $query) = @_; - local $main::setvar = 0; - - if (!defined $main::options{'u'}) { - &print_message ("Updates will be ignored"); - return; - } - &check_options ($options); - - &print_message ("Updating values with \"$query\""); - my $rc = $main::db_handle->do($query); - &print_message ("$rc rows updated"); -} - -##### -# Some error handling (mainly cleanup stuff) -# Files will be closed if opened, and if no sql output was written yet, -# the outputfile will be removed. -# -sub just_died ($) { - my $step = shift; - my $Resurect = 0; - - $Resurect = 1 if ($step == 4 && $main::NULLallowed); - - if ($step >= 1 && !$Resurect) { -# close FI; -# close FO; - } - if ($step > 2 && !$Resurect) { -# $main::db_handle->disconnect(); - } - if ($step >= 1 && $step <= 2 && !$Resurect) { - unlink ("$main::path$main::outputfile"); - } - - ##### - # Step specific exit - # - my $msg; - if ($step == 2) { - $msg = "no database opened at line $main::lcount[$main::fcount]"; - } elsif ($step == 3) { - $msg = "insufficient parameters to substitute variable on line $main::lcount[$main::fcount]"; - } elsif ($step == 4) { - $msg = "no result set found on line $main::lcount[$main::fcount]"; - } elsif ($step == 5) { - $msg = "result set too big on line $main::lcount[$main::fcount]"; - } elsif ($step == 6) { - $msg = "trying to substitute with non existing on line $main::lcount[$main::fcount]"; - } elsif ($step == 7) { - $msg = "trying to overwrite an existing variable on line $main::lcount[$main::fcount]"; - } elsif ($step == 8) { - $msg = "no parameters for multidocument found on line $main::lcount[$main::fcount]"; - } elsif ($step == 9) { - $msg = "too many fields returned in multidocument mode on $main::lcount[$main::fcount]"; - } elsif ($step == 10) { - $msg = "unrecognized command on line $main::lcount[$main::fcount]"; - } elsif ($step == 11) { - $msg = "start using a non-existing array on line $main::lcount[$main::fcount]"; - } elsif ($step == 12) { - $msg = "\\sqluse command encountered outside loop context on line $main::lcount[$main::fcount]"; - } - if ($main::fcount > 0) { - for (my $fcnt = 0; $fcnt < $main::fcount; $fcnt++) { - $msg .= ', file included from line '.$main::lcount[$fcnt]; - } - } - warn "$msg\n"; - return if ($Resurect); - exit (1); -} - -##### -# An SQL statement was found in the input file. If multiple lines are -# used for this query, they will be read until the '}' is found, after which -# the query will be executed. -# -sub parse_command ($$$) { - my $cmdfound = shift; - my $multidoc_par = shift; - my $file_handle = shift; - my $options = ''; - my $varallowed = 1; - - $varallowed = 0 if ($cmdfound =~ /$main::configuration{'sql_open'}/); - - chop $cmdfound; - $cmdfound =~ s/\\//; - - $main::line =~ /\\$cmdfound/; - my $lin1 = $`; - $main::line = $'; - - while (!($main::line =~ /\}/)) { - chomp $main::line; - $main::line .= ' '; - $main::line .= <$file_handle>; - $main::lcount[$main::fcount]++; - } - - $main::line =~ /\}/; - my $statement = $`; - my $lin2 = $'; - - $statement =~ s/(\[|\{)//g; - if ($statement =~ /\]/) { - $options = $`; - $statement = $'; - } - - if ($varallowed) { - if (($main::multidoc_cnt > 0) && $main::multidoc) { - $statement =~ s/\$PAR1/$multidoc_par/g; - } else { - for (my $i = 1; $i <= $#ARGV; $i++) { - $statement =~ s/\$PAR$i/$ARGV[$i]/g; - } - } - while ($statement =~ /\$VAR[0-9]/) { - my $varno = $&; - $varno =~ s/\$VAR//; - &just_died (6) if (!defined ($main::var[$varno])); - $statement =~ s/\$VAR$varno/$main::var[$varno]/g; - } - &just_died (3) if ($statement =~ /\$PAR/ && ($main::multidoc_cnt > 0) && $main::multidoc); - $statement =~ s/\{//; - } - - if ($cmdfound =~ /$main::configuration{'sql_open'}/) { - &db_connect($options, $statement); - $main::db_opened = 1; - return 0; - } - - &just_died (2) if (!$main::db_opened); - - if ($cmdfound =~ /$main::configuration{'sql_field'}/) { - $main::line = $lin1 . &sql_field($options, $statement) . $lin2; - } elsif ($cmdfound =~ /$main::configuration{'sql_row'}/) { - $main::line = $lin1 . &sql_row($options, $statement) . $lin2; - } elsif ($cmdfound =~ /$main::configuration{'sql_params'}/) { - if ($main::multidoc) { # Ignore otherwise - @main::parameters = &sql_setparams($options, $statement); - $main::line = $lin1 . $lin2; - return 1; # Finish this run - } else { - $main::line = $lin1 . $lin2; - } - } elsif ($cmdfound =~ /$main::configuration{'sql_update'}/) { - &sql_update($options, $statement); - $main::line = $lin1 . $lin2; - } elsif ($cmdfound =~ /$main::configuration{'sql_start'}/) { - &sql_start($statement); - $main::line = $lin1 . $lin2; - } elsif ($cmdfound =~ /$main::configuration{'sql_use'}/) { - &just_died (12) if (!@main::current_array); - $main::line = $lin1 . "\\" . $main::configuration{'alt_cmd_prefix'} . $main::configuration{'sql_use'} . "{" . $statement . "}" . $lin2; # Restore the line, will be processed later - } elsif ($cmdfound =~ /$main::configuration{'sql_end'}/) { - $main::line = $lin1 . &sql_end() . $lin2; - } else { - &just_died (10); - } - - return 0; -} - -sub read_input($$$$) { - my ($input_file, $output_handle, $multidoc_par) = @_; - - $main::fcount++; - $main::lcount[$main::fcount] = 0; - - if (!-e $main::path . $input_file) { - die "input file $main::path$input_file not found"; - } - print_message("Processing file $main::path$input_file..."); - open (my $fileIn, "<$main::path$input_file"); - - while ($main::line = <$fileIn>) { - $main::lcount[$main::fcount]++; - next if ($main::line =~ /^\s*%/); - if ($main::line =~ /(.*?)(\\in(put|clude))(\s*?)\{(.*?)\}(.*)/) { - print $output_handle "$1" unless ($output_handle == -1); - &read_input($5, $output_handle, $multidoc_par); - return if ($main::restart); - print $output_handle "$6\n" unless ($output_handle == -1); - } - my $cmdPrefix = $main::configuration{'cmd_prefix'}; - while (($main::line =~ /\\$cmdPrefix[a-z]+(\[|\{)/) && !($main::line =~ /\\\\$cmdPrefix[a-z]+(\[|\{)/)) { - if (&parse_command($&, $multidoc_par, $fileIn) && $main::multidoc && ($main::multidoc_cnt == 0)) { - close $fileIn; - $main::fcount--; - $main::restart = 1; - return; - } - } - if (@main::current_array && $#main::current_array >= 0) { - push @{$main::loop_data[$#main::current_array]}, $main::line; - } else { - print $output_handle "$main::line" unless ($main::multidoc && ($main::multidoc_cnt == 0)); - } - } - $main::fcount--; - close $fileIn; -} - -##### -# Process the input file -# When multiple documents should be written, this routine is -# multiple times. -# The first time, it only builds a list with parameters that will be -# used for the next executions -# -sub process_file { - my $multidoc_par = ''; - - if ($main::multidoc && ($main::multidoc_cnt > 0)) { - if (!defined($main::saved_outfile_template)) { - $main::saved_outfile_template = $main::outputfile; - } - $main::saved_outfile_template = $main::outputfile if ($main::multidoc_cnt == 1); # New global name; should be a static - $main::outputfile = $main::saved_outfile_template if ($main::multidoc_cnt > 1); - $main::outputfile =~ s/\#M\#/$main::multidoc_cnt/; - $main::outputfile =~ s/\#P\#/$main::parameters[($main::multidoc_cnt-1)]/; - $multidoc_par = @main::parameters[$main::multidoc_cnt - 1]; - } - my $fileOut; - if ($main::multidoc && ($main::multidoc_cnt == 0)) { - $fileOut = -1; - } else { - open ($fileOut, ">$main::path$main::outputfile"); - } - - $main::sql_statements = 0; - $main::db_opened = 0; - $main::fcount = -1; - $main::restart = 0; - - &read_input($main::path . $main::inputfile, $fileOut, $multidoc_par); - - if ($main::multidoc) { - $main::multidoc = 0 if (($main::multidoc_cnt++) > $#main::parameters); - return if ($main::multidoc); - } - - close $fileOut; -} - -## Main: - -##### -# Default config values, will be overwritten with SQLTeX.cfg -# -%main::configuration = ( - 'dbdriver' => 'mysql' - ,'oracle_sid' => 'ORASID' - ,'texex' => 'tex' - ,'stx' => '_stx' - ,'rfile_comment' => ';' - ,'rfile_regexploc' => '...' - ,'rfile_regexp' => 're(...)' - ,'cmd_prefix' => 'sql' - ,'sql_open' => 'db' - ,'sql_field' => 'field' - ,'sql_row' => 'row' - ,'sql_params' => 'setparams' - ,'sql_update' => 'update' - ,'sql_start' => 'start' - ,'sql_end' => 'end' - ,'sql_use' => 'use' - ,'less_av' => 1 - ,'more_av' => 1 - ,'repl_step' => 'OSTX' - ,'alt_cmd_prefix' => 'processedsqlcommand' -); - -##### -# Some globals -# -{ - my @dir_list = split /\//, $0; - pop @dir_list; - $main::my_location = join '/', @dir_list; -} - -# Check config -# Used for loops, should not start with $main::configuration{'cmd_prefix'} !! -if ($main::configuration{'alt_cmd_prefix'} =~ /^$main::configuration{'cmd_prefix'}/) { - die "Configuration item 'alt_cmd_prefix' cannot start with $main::configuration{'cmd_prefix'}"; -} - -$main::myself = $ENV{'_'}; -while ($main::myself =~ /\//) { $main::myself = $'; } - -$main::version = '2.0'; -$main::rdate = 'Jan 12, 2016'; - -&parse_options; -&get_filenames; - -if (!$main::multidoc && -e "$main::path$main::outputfile") { - die ("outputfile $main::path$main::outputfile already exists\n") - unless (defined $main::options{'f'}); -} - -if (defined $main::configurationfile) { - open (CF, "<$main::configurationfile"); - while ($main::line = <CF>) { - next if ($main::line =~ /^\s*#/); - next if ($main::line =~ /^\s*$/); - chomp $main::line; - my ($ck, $cv) = split /=/, $main::line; - $ck =~ s/\s//g; - $cv =~ s/\s//g; - if ($cv ne '') { - $main::configuration{$ck} = $cv; - } - } - close CF; -} - -if (defined $main::replacefile) { - my $repl_cnt = '000'; - @main::repl_order = (); - open (RF, "<$main::replacefile"); - while ($main::line = <RF>) { - next if ($main::line =~ /^\s*$main::configuration{'rfile_comment'}/); - chomp $main::line; - $main::line =~ s/\t+/\t/; - my ($rk, $rv) = split /\t/, $main::line; - if ($rk ne '') { - push @main::repl_order, $rk; - $main::repl_key{$rk} = "$main::configuration{'repl_step'}$repl_cnt"; - $main::repl_val{"$main::configuration{'repl_step'}$repl_cnt"} = $rv; - $repl_cnt++; - } - } - close RF; -} - -# Start processing -do { - &process_file; - $main::restart = 0; - if ($main::sql_statements == 0) { - unlink ("$main::path$main::outputfile"); - print "no sql statements found in $main::path$main::inputfile\n"; - $main::multidoc = 0; # Problem in the input, useless to continue - } else { - print "$main::sql_statements queries executed - TeX file $main::path$main::outputfile written\n" - unless ($main::multidoc && ($main::multidoc_cnt == 1)); - } -} while ($main::multidoc); # Set to false when done - -$main::db_handle->disconnect() if ($main::db_opened); -exit (0); - -# -# And that's about it. -##### |