Menu
▾
▴
[Woc-commit] CVS: woc/src/woc/cgi-src/htplpdir Grammar.pm,NONE,1.1 README,NONE,1.1 dataConv.pm,NONE,1.1 dataFunc.pm,NONE,1.1 dataIO.pm,NONE,1.1 helper,NONE,1.1 htplp,NONE,1.1 naam.pl,NONE,1.1
|
From: Geert J. <gj...@us...> - 2002-09-03 19:40:44
|
Update of /cvsroot/woc/woc/src/woc/cgi-src/htplpdir
In directory usw-pr-cvs1:/tmp/cvs-serv23171/woc/cgi-src/htplpdir
Added Files:
Grammar.pm README dataConv.pm dataFunc.pm dataIO.pm helper
htplp naam.pl
Log Message:
--- NEW FILE: Grammar.pm ---
package Grammar;
# Polymorphic-data-grammar reading by G.P.H. Josten June, 1998
#
# This package contains the function to extract the data-grammar from a file.
#
use strict;
require Exporter;
@Grammar::ISA = qw(Exporter);
@Grammar::EXPORT = qw(read_grammar);
sub read_grammar ($) {
#
# read in the grammar of the data from a grammar file
#
# PRE: $source contains name of grammar file
# POST: %order, %distribution and %keynames contain the information
# necessary to retrieve fields from the data and show them on screen
my ($source) = @_;
my (%order, %distribution, %keynames, $regel, @regel, @lijst, $i);
my ($dataseparator) = "#";
my ($fieldseparator) = ", ";
open (SOURCE, $source) || die $!;
#
# first read the order into %order:
#
defined ($regel = <SOURCE>) || die $!;
@regel = split (" ", $regel);
$i=0;
@lijst = ();
while ($i < $regel[1] && defined ($regel = <SOURCE>)) {
chomp($regel);
push (@lijst, $regel, $i);
$i++;
}
%order = @lijst;
#
# second the distribution along multiple lines:
#
defined ($regel = <SOURCE>) || die $!;
@regel = split (" ", $regel);
$i=0;
@lijst = ();
while ($i < $regel[1] && defined ($regel = <SOURCE>)) {
chomp($regel);
push (@lijst, $i, $regel);
$i++;
}
%distribution = @lijst;
#
# last the names to show in front of each line:
#
defined ($regel = <SOURCE>) || die $!;
@regel = split (" ", $regel);
$i=0;
@lijst = ();
while ($i < $regel[1] && defined ($regel = <SOURCE>)) {
chomp($regel);
push (@lijst, $i, $regel);
$i++;
}
push (@lijst, "comment", "/");
%keynames = @lijst;
close (SOURCE) || die $!;
# return the references only!!
return [\%order, \%distribution, \%keynames, $dataseparator, $fieldseparator];
}
--- NEW FILE: README ---
August 5th, 1998
Why Htplp and Editor
Htplp and Editor are two Perl-scripts which were written to resolve problems
concerning the representation of large quantities of data on WWW as HTML. Htplp
is the Parser which generates the pages, Editor is the utility to edit the data.
Where it all started
The parent problem was a small already existing site of the student association
V.V.C.N. Sigma (http://www.sci.kun.nl/sigma/) which contained almost all
pictures of the Chemistry students at the University of Nijmegen (most of them
member of Sigma). Each year new students arrived and the pages had to be updated (each year of students meant three pages of each a number of kilobytes). I took
that job on me (don't ask me why, I can't remember) and did this for one new
year of students. My conclusion was that it was an unflexible, easily
out-of-date and time consuming way. Everything had to be done manually.
Especially when I (yes, one of those great ideas to do some self-torture) came
to the idea to improve the layout by using multi-column layout for the pictures, I got tired of it. With some cut and paste it could be done, but it was boring
and specially suited for computers to do it for you.
The first monster
The problems weren't very important, as the pages didn't needed to be very
up-to-date. Nevertheless, it is a good visit card to do have a site with
accurate and usable information. Besides, it was an interesting challenge which
could make things easy in future. With my fresh knowledge of Java ("C1", the
introductory course to programming - in Java :-( - was one of the obligatory
courses), I set off to build a database and an engine that could read the data
and generate the pages for me. An immense monster resulted. It worked, but it
was ill-programmed and unreadable, only I worked with it - with reason I presume :-P -, and most of all, it was unflexible and still unmaintainable. But, a
database was generated, one of the biggest benefits, and the page generation was automated. The engines most worth, it proved to me with it's first use outside
it's original purpose, a use for like-wise layout, not for WWW but for a booklet with information about Sigma. I used this monster more than a year I believe, it has shown it's purpose, but now fortunately it's obsolete.
The data
The data which was held by a number of files, had to be created and maintained.
This was a second problem, because using a text-editor isn't the best way, for
mistakes are very easily made. Leaving some special symbol out meant that half
the data of one year wasn't read, but skipped. Searching these files and
extracting the useful information was another problem. Busy with the data - I
was probably adding a new year or updating some names - I came to the idea of
writing an editor. Actually, the idea originated because I wanted to facilitate
the extraction of information. I was busy typing all fields that represented a
single student. Life happened to let me stumble over Perl, I was interested and
asked a 'colleague' student - he studied Informatics, I Chemistry at that time,
Informatical Chemistry presently - for some advise about books about Perl. I
bought to his advice two and with "Learning Perl" in one hand and the data files in the other, I tried to get a better and moreover faster extraction going. But
using Unix shell-script (find, grep, sort, etc.) and Unix shell commands within
Perl scripts didn't work and typing all information didn't facilitate it very
much either this way. Well, why not read it in with Perl, put it in some
variables, let Perl do some sorting and voila, my first real useful Perl-script
was born. But with that it didn't stop. Hacking around in Perl, I wrote not only a search utility, but also some conversion utilities and another page generating script. But again, they were ill-programmed, hardly better readable, still only
I (could) work(ed) with them and they still didn't show very much flexibility.
The data improved though, for I typed all data, got some real regularity in it
and got fresh ideas about how to better deal with it.
The new approach
I realised that the power of Perl could be far better utilised for this matter
than I did. I hardly did, so that isn't much of a surprise. One benefit of Perl
is, that normally it doesn't make a difference between words and numbers. I mean that in Perl for example not only numbers could be used to index in an array of
items, but words as well. The Perl hash-variable the best example of this power
of Perl in which one value is used to extract another, one to one. Not vice
versa by the way. My fantasy got almost wild with the only enlarging space in
which I could invent options and ideas and problems and solutions. Meanwhile, I
had been busy with some funny command interpreting script which could represent
the fields of data of one student in some basic way, could edit them as well and after some trouble, could even search the big lot. Discovering more and more
about Perl, I started extracting more and more of the determining values and
putting them into handy variables I could initialize at start and manipulated
mid-way if necessary. This process resulted in a separate file which contained
the full typing of the data and even the representation in the basic way. This
information is read in and put in a few variables. In the rest of the script
only these variables are used and not their actual value. Comparing with the
actual values of these typing variables is only done with user input!! This
process plus the ability of recognizing shortened versions of the actual values
made the Editor very powerful.
The Editor evolved
I continued this work and started working on a profound way. I grouped certain
functions and made them complete and robust. Most of them had to be converted to my new ideas and this allowed me to reconsider the solutions and improve them to their present state. This makes the Editor a full grown script, with fairly
balanced functions and a quite user-friendly user-interface. I already had build an almost complete version of the Editor which I had subjected to some
beta-testing (another colleague student :-). The new version could be tested
back to back with this one and most testing did I do between all the other
programming activities (hint: try to always test an earlier programmed part
before you need to use it!). And still my knowledge about Perl is increasing,
but the usefulness has converged about now - after building Htplp and Editor -.
The data structuring
The data had changed a lot in the meantime. First more regularity, second the
typing and third cenversion. Conversion from the multi-line format (quite
similar to the basic representation) to a single line one. The first two steps
had been time consuming and text editor usage intensive, but are worth it now.
The integrity of the data has very much increased as well as the managebility,
editibility and usability. It also allowed me to experiment a little with how to structure the data. This has resulted in the separate file with the typing and
the single-line format, with all fields of data of one student on a single line. This was done deliberately with several thoughts, no particular order, in my
mind. Difficult to handle are fields of data of undefined number of lines. As
linefeeds and carriage returns are of no use in HTML (it's just treated as
whitespace) it was the first I got rid of. I stuffed everything on a single line and separated it by some specific string. At the moment I have chosen for a
single character, the guard '#'. In near future the choice will be put in the
typing file as well. I call these typing information together the grammar of the data, just to give it a name. Putting everything on a single line, makes the
data easily manageble by using a simple array. This can even be sorted without
any special work (one single command). Using the Perl functions split and join,
the fields can be separated and glued together (single lines again). With the
grammar of the data you can find out where a certain field remains and this can
be use to extract, compare, manipulate and store the value if wanted. It may
sound a bit difficult but it is just short and highly generic all at the same
time, flexible at last and powerful indeed. It's real power became clear to me
when I tried the Editor on a different data-file. It took two minutes to define
a grammar and invent four lines of data. I ran the Editor and it just worked! It really worked!! Not a single change to the Editor was necessary, only the
grammar and the data. I had underestimated my own abilities and the power of
Perl.
What followed
With building this Editor which needs only some final commenting, addition of
one or two extra functions and documentation on usage and maintenance, I created a profound basis of functions I saw I could use for the parent problem where I
started my story. I had deliberately put all the Editor functions grouped in
separate files, which could be used as nicely shielded modules. You only need to call the Perl function use and the functions are all yours. I had data, I had
grammar and I had a whole bunch of functions, all tested and commented too. I
took the page generating script in Perl in front of me and almost paniced in
horror. It was awfull, HTML and Perl stood right next to each other, it was one
big mess and in this script I had used old copies of the functions I had nicely
defined in modules now. To get this readable, I had to get rid of the HTML
between the Perl in some or the other way. By this time, I happened to look in
some existing Perl script which gives some statistics, but more important, it
read a plain text file in and substituted variables it contained (just a dollar
sign '$' followed by an identifier). Interesting!! I though and once more I set
off. But hey, I might could do better, I might be able to write some script
which not only reads in those plain text files and substitutes some variables,
but do this for any file, identified by some argument or so. Not a bad idea, I
thought, so I hacked a bit in Perl, read in a file and substituted variables and produced the result. Hmm, well, I had to do a lot more if I wanted ever to
produce the picture pages of Sigma. It is a tree-like structure with a lot of
hyperlink refering to each other. Besides I had to process a lot of information
if necessary. But, no worry, I thought, let the parser recognize filenames as
variables as well (just dollar sign '$' plus filename) and process these too,
Perl scripts as well. So I did, but being busy and stumbling over several
difficulties one becomes wiser and wiser.
The Htpl parser
After lots and lots of trial-and-error activities (regular expressions are very, very, very flexible in Perl :-P), this resulted in Htplp. The name is derived
from HTml and PerL Parser, which is not completely accurate, but it will do.
This script, or parser if you like to call it that way, starts with reading one
argument. This argument determines what site it should parse and generate. From
this argument some basic files are derived, a.o. the grammar file, the data
file, the main Perl script needed too beside the parsing script and the main
text file. The grammar and data are read, some default variables are set and
next the main Perl script is executed. Actually, it is the only Perl script that is necessary for that particular site. This script is supposed to do something
useful to every remaining argument the parser script received at start. With
these arguments the script is given the opportunity to initialize, process and
destroy variables which, and this is the trick, are automatically acessible from within the parsing script (they are just global variables, so it's no fancy
trick at all and note that the parser script's variables are global too!!). Then the main text file is read in and the real parsing commences. This parsing is no real big deal, although it cost me a lot of fine tuning to get it working.
How the parsing works
This parsing means only that the parser tries to find a few posibilities and
process accordingly. First, the parser could find the word "if" somewhere. If
this "if" is followed by a variable ($varname), then it will try to determine
wether this variable exists or not, if so, the following part remains, otherwise it is deleted. If it is followed in the same line by the word "fi", then
everything in between might survive or not. No "fi", then if the variable isn't
set by that site-specific script, than the full line is deleted. The if .. fi
construction may be put halfway a line, if .... construction must commence at
the beginning of a line. In both if constructions the variable may be directly
preceded by an exclamation mark '!', which negates the required existence of the following variable. Other constructs are as mentioned previously, filenames
($filename), with the only restriction that the filename must end with dot plus
"htpl" ("$filenaam.htpl"). This is merely a handy choice which I'm not about to
change. Final possibilities are just variable substitutions, scalar variables
($varname) and array variables (@varname) as well. Scalar variables are just
substituted by their content. Array variables are a bit trickier. I programmed
the parser in such a way that it pops the first value (The Perl function shift), which is lost that way. I found it necessary to build in a last option, to not
pop that first value, but look at it and possibly use it once again. For this,
put a exclamation mark '!' directly behind the @ in @varname (e.g. @!varname).
This ought to do the trick :-). After each substitution in a line, the parser
tries again, untill it fully fails, then it produces that line. Going over each
line exhaustively allows to parse highly nested structures as well (variable
names in variable names in variable names in a filename in an array variable in
an variable name in an if evaluation in...). This may sound like a lot of work,
but Perl manages to do this for a small but difficult page, within 10 seconds
(at our server at least, which is not the slowest around). Especially the
variable substitutions, which are often the far most done, influence this time
greatly. Try to keep the actions as minimal as possible, by presubstituting all
those values if possible. This doesn't have to be done exhaustively, the script
is fast enough (Perl is compiled before execution!!). If it takes too long, your page might be just too long or perhaps, the server is slow in executing
scripts...
Finally
I hope that this Editor and Htpl Parser may find a lot of future applications
and not only done by me. I build these to give them through to future members of the Internetcommittee of V.V.C.N. Sigma. For as long as I will still be around I will try to do some final modifications in order to make those future
applications even more possible. Let me note, that the Editor script or some
text file nearby that script will contain a more extensive explenation of the
use of the grammar. The Editor itself contains a help function which should
explain the Editor functions at least a little. The error messages should do the rest, I hope. Htplp should be installed by somebody with at least some Perl
experience and he or she could take care of the main site scripts if they are
needed. Any layouting can be done by somebody else, like some HTML wizard or so. Minimal knowledge of how to call the script with the right arguments and what
variables are available in which situation is necessary though. A documenting
file would be very helpfull I suppose. And now the really, really final note: I
called the Parser HTml and PerL Parser, but, actually, the HTML part doesn't
have to be HTML at all, anything based on plain text could do. LaTeX for example too.
May you all have a pleasent exercise of mind with scripts, may they enlighten
your life, may they relieve you of a lot of trouble and sorrow and sweat and
pain. If they don't, I suggest: R.T.F.M.!!!!!!!!
Signed,
WoodWorm alias G.P.H. Josten
student Informatical Chemistry at the University of Nijmegen
member of student association Sigma at Nijmegen
member of the internetcommittee of Sigma
--- NEW FILE: dataConv.pm ---
package dataConv;
# Polymorphic-data convert and show by G.P.H. Josten June, 1998
#
# This package contains functions convert some database data from single line
# format to multiple line format and show it this way on screen.
#
use strict;
require Exporter;
@dataConv::ISA = qw(Exporter);
@dataConv::EXPORT = qw(compress expand show);
sub by_number {
#
# function used by sort to sort numerical instead of alphanumerical
#
if ($a < $b) {
return -1;
} elsif ($b < $a) {
return 1;
} else {
return 0;
}
}
sub compress ($$) {
#
# compress data fields from over multi lines onto single lines
#
# PRE: $refdata, a reference to the data in multiline format to be
# compressed, $reforder, $refdistr and $refkeys, references to
# the hash variables that define how to translate from multi to
# single line and $datasep and $fieldsep the strings that
# separate the fields in the single resp. multi line format
# POST: the data in single line format
my ($refdata, $grammar) = @_;
my ($reforder, $refdistr, $refkeys, $datasep, $fieldsep) = @$grammar;
my (@result, $num_lines, $line, $i, @pos, @gegevens);
$num_lines = scalar (keys (%$refdistr));
while (@$refdata) {
do {
$line = shift (@$refdata);
} while ($line =~ /$$refkeys{"comment"}/i);
for ($i = 0; $i < $num_lines; $i++) {
$line =~ tr/^$$refkeys{$i}//;
@pos = split(/$fieldsep/, $$refdistr{$i});
@gegevens[@pos] = split(/$fieldsep/, $line);
}
shift (@$refdata); # empty line
push (@result, join ("$datasep", @gegevens));
}
return \@result;
}
sub expand ($$$) {
#
# expand one single line of data to multiline format
#
# PRE: $refdata, a reference to the data in single line format from
# which one record is to be expanded; $reforder, $refdistr and
# $refkeys, references to the hash variables that define how to
# translate from single to multi line format and $datasep and
# $fieldsep the strings that separate the fields in the single
# resp. multi line format
# POST: one data record in multi line format
my ($index, $refdata, $grammar) = @_;
my ($reforder, $refdistr, $refkeys, $datasep, $fieldsep) = @$grammar;
my (@data, @result, @lines, @fields) = ((), (), (), ());
my ($line); # show each of the list by expanding them one by one
@data = split (/$datasep/, $$refdata[$index-1]);
@lines = (0..(scalar (keys (%$refdistr)) - 1));
# add numbering of output
push (@result, "/// ".$index." ///$/");
# add each line with the apropriate datafields
foreach (@lines) {
# which fields?
@fields = split(/$fieldsep/, $$refdistr{$_});
# add line identifying string
$line = $$refkeys{$_};
# add the fields
$line .= join ("$fieldsep", @data[@fields]);
push (@result, "$line$/");
}
return @result;
}
sub show ($$$) {
#
# show a given number of record from the data
#
# PRE: $reflist, a reference to a list with all indices to the records
# from the data to be shown;
# $refdata, a reference to the data in single line format from
# which one record is to be expanded; $reforder, $refdistr and
# $refkeys, references to the hash variables that define how to
# translate from single to multi line format and $datasep and
# $fieldsep the strings that separate the fields in the single
# resp. multi line format
my ($reflist, $refdata, $grammar) = @_;
my (@listtoshow) = @$reflist;
# got a number?
if (@listtoshow) {
# show all?
if ($listtoshow[0] =~ /^all/i) {
@listtoshow = (1..@$refdata);
} else {
# else sort the received list
@listtoshow = (sort by_number (@$reflist));
}
# show each of the list by expanding them one by one
foreach (@listtoshow) {
print &expand ($_, $refdata, $grammar), $/;
}
}
}
--- NEW FILE: dataFunc.pm ---
package dataFunc;
# Polymorphic-data del, find, filter, get, new by G.P.H. Josten June, 1998
#
# This package contains functions to delete, find records, filter them out or
# build new ones.
#
use strict;
require Exporter;
@dataFunc::ISA = qw(Exporter);
@dataFunc::EXPORT = qw(del filter find get new_record sort_data undo);
use dataConv;
sub by_number {
#
# function used by sort to sort numerical instead of alphanumerical
#
if ($a < $b) {
return -1;
} elsif ($b < $a) {
return 1;
} else {
return 0;
}
}
sub del ($$$$) {
#
# delete records from the database, given some indices
#
# PRE: $reflist is a reference to the list with indices to the
# records that should be deleted, $refdata the reference to
# the data list; if $verbose is set true, give some output
# POST: reference to the updated data list
my ($reflist, $refdata, $grammar, $verbose) = @_;
my ($nr, $antwoord, $i, $j, @checked);
foreach (sort by_number (@$reflist)) {
&show ([$_], $refdata, $grammar);
print "verwijderen? ";
chomp ($antwoord = <STDIN>);
if ($antwoord =~ /^(j|y)/i) {
push (@checked, $_);
}
}
my (@new) = ();
$j = 1;
foreach (@checked) {
for ($i = $j; $i < $_; $i++) {
push (@new, $$refdata[$i-1]);
}
$j = $_+1;
}
for ($i = $j; $i <= @$refdata; $i++) {
push (@new, $$refdata[$i-1]);
}
print "verwijderd zijn: ", join (",", @checked), " overgebleven aantal: ",
$#new+1, $/ if (@checked && $verbose);
return (\@new);
}
sub filter ($$$$) {
#
# grep records out of the database given some criteria
#
# PRE: $reffilters is a reference to a number of pairs strings
# of which the first identifies a unique field and the second
# is used to match the value; $grammar is used to extract the
# fields from the data, $verbose to show some output on screen
# POST: reference to the remaining data
my ($reffilters, $refdata, $grammar, $verbose) = @_;
my ($reflist, $gedelete, $one, $other);
my (@result) = ();
($reflist) = &find ($reffilters, $refdata, $grammar, $verbose);
$one = 1;
while (@$reflist) {
if ($one < $$reflist[0]) {
push (@result, $one);
$one++;
} else {
shift @$reflist;
$one++;
}
}
while ($one <= @$refdata) {
push (@result, $one);
$one++;
}
@result = @$refdata[map {--$_} @result] if @result;
$gedelete = @$refdata-@result;
print "aantal weggefilterd: ", $gedelete, ", aantal overgebleven: ",$#result+1,$/
if (($gedelete > 0) && $verbose);
return \@result;
}
sub find ($$$$) {
#
# find records given some criteria
#
# PRE: $reffilters is a reference to a number of pairs strings
# of which the first identifies a unique field and the second
# is used to match the value; $grammar is used to extract the
# fields from the data, $verbose to show some output on screen
# POST: reference to the list with found matches
my ($reffilters, $refdata, $grammar, $verbose) = @_;
my ($reforder, $refdistr, $refkeys, $datasep, $fieldsep) = @$grammar;
my (%filters) = @$reffilters;
my (@known, @filtered);
my (@result) = (0..$#$refdata);
my ($failure) = "";
my (@keynames) = sort (keys (%$reforder));
my ($gegeven, $string, $waarde, @gegevens);
while (!$failure && (($gegeven, $string) = each (%filters))) {
@filtered = ();
# look how many fieldnames match the given description
@known = grep {$_ =~ /^$gegeven/i} @keynames;
if (@known > 1) {
# more than one match
print "meer mogelijkheden met $gegeven:$/@known$/" if $verbose;
@result = ();
$failure = "true";
} elsif (@known > 0) {
# one match
foreach (@result) {
@gegevens = split (/$datasep/, $$refdata[$_]);
# select the fieldname that matched the description
($waarde = $gegevens[$$reforder{$known[0]}])
|| ($waarde = "");
# keep line if value contains string
push (@filtered, $_) if ($waarde =~ /$string/i);
}
@result = @filtered;
@filtered = ();
} else {
# no matches
print "mogelijkheden:$/@keynames$/$/help\tgeeft beschrijving gegevens$/$/" if $verbose;
$failure = "true";
@result = ();
}
}
# add to all indices one to get a numbering from 1 to # data
@result = map {++$_} @result;
if (@result && $verbose) {
print "gevonden zijn: ", join (",", @result), $/;
}
return \@result;
}
sub get ($$$$) {
#
# returns a list of all selected values
#
# PRE: $reflist is a reference to a list of all fieldnames of which
# values must be returned, $refdata a reference to the data;
# $grammar is used to extract the fields from the data, $verbose
# to show some output on screen
# POST: reference to the list with all matching values
my ($reflist, $refdata, $grammar, $verbose) = @_;
my ($reforder, $refdistr, $refkeys, $datasep, $fieldsep) = @$grammar;
my (@fields) = @$reflist;
my (@result) = ();
my ($failure) = "";
my (@keynames) = sort (keys (%$reforder));
my ($field, @gegevens, @known);
my (@positions) = ();
if ($fields[0] =~ /^all/i) {
@positions = sort (values (%$reforder));
} else {
while (!$failure && ($field = shift (@fields))) {
# look how many fieldnames match the given description
@known = grep {$_ =~ /^$field/i} @keynames;
if (@known > 1) {
# more than one match
print "meer mogelijkheden met $field:$/@known$/" if $verbose;
@positions = ();
$failure = "true";
} elsif (@known > 0) {
# one match
push (@positions, $$reforder{$known[0]});
} else {
# no matches
print "mogelijkheden:$/@keynames$/$/help\tgeeft beschrijving gegevens$/$/" if $verbose;
$failure = "true";
@positions = ();
}
}
}
foreach (0..(@$refdata - 1)) {
@gegevens = split (/$datasep/, $$refdata[$_]);
push (@result, join ("$datasep", @gegevens[@positions]));
}
return \@result;
}
sub new_record ($$) {
#
# returns updated data
#
# PRE: $refdata is a reference to the datalist that should be sorted;
# $grammar is used to extract the fields from the data, $verbose
# to show some output on screen
# POST: reference to the sorted datalist
my ($refdata, $grammar, $refhelp) = @_;
my ($reforder, $refdistr, $refkeys, $datasep, $fieldsep) = @$grammar;
my (%invorder, $key, $aantal, $i, $notdone, $record, $value, $last, $newdata);
foreach $key (keys(%$reforder)) {
$invorder{$$reforder{$key}} = $key;
}
$last = @$refdata+1;
$record = "";
$aantal = keys(%$reforder);
$i = 0;
$notdone = "true";
print "[$last] geef de waarden:$/";
while ($i < $aantal && $notdone) {
print $invorder{$i},"? ";
if (defined($value = <STDIN>)) {
chomp ($value);
$value = " " if !$value;
$record .= $value;
$record .= $datasep if ($i < $aantal-1);
} else {
$notdone = "";
}
$i++;
}
if ($notdone) {
$newdata = [@$refdata, $record];
$last = @$newdata;
print $/;
&show ([$last], $newdata, $grammar);
print "toevoegen? ";
defined ($value = <STDIN>) || ($value = "nee");
if ($value =~ /^(j|y)/i) {
$refdata = $newdata;
print "$/1 record toegevoegd...$/";
} else {
print "$/geen wijzigingen aangebracht...$/";
}
} else {
print "$/geen wijzigingen aangebracht...$/";
}
return $refdata;
}
sub sort_data ($$) {
#
# returns alphanumerically sorted data
#
# PRE: $refdata is a reference to the datalist that should be sorted;
# $grammar is used to extract the fields from the data, $verbose
# to show some output on screen
# POST: reference to the sorted datalist
my ($refdata, $verbose) = @_;
(print (@$refdata+1," records alphanumeriek gesorteerd$/")) if ($verbose);
return [sort (@$refdata)];
}
#sub unfilter {
# @studenten = @unfilter;
#}
--- NEW FILE: dataIO.pm ---
package dataIO;
# Polymorphic-data read, save and print by G.P.H. Josten June, 1998
#
# This package contains functions to read, save and print the database data line
# per line.
#
use strict;
require Exporter;
@dataIO::ISA = qw(Exporter);
@dataIO::EXPORT = qw(read_data save_data print_data);
@dataIO::EXPORT_OK = qw(read_data save_data print_data);
sub read_data ($$){
#
# read in data from a file
#
# PRE: $bron contains the name of the data file and $verbose is set to true
# if the number of data read must be shown
my ($bron, $verbose) = @_;
my (@studenten, @commented_data, $regel, $comment);
open (SOURCE, $bron) || die "$!: $bron";
@commented_data = ();
@studenten = ();
$comment = "\/\/";
while (defined ($regel = <SOURCE>)) {
chomp ($regel);
if ($regel =~ /^$comment/i) {
push (@commented_data, $regel);
} else {
push (@studenten, $regel);
}
}
close (SOURCE) || die "$!: $bron";
print $#studenten+1," studenten ingelezen uit $bron$/" if $verbose;
return (\@studenten, \@commented_data);
}
sub save_data {
#
# save given data to a file
#
# PRE: $doel contains the name of the file to which the data must be saved
# *studenten is a reference to a data list and $verbose determines
# wether the number of lines written is shown
my ($doel, $refstuds, $refcommentdata, $verbose) = @_;
open (TARGET, ">$doel") || die "$!: $doel";
foreach (@$refcommentdata) {
print TARGET $_,$/;
}
foreach (@$refstuds) {
print TARGET $_,$/;
}
close (TARGET) || die "$!: $doel";
print @$#refstuds+1," studenten weggeschreven naar $doel$/" if $verbose;
}
sub print_data {
print @_,$/;
}
--- NEW FILE: helper ---
#!/usr/bin/sh
cd /vol/www/woc/bin/editor
Editor htplp
--- NEW FILE: htplp ---
#!/usr/local/bin/perl
#
# First get some libraries necessary to read in data and
# get the right fields out of it...
#
use dataConv;
use dataFunc;
use dataIO;
use Grammar;
#
# Next find out what the user is requesting...
#
if (@ARGV) {
$mode = shift (@ARGV);
if ($mode =~ /^debug/i) {
$debug = "true";
if (@ARGV) {
$mode = shift (@ARGV);
} else {
$mode = "smoel";
}
}
} else {
$mode = "smoel";
}
#
# don't mind the debug info, this script is stuffed with it
#
print "Content-type: text/html$/$/<PRE>" if $debug;
#
# Setup the default variables...
#
$time = gmtime (time ());
#$scriptage = "(".int(-M $0)." days old)";
$script = $0;
$script =~ s#.*\/##i;
$scriptage = "(".int(-M $script)." days old)";
$path = $&; # that what was cut in previous line
$path .= $script."dir/$mode/"; # Wordt niet meer gebruikt !!!!
$script = "/cgi-bin/$script?$mode";
$maintainer = "woc\@sci.kun.nl";
$header = "Dit is een test header"; # don't mind, unimportent
$body = "Geertje!!"; # ;->
#
# Okay, select path to go to the files that contain the mode
# specific data and layout...
#
chdir $mode;
#
# These are the files which are supposed to contain the main
# script, html, data and grammar for the data...
#
$mainperlfile = "$mode.pl";
$mainfile = "$mode.htpl";
$datafile = $mode."data/$mode.dat";
$grammarfile = $mode."data/$mode.grm";
#
# read the data...
#
$grammar = &read_grammar ($grammarfile);
#print "Content-type: text/html$/$/";
#$refdata = &read_data ($datafile, "verbose");
($refdata, $refcommenteddata) = &read_data ($datafile, "");
#
# execute the main script
#
if (-r $mainperlfile) {
do $mainperlfile;
}
#
# read the main html containing file
#
@mainfile = ();
open (MAINFILE, $mainfile) || die "$!:$mainfile";
while (<MAINFILE>) {
push (@mainfile, $_);
}
close (MAINFILE);
#
# and at last, parse the html you just read...
#
print "begin while...$/" if $debug;
while (@mainfile) {
# variable enclosed by if and fi
$match = "";
$begin = "";
$var = "";
$end = "";
@var = ();
$varcont = " ";
@varcont = ();
$redo = "true";
if ($mainfile[0] =~ /(\s)(if\s+)(\$.*?)(\s)(.*?)(\sfi)(\b)/i) {
print "1" if $debug;
$match = $&;
$begin = $1;
$if = $2;
$var = $3;
$space = $4;
$then = $5;
$fi = $6;
$end = $7;
chomp ($end);
$match = &convmatch (\$match);#$match =~ s#\$#\\\$#ig;
if (eval "$var") {
$mainfile[0] =~ s#$match#$begin$then$end#ig;
} else {
print "-" if $debug;
$mainfile[0] =~ s#$match#$begin$end#ig;
}
$var = "";
} elsif ($mainfile[0] =~ /(\s)(if\s+\!)(\$.*?)(\s)(.*?)(\sfi)(\b)/i) {
print "1b" if $debug;
$match = $&;
$begin = $1;
$if = $2;
$var = $3;
$space = $4;
$then = $5;
$fi = $6;
$end = $7;
chomp ($end);
$match = &convmatch (\$match);#$match =~ s#\$#\\\$#ig;
if (eval "\!$var") {
$mainfile[0] =~ s#$match#$begin$then$end#ig;
} else {
print "~" if $debug;
$mainfile[0] =~ s#$match#$begin$end#ig;
}
$var = "";
} elsif ($mainfile[0] =~ /(^if\s+)(\$.*?)(\s)(.*)/i) {
print "2" if $debug;
$match = $&;
$if = $1;
$var = $2;
$space = $3;
$then = $4;
if (eval "$var") {
$match = &convmatch (\$match); #$match =~ s#\$#\\\$#ig;
$mainfile[0] =~ s#$match#$then#i;
} else {
print "^" if $debug;
shift (@mainfile);
}
$var = "";
} elsif ($mainfile[0] =~ /(^if\s+\!)(\$.*?)(\s)(.*)/i) {
print "2b" if $debug;
$match = $&;
$if = $1;
$var = $2;
$space = $3;
$then = $4;
if (eval "\!$var") {
$match = &convmatch (\$match); #$match =~ s#\$#\\\$#ig;
$mainfile[0] =~ s#$match#$then#i;
} else {
print "'`" if $debug;
shift (@mainfile);
}
$var = "";
# substitute $name.htpl with content of file name.htpl
} elsif ($mainfile[0] =~ /([^\\]*)(\$)(\S+\.htpl)(.*)/i) {
print "4" if $debug;
$match = $&;
$begin = $1;
$var = $2.$3;
$file = $3;
$end = $4;
if (-r $file) {
@htplfile = ();
open (HTPLFILE, $file) || die $!;
while (defined ($line = <HTPLFILE>)) {
push (@htplfile, $line);
}
close (HTPLFILE);
if (@htplfile) {
$varcont = join ("", @htplfile);
} else {
print "-" if $debug;
$var = "\\".$var;
$match = &convmatch (\$match); #$match =~ s#\$#\\\$#ig;
$mainfile[0] = $begin.$end; #= s/$match/$begin$end/ig;
$var = "";
}
} else {
print "-" if $debug;
$var = "\\".$var;
$match = &convmatch (\$match); #$match =~ s#\$#\\\$#ig;
$mainfile[0] = $begin.$end; #= s/$match/$begin$end/i;
$var = "";
}
# $variables without if or if ... fi
} elsif ($mainfile[0] =~ /([^\\]*?)(\$.*?)(\W)/i) {
print "5" if $debug;
$match = $&;
$begin = $1;
$var = $2;
$end = $3;
if (eval "$var") {
$varcont = eval "$var";
} else {
print "-$var:" if $debug;
$var = "\\".$var;
$match = &convmatch (\$match); #$match =~ s#\$#\\\$#ig;
$mainfile[0] =~ s/$match/$begin$end/ig;
$var = "";
}
# @!variables without if or if ... fi
} elsif ($mainfile[0] =~ /([^\\]*?)(\@)(\!)(.*?)(\W)/i) {
print "6" if $debug;
$match = $&;
$begin = $1;
$var = $2.$3.$4;
$variable = $2.$4;
$varname = $4;
$end = $5;
if (eval "$variable") {
$varcont = eval ('$'.$varname.'[0]');
} else {
print "-" if $debug;
$match = &convmatch (\$match); #$match =~ s#\$#\\\$#ig; $match =~ s#\@#\\\@#ig;
$mainfile[0] =~ s/$match/$begin$end/ig;
$var = "";
}
# @variables without if or if ... fi
} elsif ($mainfile[0] =~ /([^\\]*?[^\\])(\@.*?)(\W)/i) {
print "7" if $debug;
$match = $&;
$begin = $1;
$var = $2;
print "$var" if $debug;
$end = $3;
if (eval "$var") {
$varcont = eval "shift ($var)";
} else {
print "-" if $debug;
$match = &convmatch (\$match); #$match =~ s#\$#\\\$#ig; $match =~ s#\@#\\\@#ig;
$mainfile[0] =~ s/$match/$begin$end/ig;
$var = "";
}
} else {
print "0" if $debug;
$redo = "";
}
if ($redo && $var) {
$var = "\\".$var;
$varcont || ($varcont = "");
chomp ($varcont);
@varcont = split ($/, $varcont);
if ($varcont && (@varcont > 1)) {
# $htplpnummer = @varcont;
foreach (@varcont) {
$_ .= $/;
}
print "*|" if $debug;
$first = shift (@mainfile);
chomp ($varcont[0]);
$first =~ s/$begin$var$end/$begin$varcont[0]/ig;
shift (@varcont);
chomp ($varcont[$#varcont]);
$varcont[$#varcont] = $varcont[$#varcont].$end.$/;
(@mainfile) = ($first, @varcont, @mainfile);
} else {
print "+|" if $debug;
$newbegin = &convmatch (\$begin);
$newend = &convmatch (\$end);
$mainfile[0] =~ s/$newbegin$var$newend/$begin$varcont$end/ig;
}
} elsif (! $redo) {
print ">" if $debug;
$mainfile[0] =~ s/\\\@/\@/ig;
print shift (@mainfile);
} else {
print "|" if $debug;
}
}
print "done while...$/</PRE>$/" if $debug;
sub convmatch {
#
# stupid sub to make sure that the substitutions go right
#
($_) = @_;
$_ = $$_;
#print "$_;" if $debug;
s#\$#\\\$#ig;
s#\*#\\\*#ig;
s#\@#\\\@#ig;
s#\&#\\\&#ig;
s#\?#\\\?#ig;
s#\/#\\\/#ig;
s#\(#\\\(#ig;
s#\)#\\\)#ig;
s#\+#\\\+#ig;
s#\|#\\\|#ig;
s#\[#\\\[#ig;
s#\]#\\\]#ig;
#print "$_:" if $debug;
return $_;
}
sub readhtml {
#
# sub to read in a file and put it's content in one variable
#
my ($file) = @_;
my (@result, $line);
open (BESTAND, $file) || die $!;
while (defined ($line = <BESTAND>)) {
push (@result, $line);
}
close (BESTAND);
return join ("", @result);
}
sub parse_form {
#
# function to get the input from a form and convert the hexadecimal codes it
# might contain...
#
# Get the input
#$buffer = "";
#read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'}) || die $!;
while (<STDIN>) { # this is more useful, especially in debug mode, because
$buffer .= $_; # this way you can enter values from console too. Type
} # something like name1=value1&naam2=&naam3=value3, hit
# enter and then Ctrl-D (under Unix though)
# Split the name-value pairs
@pairs = split(/&/, $buffer);
foreach $pair (@pairs) {
($name, $value) = split(/=/, $pair);
# Un-Webify plus signs and %-encoding
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
$value =~ s#<!--(.|$/)*-->##g;
$value =~ s#\r\n\r\n#\<P\>#ig; # for Unix files to
$value =~ s#\r\n#\<BR\>#ig; # get rid of ^M...
$value =~ s#$/$/#\<P\>#ig;
$value =~ s#$/#\<BR\>#ig;
$FORM{$name} = $value;
}
return %FORM;
}
--- NEW FILE: naam.pl ---
# # substitute $name.pl with evaluated content of file name.pl
# } elsif ($mainfile[0] =~ /([^\\]*)(\$)(\S+\.pl)(.*)/i) {
#print "3" if $debug;
# $match = $&;
# $begin = $1;
# $var = $2.$3;
# $file = $3;
# $end = $4;
# if (-r $file) {
# do $file;
# @plfile = ();
#
# open (PLFILE, $file) || die $!;
# while (defined ($line = <PLFILE>)) {
# push (@plfile, $line);
# }
# close (PLFILE);
#
# if (@plfile) {
# $varcont = eval (join (" ", @plfile));
# } else {
# $varcont = "\t";
# }
##print ":@plfile:$varcont:" if $debug;
# if ($varcont !~ /\S/i) {
# $match = &convmatch (\$match); #$match =~ s#\$#\\\$#ig;
# $mainfile[0] = $begin.$end; #s/$match/$begin$end/ig;
# $var = "";
##print "\"$mainfile[0]\"" if $debug;
# }
# } else {
#print "-" if $debug;
# $match = &convmatch (\$match); #$match =~ s#\$#\\\$#ig;
# $mainfile[0] = $begin.$end; #= s/$match/$begin$end/ig;
# $var = "";
# }
# if ($mainfile[0] !~ /\S/i) {
#print "^" if $debug;
# shift (@mainfile);
# $var = "";
# }
|
