#!/usr/local/bin/perl
# Usages:
# whitespace = space, tab, newline, carriage return, tilde;
# fread_letter: Reads a single letter from FILE, ignoring whitespace,
# returns one character.
#
# fread_number: Reads a number from FILE, ignoring any LEADING
# whitescape. Terminates at the first
# non-number found. Returns a signed integer.
#
# fread_length: Reads the length of file FILE.
# Returns a signed integer.
#
# fread_flag: Reads a single block of characters, ignoring
# leading whitespace, and terminating at trailing
# whitespace. Will read three different formats:
# Alphabetic flags: AGP
# Numeric flags: 32833
# Split Num flags: 1|64|32768
# Returns a string containing Alphabetic flags.
#
# fread_word: Reads a single block of characters, ignoring
# leading whitespace, and terminating at trailing
# whitespace. Returns a string containing the word.
#
# fread_string: Reads from current position (ignoring leading
# whitespace except tilde) to the first tilde.
# Returns a string.
#
# fread_levels: Reads from the first left bracket found till
# the next right bracket found. Returns a string.
#
# fread_to_eol: Reads from current position to the end of the
# current line. Returns nothing.
#
# fread_to_next: Reads from current position to the start of
# the next item. Returns a string containing
# a space, or the word "EOF" if the end of file
# was encountered.
#
# All routines require the following global variables:
# FILE The open filehandle.
# $pointer Keeps track of the current position
# in the file, should be set to 0 when
# FILE is first opened.
#
sub fread_letter {
local($var,$a);
$a = 0;
while ($a == 0)
{
$var = "";
seek(FILE, $pointer, 0);
if (sysread(FILE, $var, 1) == 0)
{
print "\nBUG: fread_letter: EOF reached. $pointer\n";
exit;
}
$pointer++;
print "\t\t$pointer X\n";
if (($var gt " ")&&($var lt "~"))
{
$a++;
}
}
return $var;
}
sub fread_number {
local($num,$text,$var,$a);
$a = 0;
$num = 0;
undef $text;
while ($a == 0)
{
$var = "";
seek(FILE, $pointer, 0);
if (sysread(FILE, $var, 1) == 0)
{
print "\nBUG: fread_number: EOF reached. $pointer\n";
exit;
}
if (($var eq "+")&&(!defined($text)))
{
$var = " ";
}
if ((($var lt "0") || ($var gt "9")) && ($var ne "-"))
{
if (($var le " ")&&(!defined($text)))
{
$pointer++;
} else {
$a++;
}
} else {
if (($var eq "-") && (defined($text)))
{
$a++;
} else {
$pointer++;
if (!defined($text))
{
$text = $var;
} else {
$text .= $var;
}
print $text, "\n";
}
}
}
if (!defined($text))
{
print "\nBUG: fread_number: Expected a number. $pointer\n";
exit;
}
$num = $text;
$num++;
$num--;
return $num;
}
sub fread_length {
local($var,$a,$leng);
$a = 0;
$leng = 0;
while ($a == 0)
{
$var = "";
seek(FILE, $leng, 0);
if (sysread(FILE, $var, 1) == 0)
{
return $leng;
}
$leng++;
}
return $leng;
}
sub fread_flag {
local($text,$var,$a,@text,$len,$num,$tmp,$flg,%done);
$a = 0;
$text = "";
while ($a == 0)
{
$var = "";
seek(FILE, $pointer, 0);
if (sysread(FILE, $var, 1) == 0)
{
print "\nBUG: fread_flag: EOF reached. $pointer\n";
exit;
}
if ((($var le ' ')||($var ge '~'))&&($text ne ""))
{
$a++;
} else {
if (($var ge '!')&&($var le '}'))
{
$text .= $var;
}
$pointer++;
}
}
$num = 0;
if ($text eq "0")
{
return $text;
}
@text = split(/\|/, $text);
$len = @text;
if ($len > 1)
{
foreach $tmp (@text)
{
$num += $tmp;
}
$text = $num;
}
@text = split('', $text);
if (($text[0] ge '0') && ($text[0] le '9'))
{
$num = $text;
} else
{
undef %done;
foreach $tmp (@text)
{
if (!defined($done{$tmp}))
{
$num += $flag{$tmp};
$done{$tmp} = "yes";
}
}
undef %done;
}
$num++;
$num--;
if ($num >= 1099511627776)
{
print "\nBUG: fread_flag: flag number out of range. $pointer\n";
exit;
}
$flg = "";
foreach $tmp (reverse(sort(keys(%flag))))
{
if ($flag{$tmp} <= $num)
{
$flg .= $tmp;
$num -= $flag{$tmp};
}
}
$flg = join('', sort(split('', $flg)));
print "\t\t\t\t\t$flg\n";
return $flg;
}
sub fread_word {
local($text,$var,$a,$quote);
$a = 0;
$quote = 0;
$text = "";
while ($a == 0)
{
$var = "";
seek(FILE, $pointer, 0);
if (sysread(FILE, $var, 1) == 0)
{
print "\nBUG: fread_word: EOF reached. $pointer\n";
exit;
}
if ((($var le " ")||($var ge "~"))&&($text ne "")&&($quote == 0))
{
$a++;
} else {
if (($var ge "!")&&($var le "}"))
{
if (($var eq "\'") && ($quote == 0))
{
$quote = 1;
$text .= $var;
} elsif ($var eq "\'")
{
$quote = 0;
$text .= $var;
} else
{
$text .= $var;
}
} elsif (($quote == 1) && ($var ge " ") && ($var le "}"))
{
$text .= $var;
}
$pointer++;
}
}
print "\t\t\t\t\t$text\n";
return $text;
}
sub fread_string {
local($text,$var,$a);
$a = 0;
$text = "";
while ($a == 0)
{
$var = "";
seek(FILE, $pointer, 0);
if (sysread(FILE, $var, 1) == 0)
{
print "\nBUG: fread_string: EOF reached. $pointer\n";
exit;
}
if (($var le " ")&&($text eq ""))
{
$pointer++;
} elsif ($var eq "~")
{
$pointer++;
$a++;
} else
{
$text .= $var;
$pointer++;
}
}
print "\t\t\t\t$text\n";
return $text;
}
sub fread_levels {
local($text,$var,$a,$vala,$valb);
$a = 0;
$text = "";
while ($a == 0)
{
$var = "";
seek(FILE, $pointer, 0);
if (sysread(FILE, $var, 1) == 0)
{
print "\nBUG: fread_string: EOF reached. $pointer\n";
exit;
}
if (($var ne '{')&&($var ne '<')&&($text eq ""))
{
$pointer++;
} elsif (($var eq '}')||($var eq '>'))
{
$text .= $var;
$pointer++;
$a++;
} else
{
$text .= $var;
$pointer++;
}
}
return $text;
}
sub fread_to_eol {
local($var,$a);
$a = 0;
while ($a == 0)
{
$var = "";
seek(FILE, $pointer, 0);
if (sysread(FILE, $var, 1) == 0)
{
print "\nBUG: fread_to_eol: EOF reached. $pointer\n";
exit;
}
if (($var eq "\n") || ($var eq "\r"))
{
$a++;
}
$pointer++;
}
return;
}
sub fread_to_next {
local($text,$var,$a);
$a = 0;
$text = "";
while ($a == 0)
{
$var = "";
seek(FILE, $pointer, 0);
if (sysread(FILE, $var, 1) == 0)
{
return "EOF";
}
if ($var eq '#')
{
$a++;
} else
{
$pointer++;
}
}
return " ";
}
1;