From: "andrew.carroll@okstate.edu" <andrew.carroll@okstate.edu>
Subject: Re: STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW
Date: 2 Apr 2007 07:11:50 -0700
Date: 2007-04-02T07:11:50-07:00 [thread overview]
Message-ID: <1175523110.139336.101840@b75g2000hsg.googlegroups.com> (raw)
In-Reply-To: <ulkhbozn0.fsf@stephe-leake.org>
All the files are below. The last file in the list, called
tables.txt, is the input file. I've supplied the input file I am
using when I get the errors.
with Ada.Text_IO, Ada.Directories, GNAT.Calendar.Time_IO,
Ada.Characters.Latin_1, Ada.IO_Exceptions,
Ada.Strings.Maps.Constants, Ada.Strings.Fixed,
Ada.Characters.Handling, Ada.Calendar,
schema_types, attribute_types, parser, util, index_types;
use parser, GNAT.Calendar.Time_IO, Ada.Characters.Latin_1,
Ada.Strings.Maps.Constants, Ada.Strings.Fixed,
Ada.Characters.Handling, Ada.Calendar, schema_types, attribute_types,
util;
procedure dbprog is
-- the input file contains the table specifications --
input : Ada.Text_IO.File_Type;
------------------------------------
-- Variables for Processing --
------------------------------------
char : Character;
line : string_ptr;
tablename : string_ptr;
datacols : string_array_ptr;
pkcols : string_array_ptr;
schemas : schema_array_ptr;
sindex : Integer := 1;
tupls : tuple_ptr;
procedure showoptionsmenu is
begin
cls;
pl ("---------------------------------------------------",
True);
pl ("Type one of the following at the prompt:", True);
pl (" ", True);
pl ("~ QUIT ", True);
pl ("1 INSERT DATA", True);
pl ("2 UPDATE DATA", True);
pl ("3 DELETE DATA", True);
pl ("4 SHOW RECORDS", True);
pl ("For help type 'help'", True);
pl ("---------------------------------------------------",
True);
pl (">>", False);
while Ada.Text_IO.End_Of_Line loop
Ada.Text_IO.Skip_Line;
end loop;
line := new String'(Ada.Text_IO.Get_Line);
end showoptionsmenu;
function markschema return Integer is
idx : Integer := 0;
begin
--find the schema in schemas.
if schemas'length <= 0 then
return idx;
end if;
loop
idx := idx + 1;
exit when idx > schemas'length
or else Index (To_Upper (schemas
(idx).tablename), tablename.all) > 0;
end loop;
return idx;
end markschema;
procedure getcolumnnamesandvalues is
year : Year_Number;
month : Month_Number;
day : Day_Number;
line : string_ptr := new String'("");
valid : Boolean := False;
begin
--markschema sets sindex to the appropriate index in schemas
--for the table with tablename.
sindex := markschema;
--tables are already loaded and ready to go.
datacols := new string_array (1 .. schemas
(sindex).attributes'length);
for x in 1 .. schemas (sindex).attributes'length loop
if Trim (schemas (sindex).attributes (x).domain,
Ada.Strings.Both) = "DATE" then
while not valid loop
pl
("Enter a YEAR (1901 - 2099) for " &
Trim (schemas (sindex).attributes (x).name,
Ada.Strings.Both) &
" >>",
False,
False);
while Ada.Text_IO.End_Of_Line loop
Ada.Text_IO.Skip_Line;
end loop;
line := new String'(Ada.Text_IO.Get_Line);
if Index (line.all, Decimal_Digit_Set,
Ada.Strings.Outside) > 0 then
pl ("!! INVALID !!", True, False);
elsif Index (line.all, Decimal_Digit_Set,
Ada.Strings.Outside) <= 0
and then Integer'value (line.all) not in
Ada.Calendar.Year_Number'range
then
pl ("!! INVALID !!", True, False);
else
valid := True;
end if;
end loop;
year := Year_Number'value (line.all);
valid := False;
while not valid loop
pl
("Enter a MONTH NUMBER for " &
Trim (schemas (sindex).attributes (x).name,
Ada.Strings.Both) &
" >>",
False,
False);
while Ada.Text_IO.End_Of_Line loop
Ada.Text_IO.Skip_Line;
end loop;
line := new String'(Ada.Text_IO.Get_Line);
if Index (line.all, Decimal_Digit_Set,
Ada.Strings.Outside) > 0 then
pl ("!! INVALID !!", True, False);
elsif Index (line.all, Decimal_Digit_Set,
Ada.Strings.Outside) <= 0
and then Integer'value (line.all) not in
Ada.Calendar.Month_Number'range
then
pl ("!! INVALID !!", True, False);
else
valid := True;
end if;
end loop;
month := Month_Number'value (line.all);
valid := False;
while not valid loop
pl
("Enter a DAY NUMBER for " &
Trim (schemas (sindex).attributes (x).name,
Ada.Strings.Both) &
" >>",
False,
False);
while Ada.Text_IO.End_Of_Line loop
Ada.Text_IO.Skip_Line;
end loop;
line := new String'(Ada.Text_IO.Get_Line);
if Index (line.all, Decimal_Digit_Set,
Ada.Strings.Outside) > 0 then
pl ("!! INVALID !!", True, False);
elsif Index (line.all, Decimal_Digit_Set,
Ada.Strings.Outside) <= 0
and then Integer'value (line.all) not in
Ada.Calendar.Day_Number'range
then
pl ("!! INVALID !!", True, False);
else
valid := True;
end if;
end loop;
day := Day_Number'value (line.all);
datacols.all (x) := new String'(Image (Time_Of (year,
month, day), ISO_Date));
valid := False;
else
while not valid loop
pl
("Enter a value for " &
Trim (schemas (sindex).attributes (x).name,
Ada.Strings.Both) &
"(" &
Trim (schemas (sindex).attributes (x).domain,
Ada.Strings.Both) &
") >>",
False,
False);
while Ada.Text_IO.End_Of_Line loop
Ada.Text_IO.Skip_Line;
end loop;
line := new String'(Ada.Text_IO.Get_Line);
if Trim (schemas (sindex).attributes (x).domain,
Ada.Strings.Both) =
"BOOLEAN"
then
if To_Upper (line.all) = "TRUE" then
line := new String'("True");
valid := True;
elsif To_Upper (line.all) = "FALSE" then
line := new String'("False");
valid := True;
elsif line.all = "1" then
line := new String'("True");
valid := True;
elsif line.all = "0" then
line := new String'("False");
valid := True;
else
pl ("!! INVALID !!", True, False);
end if;
elsif Trim (schemas (sindex).attributes
(x).domain, Ada.Strings.Both) =
"INTEGER"
then
if Index (line.all, Decimal_Digit_Set,
Ada.Strings.Outside) <= 0 then
valid := True;
else
pl ("!! INVALID !!", True, False);
end if;
else --"STRING"
valid := True;
end if;
end loop;
valid := False;
datacols.all (x) := new String'(line.all);
end if;
end loop;
end getcolumnnamesandvalues;
procedure getprimarykeynamesandvalues is
year : Year_Number;
month : Month_Number;
day : Day_Number;
line : string_ptr := new String'("");
valid : Boolean := False;
begin
--markschema sets sindex to the appropriate index in schemas
--for the table with tablename.
sindex := markschema;
pl ("Provide the primary key values to identify the record to
delete.", False, True);
pl ("Press Enter to continue...", True, True);
Ada.Text_IO.Get_Immediate (char);
--tables are already loaded and ready to go.
pkcols := new string_array (1 .. schemas
(sindex).primary_key_count);
for x in 1 .. schemas (sindex).attributes'length loop
if schemas (sindex).attributes (x).isprimarykey then
if Trim (schemas (sindex).attributes (x).domain,
Ada.Strings.Both) = "DATE" then
while not valid loop
pl
("Enter a YEAR (1901 - 2099) for " &
Trim (schemas (sindex).attributes
(x).name, Ada.Strings.Both) &
" >>",
False,
False);
while Ada.Text_IO.End_Of_Line loop
Ada.Text_IO.Skip_Line;
end loop;
line := new String'(Ada.Text_IO.Get_Line);
if Index (line.all, Decimal_Digit_Set,
Ada.Strings.Outside) > 0 then
pl ("!! INVALID !!", True, False);
elsif Index (line.all, Decimal_Digit_Set,
Ada.Strings.Outside) <= 0
and then Integer'value (line.all) not in
Ada.Calendar.Year_Number'range
then
pl ("!! INVALID !!", True, False);
else
valid := True;
end if;
end loop;
year := Year_Number'value (line.all);
valid := False;
while not valid loop
pl
("Enter a MONTH NUMBER for " &
Trim (schemas (sindex).attributes
(x).name, Ada.Strings.Both) &
" >>",
False,
False);
while Ada.Text_IO.End_Of_Line loop
Ada.Text_IO.Skip_Line;
end loop;
line := new String'(Ada.Text_IO.Get_Line);
if Index (line.all, Decimal_Digit_Set,
Ada.Strings.Outside) > 0 then
pl ("!! INVALID !!", True, False);
elsif Index (line.all, Decimal_Digit_Set,
Ada.Strings.Outside) <= 0
and then Integer'value (line.all) not in
Ada.Calendar.Month_Number'
range
then
pl ("!! INVALID !!", True, False);
else
valid := True;
end if;
end loop;
month := Month_Number'value (line.all);
valid := False;
while not valid loop
pl
("Enter a DAY NUMBER for " &
Trim (schemas (sindex).attributes
(x).name, Ada.Strings.Both) &
" >>",
False,
False);
while Ada.Text_IO.End_Of_Line loop
Ada.Text_IO.Skip_Line;
end loop;
line := new String'(Ada.Text_IO.Get_Line);
if Index (line.all, Decimal_Digit_Set,
Ada.Strings.Outside) > 0 then
pl ("!! INVALID !!", True, False);
elsif Index (line.all, Decimal_Digit_Set,
Ada.Strings.Outside) <= 0
and then Integer'value (line.all) not in
Ada.Calendar.Day_Number'range
then
pl ("!! INVALID !!", True, False);
else
valid := True;
end if;
end loop;
day := Day_Number'value (line.all);
pkcols.all (x) := new String'(Image (Time_Of
(year, month, day), ISO_Date));
valid := False;
else
while not valid loop
pl
("Enter a value for " &
Trim (schemas (sindex).attributes
(x).name, Ada.Strings.Both) &
"(" &
Trim (schemas (sindex).attributes
(x).domain, Ada.Strings.Both) &
") >>",
False,
False);
while Ada.Text_IO.End_Of_Line loop
Ada.Text_IO.Skip_Line;
end loop;
line := new String'(Ada.Text_IO.Get_Line);
if Trim (schemas (sindex).attributes
(x).domain, Ada.Strings.Both) =
"BOOLEAN"
then
if To_Upper (line.all) = "TRUE" then
line := new String'("True");
valid := True;
elsif To_Upper (line.all) = "FALSE" then
line := new String'("False");
valid := True;
elsif line.all = "1" then
line := new String'("True");
valid := True;
elsif line.all = "0" then
line := new String'("False");
valid := True;
else
pl ("!! INVALID !!", True, False);
end if;
elsif Trim (schemas (sindex).attributes
(x).domain, Ada.Strings.Both) =
"INTEGER"
then
if Index (line.all, Decimal_Digit_Set,
Ada.Strings.Outside) <=
0
then
valid := True;
else
pl ("!! INVALID !!", True, False);
end if;
else --"STRING"
valid := True;
end if;
end loop;
valid := False;
pkcols.all (x) := new String'(line.all);
end if;
end if;
end loop;
end getprimarykeynamesandvalues;
procedure gettablename is
count : Integer := 1;
begin
pl ("Enter the table name in CAPITAL letters >>", False);
tablename := new String'(Ada.Text_IO.Get_Line);
tablename.all := To_Upper (tablename.all);
while not Ada.Directories.Exists (tablename.all) and count < 5
loop
pl ("Enter the table name in CAPITAL letters >>", False);
tablename := new String'(Ada.Text_IO.Get_Line);
tablename.all := To_Upper (tablename.all);
count := count + 1;
end loop;
if count >= 5 then
raise Constraint_Error;
end if;
end gettablename;
procedure getchosenoptiondata is
begin
gettablename;
--we don't do "4" here because it is just a select and we
don't
--need values for it and we already have the attribute names
in
--the schemas(sindex) object for which to SELECT or SHOW the
--data.
if line.all = "1" then
getcolumnnamesandvalues;
elsif line.all = "2" then
getprimarykeynamesandvalues;
pl (" ", True, True);
pl ("Please enter new values for each item. You can enter
the same ", True, True);
pl ("data if you don't want it modified.", True, True);
pl (" ", True, True);
getcolumnnamesandvalues;
elsif line.all = "3" then
getprimarykeynamesandvalues;
end if;
end getchosenoptiondata;
procedure parsechosenoption is
pkattribs : attribute_array_ptr;
newvalues : attribute_array_ptr;
linelength : Integer;
outline : string_ptr;
begin
if line.all = "1" then
-------------------
-- INSERT DATA --
-------------------
newvalues := new attribute_array (1 .. schemas
(sindex).attributes'length);
--fill in the values on the objects and pass that to
insert.
for x in 1 .. newvalues'length loop
if Trim (schemas (sindex).attributes (x).domain,
Ada.Strings.Both) =
"BOOLEAN"
then
newvalues (x) :=
new booleanattribute'
(name => schemas (sindex).attributes
(x).name,
domain => schemas (sindex).attributes
(x).domain,
isprimarykey => schemas (sindex).attributes
(x).isprimarykey,
byte_start => 0,
byte_end => 0,
value => Boolean'value (datacols
(x).all));
elsif Trim (schemas (sindex).attributes (x).domain,
Ada.Strings.Both) =
"STRING"
then
newvalues (x) :=
new stringattribute'
(name => schemas (sindex).attributes
(x).name,
domain => schemas (sindex).attributes
(x).domain,
isprimarykey => schemas (sindex).attributes
(x).isprimarykey,
byte_start => 0,
byte_end => 0,
value => max_stringlength * ' ');
Replace_Slice
(stringattribute (newvalues (x).all).value,
1,
max_stringlength,
datacols (x).all);
elsif Trim (schemas (sindex).attributes (x).domain,
Ada.Strings.Both) =
"INTEGER"
then
newvalues (x) :=
new integerattribute'
(name => schemas (sindex).attributes
(x).name,
domain => schemas (sindex).attributes
(x).domain,
isprimarykey => schemas (sindex).attributes
(x).isprimarykey,
byte_start => 0,
byte_end => 0,
value => Integer'value (datacols
(x).all));
else -- "DATE"
newvalues (x) :=
new dateattribute'
(name => schemas (sindex).attributes
(x).name,
domain => schemas (sindex).attributes
(x).domain,
isprimarykey => schemas (sindex).attributes
(x).isprimarykey,
byte_start => 0,
byte_end => 0,
value => Value (datacols (x).all),
year => Year (Value (datacols
(x).all)),
month => Month (Value (datacols
(x).all)),
day => Day (Value (datacols
(x).all)));
end if;
end loop;
insertrec (schemas (sindex).all, newvalues.all);
elsif line.all = "2" then
-------------------
-- UPDATE DATA --
-------------------
pkattribs := new attribute_array (1 .. pkcols'length);
--fill in the values on the objects and pass that to
insert.
for x in 1 .. pkcols'length loop
if Trim (schemas (sindex).attributes (x).domain,
Ada.Strings.Both) =
"BOOLEAN"
then
pkattribs (x) :=
new booleanattribute'
(name => schemas (sindex).attributes
(x).name,
domain => schemas (sindex).attributes
(x).domain,
isprimarykey => schemas (sindex).attributes
(x).isprimarykey,
byte_start => 0,
byte_end => 0,
value => Boolean'value (pkcols
(x).all));
elsif Trim (schemas (sindex).attributes (x).domain,
Ada.Strings.Both) =
"STRING"
then
pkattribs (x) :=
new stringattribute'
(name => schemas (sindex).attributes
(x).name,
domain => schemas (sindex).attributes
(x).domain,
isprimarykey => schemas (sindex).attributes
(x).isprimarykey,
byte_start => 0,
byte_end => 0,
value => max_stringlength * ' ');
Replace_Slice
(stringattribute (pkattribs (x).all).value,
1,
max_stringlength,
pkcols (x).all);
elsif Trim (schemas (sindex).attributes (x).domain,
Ada.Strings.Both) =
"INTEGER"
then
pkattribs (x) :=
new integerattribute'
(name => schemas (sindex).attributes
(x).name,
domain => schemas (sindex).attributes
(x).domain,
isprimarykey => schemas (sindex).attributes
(x).isprimarykey,
byte_start => 0,
byte_end => 0,
value => Integer'value (pkcols
(x).all));
else -- "DATE"
pkattribs (x) :=
new dateattribute'
(name => schemas (sindex).attributes
(x).name,
domain => schemas (sindex).attributes
(x).domain,
isprimarykey => schemas (sindex).attributes
(x).isprimarykey,
byte_start => 0,
byte_end => 0,
value => Value (pkcols (x).all),
year => Year (Value (pkcols (x).all)),
month => Month (Value (pkcols
(x).all)),
day => Day (Value (pkcols (x).all)));
end if;
end loop;
newvalues := new attribute_array (1 .. schemas
(sindex).attributes'length);
--fill in the values on the objects and pass that to
insert.
for x in 1 .. newvalues'length loop
if Trim (schemas (sindex).attributes (x).domain,
Ada.Strings.Both) =
"BOOLEAN"
then
newvalues (x) :=
new booleanattribute'
(name => schemas (sindex).attributes
(x).name,
domain => schemas (sindex).attributes
(x).domain,
isprimarykey => schemas (sindex).attributes
(x).isprimarykey,
byte_start => 0,
byte_end => 0,
value => Boolean'value (datacols
(x).all));
elsif Trim (schemas (sindex).attributes (x).domain,
Ada.Strings.Both) =
"STRING"
then
newvalues (x) :=
new stringattribute'
(name => schemas (sindex).attributes
(x).name,
domain => schemas (sindex).attributes
(x).domain,
isprimarykey => schemas (sindex).attributes
(x).isprimarykey,
byte_start => 0,
byte_end => 0,
value => max_stringlength * ' ');
Replace_Slice
(stringattribute (newvalues (x).all).value,
1,
max_stringlength,
datacols (x).all);
elsif Trim (schemas (sindex).attributes (x).domain,
Ada.Strings.Both) =
"INTEGER"
then
newvalues (x) :=
new integerattribute'
(name => schemas (sindex).attributes
(x).name,
domain => schemas (sindex).attributes
(x).domain,
isprimarykey => schemas (sindex).attributes
(x).isprimarykey,
byte_start => 0,
byte_end => 0,
value => Integer'value (datacols
(x).all));
else -- "DATE"
newvalues (x) :=
new dateattribute'
(name => schemas (sindex).attributes
(x).name,
domain => schemas (sindex).attributes
(x).domain,
isprimarykey => schemas (sindex).attributes
(x).isprimarykey,
byte_start => 0,
byte_end => 0,
value => Value (datacols (x).all),
year => Year (Value (datacols
(x).all)),
month => Month (Value (datacols
(x).all)),
day => Day (Value (datacols
(x).all)));
end if;
end loop;
updaterec (schemas (sindex).all, pkattribs.all,
newvalues.all);
elsif line.all = "3" then
-------------------
-- DELETE DATA --
-------------------
Ada.Text_IO.Put_Line (Integer'image (sindex));
Ada.Text_IO.Put_Line (tablename.all);
pkattribs := new attribute_array (1 .. pkcols'length);
--fill in the values on the objects and pass that to
delete.
for x in 1 .. pkcols'length loop
if Trim (schemas (sindex).attributes (x).domain,
Ada.Strings.Both) =
"BOOLEAN"
then
pkattribs (x) :=
new booleanattribute'
(name => schemas (sindex).attributes
(x).name,
domain => schemas (sindex).attributes
(x).domain,
isprimarykey => schemas (sindex).attributes
(x).isprimarykey,
byte_start => 0,
byte_end => 0,
value => Boolean'value (pkcols
(x).all));
elsif Trim (schemas (sindex).attributes (x).domain,
Ada.Strings.Both) =
"STRING"
then
pkattribs (x) :=
new stringattribute'
(name => schemas (sindex).attributes
(x).name,
domain => schemas (sindex).attributes
(x).domain,
isprimarykey => schemas (sindex).attributes
(x).isprimarykey,
byte_start => 0,
byte_end => 0,
value => max_stringlength * ' ');
Replace_Slice
(stringattribute (pkattribs (x).all).value,
1,
max_stringlength,
pkcols (x).all);
elsif Trim (schemas (sindex).attributes (x).domain,
Ada.Strings.Both) =
"INTEGER"
then
pkattribs (x) :=
new integerattribute'
(name => schemas (sindex).attributes
(x).name,
domain => schemas (sindex).attributes
(x).domain,
isprimarykey => schemas (sindex).attributes
(x).isprimarykey,
byte_start => 0,
byte_end => 0,
value => Integer'value (pkcols
(x).all));
else -- "DATE"
pkattribs (x) :=
new dateattribute'
(name => schemas (sindex).attributes
(x).name,
domain => schemas (sindex).attributes
(x).domain,
isprimarykey => schemas (sindex).attributes
(x).isprimarykey,
byte_start => 0,
byte_end => 0,
value => Value (pkcols (x).all),
year => Year (Value (pkcols (x).all)),
month => Month (Value (pkcols
(x).all)),
day => Day (Value (pkcols (x).all)));
end if;
end loop;
deleterec (schemas (sindex).all, pkattribs.all);
elsif line.all = "4" then
----------------------
-- SELECT RECORDS --
----------------------
linelength := 60;
sindex := markschema;
outline := new String'(1 .. linelength => '-');
pl (outline.all, True, False);
pl (schemas (sindex).tablename, True, False);
pl (outline.all, True, False);
pl ("| ", False, False);
for x in 1 .. schemas (sindex).attributes'length loop
pl (Trim (schemas (sindex).attributes (x).name,
Ada.Strings.Both), False, False);
if x < schemas (sindex).attributes'length then
pl (" | ", False, False);
end if;
end loop;
pl (" |", True, False);
pl (outline.all, True, False);
tupls := selectrec (schemas (sindex).all);
if tupls = null then
pl ("No Data", True, False);
else
for y in 1 .. tupls'length loop
newvalues := tupls (y);
for x in 1 .. newvalues'length loop
if Trim (newvalues (x).domain,
Ada.Strings.Both) = "BOOLEAN" then
pl
(Trim
(Boolean'image (booleanattribute
(newvalues (x).all).value),
Ada.Strings.Both),
False,
False);
elsif Trim (newvalues (x).domain,
Ada.Strings.Both) = "STRING" then
pl
(Trim
(stringattribute (newvalues
(x).all).value,
Ada.Strings.Both),
False,
False);
elsif Trim (newvalues (x).domain,
Ada.Strings.Both) = "INTEGER" then
pl
(Trim
(Integer'image (integerattribute
(newvalues (x).all).value),
Ada.Strings.Both),
False,
False);
else -- "DATE"
pl
(Trim
(Image (dateattribute (newvalues
(x).all).value, ISO_Date),
Ada.Strings.Both),
False,
False);
end if;
if x < newvalues'length then
pl (" ", False, False);
end if;
end loop;
pl (" ", True, False);
end loop;
end if;
pl (outline.all, True, False);
pl ("Press Enter >>", False, False);
Ada.Text_IO.Get_Immediate (char);
end if;
sindex := 0;
tablename := null;
datacols := null;
pkcols := null;
tupls := null;
end parsechosenoption;
begin
cls;
pl ("---------------------------------------------------", True);
pl ("Put your table definitions in a file named ", True);
pl ("tables.txt and place the file in the same folder as", True);
pl ("this program (Parser.exe). Type C to continue or.", True);
pl ("~ to quit.", True);
pl ("---------------------------------------------------", True);
pl (">>", False);
Ada.Text_IO.Get (char);
line := new String'(Ada.Text_IO.Get_Line);
if char = ETX or char = Tilde then
raise Ada.IO_Exceptions.End_Error;
end if;
setinputfile ("tables.txt");
schemas := parsetables;
closeinputfile;
showoptionsmenu;
while line.all /= "~" loop
if line.all = "help" or line.all = "HELP" then
pl ("---------------------------------------------------",
True);
pl ("If you want to quit type the tilde '~' character",
True);
pl ("---------------------------------------------------",
True);
pl (">>", False);
line := new String'(Ada.Text_IO.Get_Line);
cls;
elsif line.all = "goodbye" or
line.all = "GOODBYE" or
line.all = "exit" or
line.all = "EXIT" or
line.all = "quit" or
line.all = "QUIT" or
line.all = "q" or
line.all = "Q"
then
line := new String'("~");
else
------------------------
-- output results --
------------------------
getchosenoptiondata;
parsechosenoption;
showoptionsmenu;
end if;
end loop;
cls;
pl ("---------------------------------------------------", True);
pl ("Goodbye!", True);
pl ("---------------------------------------------------", True);
exception
when Ada.IO_Exceptions.End_Error =>
if Ada.Text_IO.Is_Open (input) then
Ada.Text_IO.Close (input);
end if;
cls;
pl ("---------------------------------------------------",
True);
pl ("An error occured while reading data. Possibly a
missing", True);
pl ("semi-colon or other format character. Or, you pressed ",
True);
pl ("CTRL + C. Goodbye!", True);
pl ("---------------------------------------------------",
True);
when Ada.Calendar.Time_Error =>
pl ("A date value was not entered correctly.", True);
pl ("Unfortunately this will cause the program to exit.",
True);
pl ("Your data is safe so long as you don't 'create fresh'.",
True);
pl ("the table when you start the program again.", True);
when Ada.IO_Exceptions.Data_Error =>
if Ada.Text_IO.Is_Open (input) then
Ada.Text_IO.Close (input);
end if;
when Constraint_Error =>
Ada.Text_IO.Put_Line ("You entered the data wrong.");
end dbprog;
with Ada.Text_IO, schema_types, attribute_types;
use schema_types, attribute_types;
package parser is
file : Ada.Text_IO.File_Type;
---------------------------
-- Utility Methods --
---------------------------
procedure setinputfile (filename : String);
procedure closeinputfile;
function parsetables return schema_array_ptr;
function parsetable return schema'class;
function parseattributes return attribute_array_ptr;
function parseattribute return attribute'class;
end parser;
with Ada.Text_IO, Ada.Directories, Ada.Integer_Text_IO,
Ada.Strings.Fixed, Ada.Characters.Latin_1,
Ada.IO_Exceptions, schema_types, attribute_types, util;
use Ada.Strings.Fixed, Ada.Characters.Latin_1, schema_types,
attribute_types, util;
package body parser is
procedure setinputfile (filename : String) is
begin
Ada.Text_IO.Open (file, Ada.Text_IO.In_File, filename);
end setinputfile;
procedure closeinputfile is
begin
if Ada.Text_IO.Is_Open (file) then
Ada.Text_IO.Close (file);
end if;
end closeinputfile;
-----------------------
-- parseTables --
-----------------------
function parsetables return schema_array_ptr is
eof : Boolean := False;
char : Character;
schemas : schema_array_ptr := null;
swap : schema_array_ptr := null;
schemainfo : schema_ptr := null;
i : Integer := 1;
begin
eatWhite (file, eof);
if not eof then
Ada.Text_IO.Look_Ahead (file, char, eof);
else
raise Ada.IO_Exceptions.End_Error;
end if;
--at this point we should be ready to read the table name.
swap := new schema_array (1 .. max_tables);
while not eof loop
schemainfo := new schema'class'(parsetable);
pl ("Create the table fresh? [y/Y] >>", False, True);
Ada.Text_IO.Get (char);
swap(i) := new schema(schemainfo.attributes'length);
if char = 'y' or char = 'Y' then
swap (i) := schemainfo;
createtable (swap (i));
else
if Ada.Directories.Exists (schemainfo.tablename) then
swap (i) := loadtable (schemainfo.tablename);
else
pl ("No table exists on disc with name = " &
schemainfo.tablename, True, True);
pl ("You will not be able to query " &
schemainfo.tablename, True, True);
pl (" ", True, False);
end if;
end if;
i := i + 1;
eatWhite (file, eof);
if not eof then
Ada.Text_IO.Look_Ahead (file, char, eof);
end if;
end loop;
i := i - 1;
if i < 1 then
schemas := null;
swap := null;
else
schemas := new schema_array (1 .. i);
for x in 1 .. i loop
schemas (x) := swap (x);
end loop;
swap := null;
end if;
return schemas;
end parsetables;
----------------------
-- parseTable --
----------------------
function parsetable return schema'class is
temp : schema_ptr := null;
eof : Boolean := False;
char : Character;
tname : String (1 .. max_tablename_length);
attribs : attribute_array_ptr;
i : Integer := 1;
begin
eatWhite (file, eof);
--at this point we should be ready to read the table name.
--the call to eatwhite might be redundant from the instance
that
--called 'me' but we want to ensure we are in the right
location within
--the file.
if not eof then
Ada.Text_IO.Look_Ahead (file, char, eof);
else
raise Ada.IO_Exceptions.End_Error;
end if;
while char /= Space and
char /= HT and
char /= LF and
char /= CR and
char /= Left_Parenthesis and
not eof
loop
Ada.Text_IO.Get (file, char);
tname (i) := char;
i := i + 1;
Ada.Text_IO.Look_Ahead (file, char, eof);
end loop;
for x in i .. max_tablename_length loop
tname (x) := ' ';
end loop;
--We just read the table name. We are expecting an opening
'('.
--If it's not there then there is a problem with the input
file
--format.
eatWhite (file, eof);
if not eof then
Ada.Text_IO.Look_Ahead (file, char, eof);
if char = Left_Parenthesis then
Ada.Text_IO.Get (file, char);
else
Ada.Text_IO.Put_Line(
" Error in input file format: No attributes found. Must have
(<attribute list>)");
end if;
else
raise Ada.IO_Exceptions.End_Error;
end if;
attribs := parseattributes;
if attribs /= null then
temp := new schema (attribs.all'length);
temp.attributes := attribs.all;
temp.tablename := tname;
for x in 1 .. temp.attributes'length loop
if temp.attributes (x).all.isprimarykey then
temp.primary_key_count := temp.primary_key_count +
1;
end if;
end loop;
else
temp := null;
end if;
--at this point we should have read the ')' for the whole
table spec.
--if we peek, we should find a ';'.
eatWhite (file, eof);
if not eof then
Ada.Text_IO.Look_Ahead (file, char, eof);
if char = Semicolon then
Ada.Text_IO.Get (file, char);
else
Ada.Text_IO.Put_Line
(" Error in input file format: Missing
closing ';' on table spec.");
temp := null;
end if;
else
Ada.Text_IO.Put_Line
(" Error in input file format: Missing closing
')' on table spec.");
temp := null;
end if;
return temp.all;
end parsetable;
---------------------------
-- parseAttributes --
---------------------------
function parseattributes return attribute_array_ptr is
eof : Boolean := False;
char : Character;
attribs : attribute_array_ptr := null;
swap : attribute_array_ptr := null;
i : Integer := 1;
begin
eatWhite (file, eof);
if not eof then
Ada.Text_IO.Look_Ahead (file, char, eof);
else
raise Ada.IO_Exceptions.End_Error;
end if;
--at this point we should be ready to read the attribute name.
if not eof and char /= Right_Parenthesis then
Ada.Text_IO.Look_Ahead (file, char, eof);
else
Ada.Text_IO.Put_Line (" found eof prematurely
or ')' is in wrong place.");
raise Ada.IO_Exceptions.End_Error;
end if;
swap := new attribute_array (1 .. max_columns);
while char /= Right_Parenthesis and char /= Semicolon and not
eof loop
swap (i) := new attribute'class'(parseattribute);
i := i + 1;
eatWhite (file, eof);
if not eof and char /= Right_Parenthesis then
--we are expecting a ')' or a comma.
Ada.Text_IO.Look_Ahead (file, char, eof);
else
raise Ada.IO_Exceptions.End_Error;
end if;
if char /= Comma and char /= Right_Parenthesis and not eof
then
Ada.Text_IO.Put_Line
(" Error in input file: Missing comma
between attributes.");
eof := True;
swap := null;
elsif not eof then
--read the comma or the ')'
Ada.Text_IO.Get (file, char);
end if;
eatWhite (file, eof);
if eof then
Ada.Text_IO.Put_Line ("Missing semi-colon or other
format error.");
raise Ada.IO_Exceptions.End_Error;
end if;
end loop;
i := i - 1;
if i < 1 then
swap := null;
else
attribs := new attribute_array (1 .. i);
for x in 1 .. i loop
attribs (x) := swap (x);
end loop;
swap := null;
end if;
return attribs;
end parseattributes;
--------------------------
-- parseAttribute --
--------------------------
function parseattribute return attribute'class is
temp : attribute_types.attribute_ptr;
eof : Boolean := False;
char : Character;
aname : String (1 .. max_attributename_length);
atype : String (1 .. max_typename_length);
asize : Integer;
isprimarykey : Boolean := False;
i : Integer := 1;
begin
if not eof then
Ada.Text_IO.Look_Ahead (file, char, eof);
else
raise Ada.IO_Exceptions.End_Error;
end if;
while char /= Space and
char /= HT and
char /= LF and
char /= CR and
char /= Left_Parenthesis and
char /= Colon and
not eof
loop
Ada.Text_IO.Get (file, char);
aname (i) := char;
i := i + 1;
Ada.Text_IO.Look_Ahead (file, char, eof);
end loop;
for x in i .. max_attributename_length loop
aname (x) := ' ';
end loop;
--at this point we have the attribute name. Read white space
to
--a parenthesis or an colon.
eatWhite (file, eof);
if not eof then
Ada.Text_IO.Look_Ahead (file, char, eof);
else
raise Ada.IO_Exceptions.End_Error;
end if;
--the next character should be '(' or ':'
if char = Left_Parenthesis then
Ada.Text_IO.Get (file, char);
eatWhite (file, eof);
i := 1;
--read "primary"
while char /= Space and
char /= HT and
char /= LF and
char /= CR and
char /= Right_Parenthesis and
not eof
loop
Ada.Text_IO.Get (file, char);
atype (i) := char;
i := i + 1;
Ada.Text_IO.Look_Ahead (file, char, eof);
end loop;
for x in i .. max_typename_length loop
atype (x) := ' ';
end loop;
if Trim (atype, Ada.Strings.Both) = "PRIMARY" then
isprimarykey := True;
end if;
eatWhite (file, eof);
if not eof then
Ada.Text_IO.Look_Ahead (file, char, eof);
else
raise Ada.IO_Exceptions.End_Error;
end if;
i := 1;
--read "key"
while char /= Space and
char /= HT and
char /= LF and
char /= CR and
char /= Right_Parenthesis and
not eof
loop
Ada.Text_IO.Get (file, char);
atype (i) := char;
i := i + 1;
Ada.Text_IO.Look_Ahead (file, char, eof);
end loop;
for x in i .. max_typename_length loop
atype (x) := ' ';
end loop;
if Trim (atype, Ada.Strings.Both) = "KEY" then
isprimarykey := True;
else
isprimarykey := False;
end if;
eatWhite (file, eof);
if not eof then
Ada.Text_IO.Look_Ahead (file, char, eof);
else
raise Ada.IO_Exceptions.End_Error;
end if;
if char = ')' then
Ada.Text_IO.Get (file, char);
else
Ada.Text_IO.Put_Line
(" Error in input: Missing ')' after
Primary Key designation.");
end if;
eatWhite (file, eof);
if not eof then
Ada.Text_IO.Look_Ahead (file, char, eof);
else
raise Ada.IO_Exceptions.End_Error;
end if;
end if;
if char = Colon then
Ada.Text_IO.Get (file, char);
eatWhite (file, eof);
if not eof then
Ada.Text_IO.Look_Ahead (file, char, eof);
else
raise Ada.IO_Exceptions.End_Error;
end if;
i := 1;
--read the type of the attribute into atype variable
while char /= Space and
char /= HT and
char /= LF and
char /= CR and
char /= Comma and
char /= Left_Parenthesis and
char /= Right_Parenthesis and
char /= Semicolon and
not eof
loop
Ada.Text_IO.Get (file, char);
atype (i) := char;
i := i + 1;
Ada.Text_IO.Look_Ahead (file, char, eof);
end loop;
for x in i .. max_typename_length loop
atype (x) := ' ';
end loop;
eatWhite (file, eof);
--read the left parenthesis
if not eof and
char = Left_Parenthesis and
Trim (atype, Ada.Strings.Both) = "STRING"
then
Ada.Text_IO.Get (file, char);
Ada.Text_IO.Look_Ahead (file, char, eof);
elsif not eof and
char /= Left_Parenthesis and
Trim (atype, Ada.Strings.Both) = "STRING"
then
Ada.Text_IO.Put_Line (" Incorrect syntax:
missing (size) for string.");
elsif eof then
raise Ada.IO_Exceptions.End_Error;
end if;
eatWhite (file, eof);
if not eof then
Ada.Text_IO.Look_Ahead (file, char, eof);
else
raise Ada.IO_Exceptions.End_Error;
end if;
--read the size of the type of the attribute into atype
variable
while char /= Space and
char /= HT and
char /= LF and
char /= CR and
char /= Comma and
char /= Right_Parenthesis and
char /= Left_Parenthesis and
not eof
loop
Ada.Integer_Text_IO.Get (file, asize, 0);
Ada.Text_IO.Look_Ahead (file, char, eof);
end loop;
--I have to do this temporarily to get this program
--to work. ALL strings are the same length. The reason
--is because there is no way to know how long the string
is
--when serializing it in from a file (see loadtable in
--schema_types) before we serialize it so that we can
--provide a length discriminant to the type defined in
--attribute_types. So, we just make them all the same
--length.
asize := max_stringlength;
eatWhite (file, eof);
--read the right parenthesis
if not eof and
char = Right_Parenthesis and
Trim (atype, Ada.Strings.Both) = "STRING"
then
Ada.Text_IO.Get (file, char);
Ada.Text_IO.Look_Ahead (file, char, eof);
elsif not eof and
char /= Right_Parenthesis and
Trim (atype, Ada.Strings.Both) = "STRING"
then
Ada.Text_IO.Put_Line
(" Incorrect syntax: missing (size ~)~
for string.");
elsif eof then
raise Ada.IO_Exceptions.End_Error;
end if;
eatWhite (file, eof);
if Trim (atype, Ada.Strings.Both) = "BOOLEAN" then
temp := new booleanattribute;
temp.name := aname;
temp.domain := atype;
if isprimarykey then
temp.isprimarykey := True;
end if;
elsif Trim (atype, Ada.Strings.Both) = "STRING" then
temp := new stringattribute;
temp.name := aname;
temp.domain := atype;
if isprimarykey then
temp.isprimarykey := True;
end if;
elsif Trim (atype, Ada.Strings.Both) = "INTEGER" then
temp := new integerattribute;
temp.name := aname;
temp.domain := atype;
if isprimarykey then
temp.isprimarykey := True;
end if;
elsif Trim (atype, Ada.Strings.Both) = "DATE" then
temp := new dateattribute;
temp.name := aname;
temp.domain := atype;
if isprimarykey then
temp.isprimarykey := True;
end if;
else
Ada.Text_IO.Put_Line (" unknown type
specified.");
end if;
--after eating the white space we should be left at the
',' or
--the ')'.
eatWhite (file, eof);
if not eof then
Ada.Text_IO.Look_Ahead (file, char, eof);
else
raise Ada.IO_Exceptions.End_Error;
end if;
--we leave the comma in the stream so that parseAttributes
can
--pick it up and loop for the next attribute. We leave
the second
--')' for parseAttributes to read to know when to exit the
loop and
--quit parsing attributes.
if char /= Comma and char /= Right_Parenthesis then
Ada.Text_IO.Put_Line(
" Error in input: Missing ')' after Primary Key
designation or ',' between attributes.")
;
temp := null;
end if;
else
Ada.Text_IO.Put_Line
(
" Error in input file: Format not correct, no type
specified for attribute " &
aname);
temp := null;
end if;
return temp.all;
end parseattribute;
begin
null;
end parser;
with Ada.Text_IO, Ada.Characters.Latin_1, Ada.Strings.Fixed,
Ada.Strings.Maps, Ada.IO_Exceptions;
use Ada.Characters.Latin_1;
package util is
type string_ptr is access all String;
type string_array is array (Integer range <>) of string_ptr;
type string_array_ptr is access all string_array;
max_columns : Integer := 5;
max_tables : Integer := 5;
max_tablename_length : Integer := 25;
max_attributename_length : Integer := 25;
max_stringlength : Integer := 255;
max_typename_length : Integer := 7;
max_filename_length : Integer := 45;
max_index_namelength: integer := 50;
procedure cls;
procedure pl (text : in String; newline : in Boolean; setcolumn :
in Boolean := True);
function tokenize (text : in String) return string_array_ptr;
procedure eatWhite (fin : in out Ada.Text_IO.File_Type; eof : in
out Boolean);
end util;
package body Util is
procedure cls is
i : Integer := 1;
begin
while i < 40 loop
Ada.Text_IO.New_Line;
i := i + 1;
end loop;
end cls;
procedure pl (text : in String; newline : in Boolean; setcolumn :
in Boolean := True) is
begin
if newline then
if setcolumn then
Ada.Text_IO.Set_Col (15);
end if;
Ada.Text_IO.Put_Line (text);
elsif setcolumn then
Ada.Text_IO.Set_Col (15);
Ada.Text_IO.Put (text);
else
Ada.Text_IO.Put (text);
end if;
end pl;
function tokenize (text : in String) return string_array_ptr is
temp : string_array_ptr;
first : Integer := 1;
i : Integer := 1;
number_of_commas : Integer := 0;
data : string_ptr;
data2 : string_ptr;
begin
data := new String'(text);
number_of_commas := Ada.Strings.Fixed.Count (data.all,
Ada.Strings.Maps.To_Set (','));
if number_of_commas > max_columns then
pl ("Invalid number of columns specified", True);
raise Ada.IO_Exceptions.Data_Error;
end if;
temp := new string_array (1 .. number_of_commas + 1);
--first will point to the first comma.
first :=
Ada.Strings.Fixed.Index
(data.all,
Ada.Strings.Maps.To_Set (','),
Ada.Strings.Inside,
Ada.Strings.Forward);
while i <= number_of_commas and number_of_commas < max_columns
loop
temp.all (i) := new String'(data.all (1 .. first - 1));
data2 := new String (1 .. data.all'length - first);
data2.all := data.all (first + 1 .. data.all'length);
data := new String'(data2.all);
i := i + 1;
first :=
Ada.Strings.Fixed.Index
(data.all,
Ada.Strings.Maps.To_Set (','),
Ada.Strings.Inside,
Ada.Strings.Forward);
end loop;
temp.all (i) := new String'(data.all);
return temp;
end tokenize;
--------------------
-- eatWhite --
--------------------
procedure eatWhite (fin : in out Ada.Text_IO.File_Type; eof : in
out Boolean) is
char : Character;
begin
Ada.Text_IO.Look_Ahead (fin, char, eof);
while Ada.Text_IO.End_Of_Line (fin) and not
Ada.Text_IO.End_Of_File (fin) loop
Ada.Text_IO.Skip_Line (fin);
end loop;
Ada.Text_IO.Look_Ahead (fin, char, eof);
while (char = Space or char = HT or char = LF or char = CR)
and
not Ada.Text_IO.End_Of_File (fin)
loop
Ada.Text_IO.Get (fin, char);
while Ada.Text_IO.End_Of_Line (fin) and not
Ada.Text_IO.End_Of_File (fin) loop
Ada.Text_IO.Skip_Line (fin);
end loop;
Ada.Text_IO.Look_Ahead (fin, char, eof);
end loop;
end eatWhite;
begin
null;
end Util;
with util, Ada.Calendar, attribute_types, Ada.Streams.Stream_IO;
use util, attribute_types;
package schema_types is
---------------------------------
-- Variable Declarations --
---------------------------------
fin : Ada.Streams.Stream_IO.File_Type;
fout : Ada.Streams.Stream_IO.File_Type;
type schema (number_of_attributes : Integer) is tagged record
tablename : String (1 .. max_tablename_length) := (1 ..
max_tablename_length => ' ');
attributes : attribute_array (1 ..
number_of_attributes);
byte_start : Integer := 0;
byte_end : Integer := 0;
primary_key_count : Integer := 0;
end record;
type schema_ptr is access all schema'class;
type schema_array is array (Integer range <>) of schema_ptr;
type schema_array_ptr is access all schema_array;
type tuple is array (Integer range <>) of attribute_array_ptr;
type tuple_ptr is access all tuple;
procedure createtable (schemainfo : schema_ptr);
function loadtable (sname : String) return schema_ptr;
function findrecord (schemainfo : schema; values :
attribute_array) return Integer;
procedure insertrec (schemainfo : schema; values :
attribute_array);
procedure deleterec (schemainfo : schema; primary_key_values :
attribute_array);
procedure updaterec
(schemainfo : schema;
pkattribs : attribute_array;
values : attribute_array);
function selectrec (schemainfo : schema) return tuple_ptr;
end schema_types;
with Ada.Streams.Stream_IO, Ada.Calendar, GNAT.Calendar.Time_IO,
Ada.Text_IO, Ada.Strings.Fixed,
Ada.Directories, Ada.IO_Exceptions;
use Ada.Streams.Stream_IO, Ada.Calendar, GNAT.Calendar.Time_IO,
Ada.Strings.Fixed;
package body schema_types is
procedure createtable (schemainfo : schema_ptr) is
fout : File_Type;
attribs : attribute_array_ptr;
attribs2 : attribute_array_ptr;
i : Integer := 1;
ii : Integer := 1;
temp : access attribute'class;
begin
if schemainfo = null then
return;
end if;
-- put them in order first
for x in 1 .. schemainfo.attributes'length loop
for y in x + 1 .. schemainfo.attributes'length loop
if schemainfo.attributes (y).name <
schemainfo.attributes (x).name then
temp := schemainfo.attributes
(y);
schemainfo.attributes (y) := schemainfo.attributes
(x);
schemainfo.attributes (x).all := temp.all;
end if;
end loop;
end loop;
attribs := new attribute_array (1 ..
schemainfo.attributes'length);
attribs2 := new attribute_array (1 ..
schemainfo.attributes'length);
for x in 1 .. schemainfo.attributes'length loop
if schemainfo.attributes (x).isprimarykey then
attribs (i) := schemainfo.attributes (x);
i := i + 1;
else
attribs2 (ii) := schemainfo.attributes (x);
ii := ii + 1;
end if;
end loop;
i := i - 1;
ii := ii - 1;
-- the primary_key attributes first
for x in 1 .. i loop
schemainfo.attributes (x) := attribs (x);
end loop;
-- non-primary key attributes next
for x in 1 .. ii loop
schemainfo.attributes (x + i) := attribs2 (x);
end loop;
Create (fout, Out_File, Trim (schemainfo.all.tablename,
Ada.Strings.Both));
--We are writing the number of attributes so that when we load
--the table we can determine the number of attributes to put
--into the new, loading schema.
Integer'write (Stream (fout),
schemainfo.all.attributes'length);
schemainfo.all.byte_start := Integer'val (Index (fout));
--we output it once so that we can capture the file position for
byte_end
schema'output (Stream (fout), schemainfo.all);
--fill in byte_end
schemainfo.all.byte_end := Integer'val (Index (fout));
close(fout);
Open (fout, Out_File, Trim (schemainfo.all.tablename,
Ada.Strings.Both));
Integer'write (Stream (fout),
schemainfo.all.attributes'length);
--now we have byte_start and byte_end
schema'output (Stream (fout), schemainfo.all);
for x in 1 .. schemainfo.all.attributes'length loop
to_disc(fout, schemainfo.all.attributes(x).all);
end loop;
Close (fout);
end createtable;
function loadtable (sname : String) return schema_ptr is
schemainfo : schema_ptr;
fin : File_Type;
length : Integer;
position : integer;
begin
Open (fin, In_File, Trim (sname, Ada.Strings.Both));
Integer'read (Stream (fin), length);
schemainfo := new schema (length);
schemainfo.all := schema'class'input (Stream
(fin));
--mark where we are at in the file to start reading attributes.
position := Integer'val (Index (fin));
for x in 1 .. schemainfo.attributes'length loop
-----------------------------------------------------
-- Old code I plan on removing
-----------------------------------------------------
-- schemainfo.all.attributes (x).all.byte_start :=
position;
--
-- if Trim (schemainfo.all.attributes (x).domain,
Ada.Strings.Both) = "BOOLEAN" then
-- schemainfo.all.attributes (x) := new
booleanattribute;
-- schemainfo.all.attributes (x).all :=
-- booleanattribute'input (Stream (fin));
-- elsif Trim (schemainfo.all.attributes (x).domain,
Ada.Strings.Both) = "STRING" then
-- schemainfo.all.attributes (x) :=
new stringattribute;
-- schemainfo.all.attributes (x).all :=
-- stringattribute'input (Stream (fin));
-- elsif Trim (schemainfo.all.attributes (x).domain,
Ada.Strings.Both) = "INTEGER" then
-- schemainfo.all.attributes (x) :=
new integerattribute;
-- schemainfo.all.attributes (x).all :=
-- integerattribute'input (Stream (fin));
-- else -- "DATE"
-- schemainfo.all.attributes (x) :=
new dateattribute;
-- schemainfo.all.attributes (x).all :=
-- dateattribute'input (Stream (fin));
-- end if;
-- position := Integer'val (Index (fin));
-- schemainfo.all.attributes (x).all.byte_end :=
position;
-- End old code
------------------------------------------------------
-----------------------------------------------------------
-- The code I want to use for dispatching
-----------------------------------------------------------
-- schemainfo.all.attributes (x) := new
attribute'class'(from_disc(fin, schemainfo.all.attributes (x).all));
-----------------------------------------------------------
------------------------------------------------------------
-- Debug code below --
------------------------------------------------------------
-- For some reason some of the attributes on schemainfo come through
-- as "unknown" after the schemainfo was filled in from
'input(stream).
-- It doesn't appear to me that createtable procedure in this package
-- writes the schema object incorrectly so I don't understand why
-- the attributes of the schemainfo object we retrieve with 'input are
-- "unknown". Well, the domain member of the attribute is not one of
-- BOOLEAN, STRING, INTEGER or DATE; that's why it prints it but why
-- isn't the domain member one of those values?
if Trim (schemainfo.all.attributes (x).domain,
Ada.Strings.Both) = "BOOLEAN" then
ada.text_io.put_line(schemainfo.all.attributes (x).name);
ada.text_io.put_line(schemainfo.all.attributes (x).domain);
elsif Trim (schemainfo.all.attributes (x).domain,
Ada.Strings.Both) = "STRING" then
ada.text_io.put_line(schemainfo.all.attributes (x).name);
ada.text_io.put_line(schemainfo.all.attributes (x).domain);
elsif Trim (schemainfo.all.attributes (x).domain,
Ada.Strings.Both) = "INTEGER" then
ada.text_io.put_line(schemainfo.all.attributes (x).name);
ada.text_io.put_line(schemainfo.all.attributes (x).domain);
elsif Trim (schemainfo.all.attributes (x).domain,
Ada.Strings.Both) = "DATE" then
ada.text_io.put_line(schemainfo.all.attributes (x).name);
ada.text_io.put_line(schemainfo.all.attributes (x).domain);
else
ada.text_io.put_line("unknown");
end if;
end loop;
-- End Debug Code
---------------------------------------------------------------
Close (fin);
return schemainfo;
exception
when Ada.IO_Exceptions.Status_Error =>
Ada.Text_IO.Put_Line ("Status error in loadtable");
return null;
end loadtable;
---------------------
-- INSERT RECORD --
---------------------
procedure insertrec (schemainfo : schema; values :
attribute_array) is
location : Integer := -1;
char : Character;
begin
location := findrecord (schemainfo, values);
--if the record isn't in there it is -1
if location = -1 then
Open (fout, Append_File, Trim (schemainfo.tablename,
Ada.Strings.Both));
for x in 1 .. schemainfo.attributes'length loop
to_disc(fout, values (x).all);
end loop;
Close (fout);
else
pl ("Record already exists with that key", True, True);
pl ("Press Enter to continue...", True, True);
Ada.Text_IO.Get_Immediate (char);
end if;
end insertrec;
---------------------
-- SELECT RECORD --
---------------------
function selectrec (schemainfo : schema) return tuple_ptr is
temp : attribute_array_ptr;
recs : tuple_ptr;
recs2 : tuple_ptr;
i : Integer := 1;
begin
Open (fin, In_File, Trim (schemainfo.tablename,
Ada.Strings.Both));
Set_Index
(fin,
Ada.Streams.Stream_IO.Count'val
(schemainfo.attributes
(schemainfo.attributes'length).all.byte_end));
temp := new attribute_array (1 ..
schemainfo.attributes'length);
if End_Of_File (fin) then
Close (fin);
return null;
end if;
recs := new tuple (1 .. 1);
while not End_Of_File (fin) loop
for x in 1 .. temp.all'length loop
temp(x) := new attribute'class'(from_disc(fin, schemainfo.attributes
(x).all));
end loop;
if i < 2 then
recs (recs'last) := temp;
else
recs2 := new tuple (1 .. recs'length);
for z in 1 .. recs'length loop
recs2 (z) := recs (z);
end loop;
recs := new tuple (1 .. i);
for z in 1 .. recs2'length loop
recs (z) := recs2 (z);
end loop;
recs (recs'last) := temp;
end if;
temp := new attribute_array (1 ..
schemainfo.attributes'length);
i := i + 1;
end loop;
Close (fin);
return recs;
end selectrec;
-------------------
-- FIND RECORD --
-------------------
function findrecord (schemainfo : schema; values :
attribute_array) return Integer is
temp : attribute_array_ptr;
location : Ada.Streams.Stream_IO.Count;
found : Integer := 0;
done : Boolean := False;
comparrisons : Integer := 0;
begin
Open (fin, In_File, Trim (schemainfo.tablename,
Ada.Strings.Both));
Set_Index
(fin,
Ada.Streams.Stream_IO.Count'val
(schemainfo.attributes
(schemainfo.attributes'length).all.byte_end));
temp := new attribute_array (1 ..
schemainfo.attributes'length);
while not End_Of_File (fin) and then not done loop
--mark our current location in the file.
location := Index (fin);
--read the whole line from the file,
for x in 1 .. schemainfo.attributes'length loop
temp(x) := new attribute'class'(from_disc(fin,
schemainfo.attributes(x).all));
end loop;
--then compare them.
comparrisons := 0;
found := 0;
for x in 1 .. values'length loop
if schemainfo.attributes (x).isprimarykey then
comparrisons := comparrisons + 1;
if Trim (values (x).domain, Ada.Strings.Both) =
"BOOLEAN" then
if booleanattribute (temp (x).all).value =
booleanattribute (values (x).all).value
then
found := found + 1;
end if;
--
ada.text_io.put_line(boolean'image(booleanattribute(temp(x).all).value
--));
elsif Trim (values (x).domain, Ada.Strings.Both) =
"STRING" then
if stringattribute (temp (x).all).value =
stringattribute (values (x).all).value
then
found := found + 1;
end if;
--
ada.text_io.put_line(stringattribute(temp(x).all).value);
elsif Trim (values (x).domain, Ada.Strings.Both) =
"INTEGER" then
if integerattribute (temp (x).all).value =
integerattribute (values (x).all).value
then
found := found + 1;
end if;
--
ada.text_io.put_line(integer'image(integerattribute(temp(x).all).value
--));
else -- "DATE"
if dateattribute (temp (x).all).value =
dateattribute (values (x).all).value
then
found := found + 1;
end if;
--
ada.text_io.put_line(image(dateattribute(temp(x).all).value,
--iso_date));
end if;
end if;
end loop;
if found = comparrisons and then comparrisons > 0 then
done := True;
end if;
if End_Of_File (fin) then
done := True;
end if;
end loop;
Close (fin);
if found < comparrisons then
return -1;
elsif found = 0 and then comparrisons = 0 then
return -1;
else
return Integer'val (location);
end if;
end findrecord;
---------------------
-- DELETE RECORD --
---------------------
procedure deleterec (schemainfo : schema; primary_key_values :
attribute_array) is
location : Integer;
original_byte_end : Integer := schemainfo.attributes
(schemainfo.attributes'last).byte_end;
temp : attribute_array_ptr;
char : Character;
begin
location := findrecord (schemainfo, primary_key_values);
--If findrecord seeks past the schema info header in the file
and ends
--on the end of file it will return -1. Therefore, no records
to delete
--in the file.
if location = -1 then
pl ("No records to delete with that key", True, True);
pl ("Press Enter to continue...", True, True);
Ada.Text_IO.Get_Immediate (char);
return;
end if;
Create (fout, Out_File, "swapfile");
Open (fin, In_File, Trim (schemainfo.tablename,
Ada.Strings.Both));
--output the schema header information to the file
Integer'write (Stream (fout), schemainfo.attributes'length);
--I took these out so that we could create a function for
--updating records that returns an rrn. functions do not
--allow out mode parameters and deleterec had an out mode
--parameter because of this next line.
--schemainfo.byte_start := Integer'val (Index (fout));
schema'output (Stream (fout), schemainfo);
--I took these out so that we could create a function for
--updating records that returns an rrn. functions do not
--allow out mode parameters and deleterec had an out mode
--parameter because of this next line.
--schemainfo.byte_end := Integer'val (Index (fout));
for x in 1 .. schemainfo.attributes'length loop
to_disc(fout, schemainfo.attributes(x).all);
end loop;
--set the index on the input file so we skip the header on
input file.
Set_Index (fin, Ada.Streams.Stream_IO.Count'val
(original_byte_end));
temp := new attribute_array (1 ..
schemainfo.attributes'length);
--Read records from one file and insert them into the other
file until
--we get to the location of the record we want to delete.
while Index (fin) < Ada.Streams.Stream_IO.Count'val (location)
loop
for x in 1 .. temp.all'length loop
temp(x) := new attribute'class'(from_disc(fin,
schemainfo.attributes(x).all));
to_disc(fin, temp(x).all);
end loop;
end loop;
--do a blank read to move past the line to delete
for x in 1 .. schemainfo.attributes'length loop
temp(x) := new attribute'class'(from_disc(fin,
schemainfo.attributes(x).all));
end loop;
--output the rest of the records.
while not End_Of_File (fin) loop
for x in 1 .. temp.all'length loop
temp(x) := new attribute'class'(from_disc(fin,
schemainfo.attributes(x).all));
to_disc(fout, temp(x).all);
end loop;
end loop;
Close (fin);
Close (fout);
Ada.Directories.Delete_File (Trim (schemainfo.tablename,
Ada.Strings.Both));
Ada.Directories.Rename ("swapfile", Trim
(schemainfo.tablename, Ada.Strings.Both));
location := findrecord (schemainfo, primary_key_values);
if location >= 1 then
deleterec (schemainfo, primary_key_values);
end if;
end deleterec;
---------------------
-- UPDATE RECORD --
---------------------
procedure updaterec
(schemainfo : schema;
pkattribs : attribute_array;
values : attribute_array)
is
position : Integer := 0;
char : Character;
begin
position := findrecord (schemainfo, pkattribs);
--if the record doesn't exist then insert it
if position < 1 then
pl ("That record doesn't exist in the database.", True,
True);
pl ("Insert it instead (menu item 1).", True, True);
pl ("Press Enter to continue...", True, True);
Ada.Text_IO.Get_Immediate (char);
elsif position >= 1 then
deleterec (schemainfo, pkattribs);
insertrec (schemainfo, values);
end if;
end updaterec;
begin
null;
end schema_types;
with util, Ada.Calendar, ada.streams.stream_io;
use util, Ada.Calendar, ada.streams.stream_io;
package attribute_types is
-----------------------------------
-- Forwarding Declarations --
-----------------------------------
type attribute is abstract tagged;
type booleanattribute is tagged;
type integerattribute is tagged;
type stringattribute is tagged;
type dateattribute is tagged;
--------------------------------------
-- Attribute Type Declarations --
--------------------------------------
type attribute is abstract tagged record
name : String (1 .. max_attributename_length) :=
(1 .. max_attributename_length => ' ');
domain : String (1 .. max_typename_length) := (1 ..
max_typename_length => ' ');
isprimarykey : Boolean :=
False;
byte_start : Integer := 0;
byte_end : Integer := 0;
end record;
--------------------------------------
-- Basic Pointer Declarations --
--------------------------------------
type attribute_ptr is access attribute'class;
type attribute_array is array (Integer range <>) of access
attribute'class;
type attribute_array_ptr is access all attribute_array;
procedure to_disc (fout: file_type; item: in out attribute) is
abstract;
function from_disc(fout: file_type; item: attribute) return
attribute'class is abstract;
-----------------------------------
-- Extended Attribute Types --
-----------------------------------
type booleanattribute is new attribute with record
value : Boolean := False;
end record;
type booleanattribute_ptr is access all booleanattribute'class;
procedure to_disc (fout: file_type; item: in out
booleanattribute);
function from_disc(fin: file_type; item: booleanattribute) return
attribute'class;
type integerattribute is new attribute with record
value : Integer := 0;
end record;
type integerattribute_ptr is access all integerattribute'class;
procedure to_disc (fout: file_type; item: in out
integerattribute);
function from_disc(fin: file_type; item: integerattribute) return
attribute'class;
type stringattribute is new attribute with record
value : String (1 .. max_stringlength) := (1 ..
max_stringlength => ' ');
end record;
type stringattribute_ptr is access all stringattribute'class;
procedure to_disc (fout: file_type; item: in out stringattribute);
function from_disc(fin: file_type; item: stringattribute) return
attribute'class;
type dateattribute is new attribute with record
year : Year_Number := 1901;
month : Month_Number := 1;
day : Day_Number := 1;
value : Time := Time_Of (1901, 1, 1);
end record;
type dateattribute_ptr is access all dateattribute'class;
procedure to_disc (fout: file_type; item: in out dateattribute);
function from_disc(fin: file_type; item: dateattribute) return
attribute'class;
end attribute_types;
with ada.text_io, util, ada.calendar;
use util, ada.calendar;
package body attribute_types is
procedure to_disc (fout: file_type; item: in out booleanattribute)
is
begin
item.byte_start := Integer'val (Index (fout));
item.byte_end := Integer'val (Index (fout)) +
(booleanattribute'size / 8) - 7;
booleanattribute'class'output(Stream(fout), item);
end to_disc;
function from_disc(fin: file_type; item: booleanattribute) return
attribute'class is
temp : access attribute'class;
begin
temp := new booleanattribute;
temp.all := booleanattribute'class'input (Stream (fin));
return temp.all;
end from_disc;
procedure to_disc (fout: file_type; item: in out integerattribute)
is
begin
item.byte_start := Integer'val (Index (fout));
item.byte_end := Integer'val (Index (fout)) +
(integerattribute'size / 8) - 7;
integerattribute'class'output(Stream(fout), item);
end to_disc;
function from_disc(fin: file_type; item: integerattribute) return
attribute'class is
temp : access attribute'class;
begin
temp := new integerattribute;
temp.all := integerattribute'class'input (Stream (fin));
return temp.all;
end from_disc;
procedure to_disc (fout: file_type; item: in out stringattribute)
is
begin
item.byte_start := Integer'val (Index (fout));
item.byte_end := Integer'val (Index (fout)) +
(stringattribute'size / 8) - 7;
stringattribute'class'output(Stream(fout), item);
end to_disc;
function from_disc(fin: file_type; item: stringattribute) return
attribute'class is
temp: access attribute'class;
begin
temp := new stringattribute;
temp.all := stringattribute'class'input (Stream (fin));
return temp.all;
end from_disc;
procedure to_disc (fout: file_type; item: in out dateattribute) is
begin
item.byte_start := Integer'val (Index (fout));
item.byte_end := Integer'val (Index (fout)) +
(dateattribute'size / 8) - 11;
dateattribute'class'output(Stream(fout), item);
end to_disc;
function from_disc(fin: file_type; item: dateattribute) return
attribute'class is
temp: access attribute'class;
begin
temp := new dateattribute;
temp.all := dateattribute'class'input (Stream (fin));
return temp.all;
end from_disc;
begin
null;
end attribute_types;
with Ada.Streams.Stream_IO, util, attribute_types,Ada.Calendar; use
util, attribute_types,Ada.Calendar;
package index_types is
---------------------------------
-- Variable Declarations --
---------------------------------
fin : Ada.Streams.Stream_IO.File_Type;
fout : Ada.Streams.Stream_IO.File_Type;
--------------------------------------------------------
-- THIS FILE IS NOT COMPLETE NOR USED YET!!!
-- IT IS INCLUDED BECAUSE IT IS WITH'D
--------------------------------------------------------
--an index is a file
--it contains the primary key value and file position for the
primary key for a primary index
--the spec sounds like only one attribute will make up a primary
key.
--for a secondary index it contains an attribute and a position.
--The spec says only one attribute.
--primary indexes are named after the table it belongs to
<tablename>_PIDX
--secondary indexes are named after the table it belongs to like
<tablename>_SIDX
--each schema object has a list of index names for a table
--initially the list of index names is empty
--the user adds an index to the table and then the index name goes
into the list of indexes on
--the schema
--the schema information will have to be re-written to the table
file when an index is added.
--This is the same for the secondary indexes
--if a tuple that an index is based on is inserted, deleted or
updated then the index must be
--loaded and re-created.
----on updates we only have to change the index if the index value
is being changed.
--The attributes store the name of an index on itself. When we load
the schema
--we go through each attribute and determine if it is indexed then
load that
--index if it is. This gives us the "type" on the index value,
elleviates the
--need to maintain a list of index names in the schema object,
----what do we load an index into?
--There are two types of indexes: primary and secondary
--** note ** the primary index is just like the secondary; it only
has one entry per item
--because there is only
--one item allowed per entry due to the fact that primary keys are
unique.
--The differences in indexes are:
----if we remove a value from a secondary we must match the rrn to
remove the correct
--item; with a primary key there is only one to remove.
----when finding a record, with a primary index when we find the
value we don't
----have to search a bunch of records for the exact tuple match.
With secondary
----, because there are multiple values that are the same with
different rrn's
----we have to search each rrn and compare values to match the
tuple.
--we don't sort as we read the table, we read the table and then
sort the index file.
type index is abstract tagged record
filename : String (1 .. max_index_namelength);
rrn : Ada.Streams.Stream_IO.Count := 0;
end record;
type index_ptr is access all index;
type index_array is array (Integer range <>) of index_ptr;
type booleanindex is tagged record
key : boolean;
end record;
type integerindex is tagged record
key : integer;
end record;
type stringindex is tagged record
key : string(1..max_stringlength);
end record;
type dateindex is tagged record
key : time;
end record;
end index_types;
*************************
* Contents of the table.txt file
* This file is used by the main procedure dbprog.
* It must be labeled tables.txt and placed in the
* same directory as the executable dbprog.exe
*************************
T3(
ID(PRIMARY KEY):INTEGER
);
T2(
DATA(PRIMARY KEY):STRING(15)
);
T4(
II(PRIMARY KEY):DATE
);
T1(
mine(PRIMARY KEY):BOOLEAN
);
*************************
next prev parent reply other threads:[~2007-04-02 14:11 UTC|newest]
Thread overview: 46+ messages / expand[flat|nested] mbox.gz Atom feed top
2007-04-02 6:13 STORAGE_ERROR : EXCEPTION_STACK_OVERFLOW andrew.carroll
2007-04-02 10:10 ` Stephen Leake
2007-04-02 14:11 ` andrew.carroll [this message]
2007-04-02 18:43 ` andrew.carroll
2007-04-02 21:48 ` Georg Bauhaus
2007-04-02 21:40 ` andrew.carroll
2007-04-03 10:25 ` Georg Bauhaus
2007-04-03 17:07 ` andrew.carroll
2007-04-03 19:43 ` Simon Wright
2007-04-03 21:32 ` andrew.carroll
2007-04-04 0:49 ` Georg Bauhaus
2007-04-04 0:32 ` andrew.carroll
2007-04-05 18:28 ` Georg Bauhaus
2007-04-09 13:12 ` andrew.carroll
2007-04-09 18:19 ` Georg Bauhaus
2007-04-10 13:22 ` andrew.carroll
2007-04-10 15:07 ` Ludovic Brenta
2007-04-10 20:55 ` andrew.carroll
2007-04-10 22:17 ` Georg Bauhaus
2007-04-10 21:43 ` andrew.carroll
2007-04-12 8:32 ` Ludovic Brenta
2007-04-11 1:55 ` Jeffrey R. Carter
2007-04-11 2:34 ` andrew.carroll
2007-04-05 0:56 ` andrew.carroll
2007-04-02 20:45 ` Simon Wright
2007-04-02 21:47 ` andrew.carroll
2007-04-02 22:05 ` andrew.carroll
2007-04-03 0:09 ` Randy Brukardt
2007-04-11 2:49 ` andrew.carroll
2007-04-11 8:07 ` Georg Bauhaus
2007-04-11 21:31 ` Simon Wright
2007-04-12 16:00 ` andrew.carroll
2007-04-12 19:08 ` Simon Wright
2007-04-12 13:48 ` andrew.carroll
2007-04-12 15:49 ` Georg Bauhaus
-- strict thread matches above, loose matches on Subject: below --
2005-08-05 0:55 Adaddict
2005-08-05 1:21 ` Adaddict
[not found] <200507082148.j68LmXhG002695@mail733.megamailservers.com>
2005-07-09 9:27 ` Marius Amado Alves
2005-07-09 19:14 ` Duncan Sands
[not found] <20050709100024.322314C41FD@lovelace.ada-france.org>
2005-07-09 12:29 ` Robert C. Leif
2005-07-08 21:48 Robert C. Leif
2005-07-09 3:52 ` John B. Matthews
2005-07-12 0:29 ` jim hopper
2005-07-09 22:55 ` Björn Persson
2005-07-11 10:15 ` Alex R. Mosteo
2005-07-11 20:07 ` Keith Thompson
replies disabled
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox