program vs_validator;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes, db, memds,strutils, sysutils,bufstream;

type
  strmaxsizes = record
    fieldname:string;
    width:integer;
  end;

var
  ds_cargo_imp,ds_cargo,ds_dock,ds_light,ds_masterpartslist,
  ds_mounts,ds_subunit,ds_units,ds_upgrades:tmemdataset;
  workdir:string;
  strmax:array of strmaxsizes;
  listof_categories: TStringList;


Procedure compareMax(st:string; t_width:integer);
function findhandle(teststr:string;r_low,r_high:integer):integer;
var
  half:integer;
  x:integer;
begin
  result := -1;
  if r_low = r_high then
  begin
  if teststr = strmax[r_low].fieldname then
    result:=r_low;
  end
  else
  begin
    half:=(r_high - r_low + 1) shr 1;
    if teststr < strmax[r_low + half].fieldname then
      result:=findhandle(teststr,r_low,r_low + half - 1) else
      result:=findhandle(teststr,r_low + half,r_high);
  end;
end;
var
  n:integer = 0;
  i:integer;
  temp:strmaxsizes;
begin
  if high(strmax) = -1 then n:= -1 else n:=findhandle(st,0,high(strmax));
  if n = -1 then
  begin
    setlength(strmax,high(strmax) + 2);
    n:=high(strmax);
    strmax[n].fieldname:=st;
    strmax[n].width:=t_width;
    while (n > 0) and (strmax[n - 1].fieldname > strmax[n].fieldname) do
    begin
      temp:=strmax[n];
      strmax[n]:=strmax[n - 1];
      strmax[n - 1]:=temp;
      dec(n);
    end;
  end else
  if strmax[n].width < t_width then strmax[n].width:=t_width;
//  n:=high(strmax);
end;

Procedure Createdb;
begin
  ds_cargo_imp:=tmemdataset.Create(nil);
  ds_cargo_imp.Name:='cargo_import';

  ds_cargo:=tmemdataset.create(nil);
  ds_cargo.Name:='cargo';

  ds_dock:=tmemdataset.create(nil);
  ds_dock.Name:='dock';

  ds_light:=tmemdataset.create(nil);
  ds_light.name:='light';

  ds_mounts:=tmemdataset.create(nil);
  ds_mounts.name:='mounts';

  ds_subunit:=tmemdataset.create(nil);
  ds_subunit.name:='subunit';

  ds_units:=tmemdataset.create(nil);
  ds_units.name:='units';

  ds_upgrades:=tmemdataset.create(nil);
  ds_upgrades.name:='upgrades';

  ds_masterpartslist:=tmemdataset.create(nil);
  ds_masterpartslist.name:='masterpartslist';

  {$I sidetables.inc}
end;

Procedure ParsecsvToMemds(filename:string;thedb:tmemdataset; skip:integer);
{New Parser, takes comma delimited file and makes it into a database.
All the real work is done by classes.

10-31-2006}
var
  ThefileIO:tfilestream;
  Thefile:treadbufstream;
  parsed:tstringlist;
  tempst:ansistring = '';
  ch:char = #0;
  x:integer;
  tint:int64;
  tfloat:double;
  line:integer = 1;
begin
  write('Processing ',filename,' no error checks -');
  Try
    parsed:=tstringlist.create; //create holding area
    parsed.delimiter:=',';
    parsed.quotechar:='"';

    ThefileIO:=tfilestream.Create(filename,fmOpenRead);
    Thefile:=treadbufstream.Create(ThefileIO,4096);

    thedb.Clear(false);
    thedb.Open;

    while Thefile.read(ch,1) > 0 do
    begin
      if ch = #10 then
      begin
        inc(line);
        if line > skip then
        begin
          if (tempst <> '') and (tempst[1] <> ',') then
          begin
            thedb.append;
            parsed.clear;
            parsed.delimitedtext:=tempst;
            for x:=0 to parsed.count - 1 do
            Case thedb.fields[x].datatype Of
              ftString: thedb.fields[x].AsString := parsed.strings[x];
              ftLargeint:  //some of the values are largish
              Begin
                val(parsed.strings[x],tint);
                thedb.fields[x].AsLargeInt := tint;
              End;
              ftBoolean: //some of the booleans have 0 or 1?
              Begin
                If (parsed.strings[x]='TRUE')
                Or (parsed.strings[x]='1') Then thedb.Fields[x].AsBoolean := true
                Else
                If (parsed.strings[x]='FALSE')
                Or (parsed.strings[x]='0')
                or (parsed.strings[x]='') Then thedb.Fields[x].AsBoolean := false;
              End;
              ftFloat:
              Begin
                val(parsed.strings[x],tfloat);
                thedb.fields[x].AsFloat := tfloat;
              End;
                //ftInteger: thedb.fields[x].AsInteger := assignmemo(parsed.strings[x]);
            End;
            thedb.post;
         end;
         tempst:='';
        end;
      end else
        tempst:=tempst + ch;
  end;
  Finally
    thefile.destroy;
    ThefileIO.free;
    writeln(' Done.');
  end;
end;


function goodstr(st:string; ck:tsyscharset):boolean;
var x:integer;
begin
  result:=true;
  for x:=1 to length(st) do
  if not(st[x] in ck) then
  begin
    result:=false;
    break;
  end;
end;

Procedure Parse_textToRecs(bufferstr:ansistring; thetable:tmemdataset; row:integer);

Var
  i,fld,lastpos: integer;
  tmpfloat: double;
  tmpint: integer;
  wasclosed:boolean;
  substr:string;
  err:integer;
  temp_filename:string;
Begin
  lastpos := 0;
  fld := 0;

  If thetable.RecordCount > 0 Then thetable.Clear(false);
  thetable.Open;
  wasclosed:=true;
  For i:=1 To length(bufferstr) Do
    Begin
      If bufferstr[i]='{' Then //start of record
        Begin
          fld := 0;
          lastpos := i;
          if not(wasclosed) then writeln('row ', row, ' - ', thetable.Name, ' subquery: unclosed. Data offset: ',i);
          wasclosed:=false;
        End
      Else
        If bufferstr[i] In ['}',';'] Then  //end of field/record, which doesn't matter yet
          Begin
            If fld > thetable.Fields.Count - 1 Then
              writeln('row ',row,' - ', thetable.name, ' subquery: field count exceeds known.')
            Else
              Begin
              substr:=ifthen(lastpos + 1 = i, '', copy(bufferstr,lastpos + 1,i - lastpos - 1));
                Case thetable.Fields[fld].DataType Of
                  ftstring:
                  begin
                    compareMax(thetable.Name + '.' + thetable.Fields[fld].FieldName, length(substr));
                    if length(substr) >= thetable.Fields[fld].datasize then writeln('row ', row,' ', thetable.name,' ', thetable.fields[fld].FieldName, ' - max avail: ',thetable.Fields[fld].datasize,' actual: ',sizeof(substr));
                    if (thetable.name = 'cargo_import') and (thetable.Fields[fld].FieldName = 'Cat') then
                    if  listof_categories.IndexOf(substr) < 0 then writeln('row ', row,' ', thetable.name,' ', thetable.fields[fld].FieldName, ' ', substr,' not found in master part list');

                    if (thetable.name = 'cargo') and (thetable.Fields[fld].FieldName = 'filename') then
                    begin
                      temp_filename:=substr;
                    end;
                    if (thetable.name = 'cargo') and (thetable.Fields[fld].FieldName = 'Category') then
                    begin
                      ds_masterpartslist.First;
                      while not(ds_masterpartslist.EOF)
                           and (ds_masterpartslist.FieldByName('file').AsString <> temp_filename)
                           and (ds_masterpartslist.FieldByName('categoryname').AsString<>substr) do
                      ds_masterpartslist.Next;
                      if (ds_masterpartslist.FieldByName('file').AsString <> temp_filename)
                           and (ds_masterpartslist.FieldByName('categoryname').AsString<>substr) then
                           writeln('row ', row,' ', thetable.name,' ', thetable.fields[fld].FieldName, ' ', temp_filename, ' - ', substr,' not found in master part list');
                    end;
                  end;
                  ftboolean: if (substr <> '') and (substr <> '1') and (substr <> '0') then writeln('row ', row,' ', thetable.name,' ', thetable.fields[fld].FieldName,' ',substr, ' not known boolean value (range of 0..1 expected).');
                  ftfloat: if not((substr = '') or goodstr(substr,['0'..'9','e','E','+','.','-'])) then
                  writeln('row ', row,' ', thetable.Name,'.', thetable.fields[fld].FieldName,' "',substr, '" doesn''t seem to be a float.')
                  else
                  if length(substr) > 0 then
                  begin
                    val(substr,tmpfloat,err);
                    if err > 0 then writeln('row ', row,' ', thetable.name,' ', thetable.fields[fld].FieldName,' ',substr, ' Float conversion of "',substr,'" fails offset ', err, ' strpos ',i);
                  end;

                  ftinteger: if not((substr = '') or goodstr(substr,['0'..'9','-'])) then
                  writeln('row ', row,' ', thetable.name,'.', thetable.fields[fld].FieldName,' "',substr, '" doesn''t seem to be an integer.')
                  else
                  if length(substr) > 0 then
                  begin
                    val(substr,tmpint,err);
                    if err > 0 then writeln('row ', row,' ', thetable.name,'.', thetable.fields[fld].FieldName,' "',substr, '" Int conversion of "',substr,'" fails offset ', err, ' strpos ',i);
                  end;
                End;
              End;
            inc(fld);
            lastpos := i;
            If bufferstr[i] = '}' Then wasclosed:=true;
            //it's the end of record
          End;
    End;
End;

Procedure populatedb;


Var F,F_out: system.text;
  x,n: integer;
  st: ansistring;
  fldptr: integer;
  cptr,qptr: integer;
  workst: string;
  tempst:string;
  tint: int64;
  tfloat: double;
  stringed: boolean;
  maxfield:integer;
  dbheader:array[1..2] of string;
  field: array Of Record
    name: string;
    use: boolean;
  End;
  unknown:integer;
  row:integer = 2;
  err:integer;
  curDirectory:string;
Begin
  writeln('Parser Begins');
  ParsecsvToMemds(workdir + 'master_part_list.csv',ds_masterpartslist, 1);
  ds_masterpartslist.First;
  while not(ds_masterpartslist.EOF) do
  begin
    listof_categories.Add(ds_masterpartslist.FieldByName('categoryname').AsString);
    ds_masterpartslist.Next;
  end;
  ds_units.Clear(false);
  ds_units.Open;
  maxfield := 1;
  system.assign(F,workdir + 'units' + directoryseparator +
                'units.csv');
  reset(F);
  For n:=1 To 2 Do
    readln(F,dbheader[n]);
  //the first two lines are headers
  Writeln('Header Read');
  For n:=1 To length(dbheader[1]) Do
    If dbheader[1][n]=',' Then inc(maxfield);
  setlength(field,maxfield);
  //dynamic arrray can be your friend
  unknown:=0;
  writeln('Unknown fields: ');
  For n:=0 To maxfield - 1 Do
    Begin
      workst := extractdelimited(2,extractdelimited(n + 1,dbheader[1],[',']),['"']);
      field[n].name := ifthen(n = 0, 'Index',ifthen(workst='','unknown' + inttostr(n),workst));
      if n = 0 then field[n].use:=true else field[n].use := false;
      For x:=0 To ds_units.FieldCount - 1 Do
        field[n].use := field[n].use or (ds_units.Fields[x].FieldName = field[n].name);
      if not(field[n].use) then
        begin
          inc(unknown);
          write(field[n].name, '  ');
        end;
    End;
  if unknown = 0 then write(' .. None.');
  writeln;
  
  Writeln('Header Processed.');
  Repeat
    readln(F,st);
    curDirectory:='';
    inc(row);
//    writeln('Reading Line ',row);
    If (st[1]<>',') And (length(st) > 0) Then
      Begin
        fldptr := 0;
        cptr := 0;
        qptr := 0;
        //field pointer, comma pointer, quote pointer
        stringed := false;
        For n:=1 To length(st) Do
          If fldptr >= ds_units.FieldCount Then
            begin
              writeln('Too Many fields: Row ',row);
              break
            end
          Else
            //if the field pointer goes beyond last known field, do no work
            Begin
              If (st[n]='"') Then
                If qptr = 0 Then qptr := n //first quote
              Else
                Begin
                  workst := copy(st,qptr+1,n - qptr - 1);
                  qptr := 0;
                  cptr := -1;
                  stringed := true;
                  //end quote, and we have a string
                End;
              If Not(stringed) And (qptr = 0) And (st[n]=',') Then
                //if not quoted, comma starts or ends string
                If cptr <> -1 Then  //but if we just delt with a quote...
                  Begin
                    workst := copy(st,cptr+1,n - cptr - 1);
                    stringed := true;
                    cptr := n;
                  End
              Else cptr := n;
              if not(stringed) and (n = length(st)) then
              begin
                workst:=copy(st,cptr+1,length(st) - cptr);
                stringed:=true;
              end;

              If stringed Then
                If length(workst) = 0 Then //empty fields can mostly be ignored
                  Begin
                    stringed := false;
                    inc(fldptr);
                  End
              Else
                Begin
                  If field[fldptr].use Then //only deal with fields that exist
                    Case ds_units.FieldByName(field[fldptr].name).datatype Of
                      ftString:
                      begin
                        compareMax('units.' + field[fldptr].name, length(workst));
                        if length(workst) > ds_units.FieldByName(field[fldptr].name).dataSize then writeln('row ',row,' column ',
                            fldptr,  field[fldptr].name, ' ', workst, ' is longer than expected (',
                            length(workst),'>',ds_units.FieldByName(field[fldptr].name).dataSize);
                        if (field[fldptr].name = 'Directory') and (length(workst) > 0) then
                        begin
                          curDirectory := workdir + 'units' + '/' + workst;
                          DoDirSeparators(curDirectory);
                          if not(DirectoryExists(curDirectory)) then
                          begin
                            writeln('row ',row,' column ',fldptr + 1,' Directory ',workst,' directory does not exist.');
                            curDirectory:='';
                          end;
                        end;
                        if (field[fldptr].name = 'Cockpit') and (workst <> '') then
                        begin
                          tempst := workdir + 'cockpits/' + workst;
                          if not(DirectoryExists(tempst)) then
                            writeln('row ',row,' column ',fldptr + 1,' Cockpit ',workst,' directory does not exist.');
                        end;
                        if curDirectory <> '' then
                        begin
                          if ((field[fldptr].name = 'Hud_image')
                          //or (field[fldptr].name = 'Cockpit')
                          or (field[fldptr].name = 'Mesh')
                          or (field[fldptr].name = 'Shield_Mesh')
                          or (field[fldptr].name = 'Rapid_Mesh')
                          or (field[fldptr].name = 'BSP_Mesh')) and (workst <> '') then
                          begin
                            if field[fldptr].name = 'Mesh' then
                              workst := ExtractDelimited(2,workst,['{',';','}']);
                            tempst := curDirectory + '/' + workst;
                            doDirSeparators(tempst);
                            if not(fileexists(tempst)) then
                            begin
                            tempst:= workdir + 'meshes/' + workst;
                            doDirSeparators(tempst);
                            if not(fileexists(tempst)) then writeln('row ',row,' column ',fldptr + 1,' ',field[fldptr].name, ' "',workst,'" file not found');
                            end;
                          end;
                        end;
                      end;
                      ftLargeint:  //some of the values are largish
                                  Begin
                                    if not((workst = '') or goodstr(workst,['0'..'9','-'])) then
                                    writeln('row ',row,' column ', fldptr + 1,' - ', field[fldptr].name, ' ', workst, '<> Integer?') else
                                    begin
                                      val(workst,tint,err);
                                      if err > 0 then writeln('row ',row,' column ', fldptr + 1,' - ', field[fldptr].name, ' ', workst, 'int conversion error offset', err);
                                    end;
                                   End;
                      ftBoolean: //some of the booleans have 0 or 1?
                                 Begin
                                   if (workst <> '') and (workst <> 'TRUE') and (workst <> 'true') and (workst <> 'false') and (workst <> 'FALSE') and (workst <> '0') and (workst <> '1') then
                                   begin
                                    writeln('row ',row,' column ', fldptr + 1,' - ',  field[fldptr].name, ' ', workst, ' <> Boolean?');
                                   end;
                                 End;
                      ftFloat:
                               Begin
                                 if not((workst = '') or goodstr(workst,['0'..'9','.','e','E','+','-']))  then
                                 writeln('row ',row,' column ', fldptr + 1,' - ',  field[fldptr].name, ' ', workst, '<> Float?')
                                 else
                                 begin
                                   val(workst,tfloat,err);
                                   if err > 0 then writeln('row ',row,' column ', fldptr + 1, ' - ', field[fldptr].name, ' ', workst, 'float conversion error offset', err);
                                 end;
                               End;
                      ftInteger:
                      begin
                        if field[fldptr].name = 'Upgrades' then Parse_textToRecs(workst, ds_upgrades, row) else
                        if field[fldptr].name = 'Sub_Units' then Parse_textToRecs(workst, ds_subunit, row) else
                        if field[fldptr].name = 'Light' then Parse_textToRecs(workst, ds_light, row) else
                        if field[fldptr].name = 'Mounts' then Parse_textToRecs(workst, ds_mounts, row) else
                        if field[fldptr].name = 'Dock' then Parse_textToRecs(workst, ds_dock, row) else
                        if field[fldptr].name = 'Cargo_Import' then Parse_textToRecs(workst, ds_cargo_imp, row) else
                        if field[fldptr].name = 'Cargo' then Parse_textToRecs(workst, ds_cargo, row);

                      //do work...
                      end;
                      
                    End;
                  stringed := false;
                  inc(fldptr);
                End;
            End;
        if st[length(st)]=',' then inc(fldptr);
        if fldptr < ds_units.FieldCount then
        writeln('Fields Error, Expected ',ds_units.FieldCount, ' got ',fldptr);
        workst := '';
      End;
  Until eof(F);
  system.close(F);
  writeln('Database processed.');
  ds_units.Active := true;
End;

procedure whichdir;
 const paths = 23;
 pathnames: array[1..paths] Of string
             = ( './','../','../data4.x/','../../data4.x/','../data/','../../data/',
                '../Resources/','../Resources/data/','/usr/share/local/vegastrike/data/',
                '/vegastrike/data/','/usr/local/vegastrike/data/','/usr/share/vegastrike/data/',
                '/usr/local/games/vegastrike/data/','/usr/games/vegastrike/data/',
                '/opt/share/vegastrike/data/','../Resources/data4.x/',
                '/usr/share/local/vegastrike/data4.x/','/usr/local/share/vegastrike/data4.x/',
                '/usr/local/vegastrike/data4.x/','/usr/share/vegastrike/data4.x/',
                '/usr/local/games/vegastrike/data4.x/','/usr/games/vegastrike/data4.x/',
                '/opt/share/vegastrike/data4.x/');

unitsstr = 'units/units.csv';
var
  testpath:string;
  n:integer;
  wasfound:boolean =false;
begin
  writeln('Finding data directory.');
  workdir := '';
  if paramcount > 0 then
  begin
    testpath := paramstr(1);
    if not(testpath[length(testpath)] in ['/','\']) then testpath := testpath + '/';
    dodirseparators(testpath);
    writeln('testing ',testpath + unitsstr);
    if fileexists(testpath + unitsstr) then
    begin
      workdir := testpath;
      wasfound:=true;
    end;
  end;
  if not(wasfound) then
  If (GetEnvironmentVariable('HOME')) <> '' Then //uhh.. check home first, k?
    Begin
      testpath := GetEnvironmentVariable('HOME') + '/data4.x/';
      dodirseparators(testpath);
      writeln('testing ',testpath + unitsstr);

      If fileexists(testpath + unitsstr) Then
      begin
        workdir := testpath;
        wasfound:=true;
      end;
    End;
    if not(wasfound) then
    For n:=1 To paths Do
      Begin
        testpath := pathnames[n];
        dodirseparators(testpath);
        writeln('testing ',testpath + unitsstr);
        If fileexists(testpath + unitsstr) Then
          Begin
            workdir := testpath;
            break;
          End;
      End;

  {$I sidetables.inc}
  //didn't like the table definitions here

  If (workdir <> '') then writeln('Using ',workdir) else
  writeln('Coundn''t find data directory.');

end;

procedure displaymax;
var x:integer;
begin
  writeln('Max Fieldlengths (Str only)');
  writeln('---------------------------');
  for x:=0 to high(strmax) do
  writeln(strmax[x].fieldname,': ',strmax[x].width);
end;
begin
  TRY
  listof_categories := tstringlist.Create;
  Createdb;
  whichdir;
  if workdir <> '' then populatedb;
  displaymax;
  FINALLY
  ds_cargo_imp.free;
  ds_cargo.free;
  ds_dock.free;
  ds_light.free;
  ds_mounts.free;
  ds_subunit.free;
  ds_units.free;
  ds_upgrades.free;
  end;
end.

