2 new units: fpg_CSVParser and fpg_StringGridBuilder

fpg_CSVParser contains a class and singleton method to allow parsing
CSV files.

fpg_StringGridBuilder is a class that allows you to load a CSV file
and automatically populate a StringGrid with its content.

6 files changed, 520 insertions, 4 deletions

diff --git a/src/corelib/fpg_csvparser.pas b/src/corelib/fpg_csvparser.pas
new file mode 100644
index 00000000..f5c0d0ed
--- /dev/null
+++ b/src/corelib/fpg_csvparser.pas
@@ -0,0 +1,320 @@
+{
+    fpGUI  -  Free Pascal GUI Toolkit
+
+    Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this
+    distribution, for details of the copyright.
+
+    See the file COPYING.modifiedLGPL, included in this distribution,
+    for details about redistributing fpGUI.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+    Description:
+      Uses a Finite State Machine to parse CSV files.
+      Graeme Geldenhuys <graemeg@gmail.com>
+
+      This unit shows how one could use the State Design Pattern to implement a
+      FSM (Finite State Machine) to create a CSV Parser.  It handles invalid
+      CSV as well and will raise an appropriate exception. In the State pattern,
+      each of the states becomes a subclass of the base class. Each subclass must
+      implement the abstract method which will handle the input character and
+      decide on the next state.
+}
+
+unit fpg_CSVParser;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes;
+
+type
+  { forward declarations }
+  TCSVParser        = class;
+  TParserStateClass = class of TCSVParserState;
+
+
+  { Abstract State object }
+  TCSVParserState = class(TObject)
+  private
+    FParser: TCSVParser;
+    procedure ChangeState(NewState: TParserStateClass);
+    procedure AddCharToCurrField(Ch: char);
+    procedure AddCurrFieldToList;
+  public
+    constructor Create(AParser: TCSVParser);
+    { Must be implemented in the concrete classes to handle the input character
+      and decide on the next state. }
+    procedure ProcessChar(Ch: AnsiChar; Pos: integer); virtual; abstract;
+  end;
+
+
+  { A concrete state object - used when starting a new field }
+  TCSVParserFieldStartState = class(TCSVParserState)
+  public
+    procedure ProcessChar(Ch: AnsiChar; Pos: integer); override;
+  end;
+
+
+  { A concrete state object - used while scanning a field }
+  TCSVParserScanFieldState = class(TCSVParserState)
+  public
+    procedure ProcessChar(Ch: AnsiChar; Pos: integer); override;
+  end;
+
+
+  { A concrete state object - used while scanning double quoted fields }
+  TCSVParserScanQuotedState = class(TCSVParserState)
+  public
+    procedure ProcessChar(Ch: AnsiChar; Pos: integer); override;
+  end;
+
+
+  { A concrete state object - used when found the ending double quote }
+  TCSVParserEndQuotedState = class(TCSVParserState)
+  public
+    procedure ProcessChar(Ch: AnsiChar; Pos: integer); override;
+  end;
+
+
+  { A concrete state object - some error occured / invalid CSV structure }
+  TCSVParserGotErrorState = class(TCSVParserState)
+  public
+    procedure ProcessChar(Ch: AnsiChar; Pos: integer); override;
+  end;
+
+
+  { The actual state machine - CSV parser }
+  TCSVParser = class(TObject)
+  private
+    FCurrentLine: string;
+    FState: TCSVParserState;
+    { Cache state objects for greater performance. This comes in handy when
+      parsing a large CSV file. For smaller files you might want to create them
+      on the fly. }
+    FFieldStartState: TCSVParserFieldStartState;
+    FScanFieldState: TCSVParserScanFieldState;
+    FScanQuotedState: TCSVParserScanQuotedState;
+    FEndQuotedState: TCSVParserEndQuotedState;
+    FGotErrorState: TCSVParserGotErrorState;
+    { Fields used during parsing }
+    FCurrField: string;
+    FFieldList: TStrings;
+    function GetState: TParserStateClass;
+    procedure SetState(const Value: TParserStateClass);
+  protected
+    procedure AddCharToCurrField(Ch: char);
+    procedure AddCurrFieldToList;
+    { An example of Self Encapsulating Field refactoring }
+    property State: TParserStateClass read GetState write SetState;
+  public
+    constructor Create;
+    destructor Destroy; override;
+    { prodecure to call, to start the parsing process }
+    procedure ExtractFields(const S: string; const pFieldList: TStrings);
+    property CurrentLine: string read FCurrentLine;
+  end;
+
+
+// global singleton function
+function gCSVParser: TCSVParser;
+
+
+implementation
+
+uses
+  SysUtils;
+
+var
+  uCSVParser: TCSVParser;
+
+
+// Lazy mans singleton
+function gCSVParser: TCSVParser;
+begin
+  if uCSVParser = nil then
+    uCSVParser := TCSVParser.Create;
+  Result := uCSVParser;
+end;
+
+{ TCSVParser }
+
+constructor TCSVParser.Create;
+begin
+  inherited Create;
+  FCurrentLine     := '';
+  FFieldStartState := TCSVParserFieldStartState.Create(Self);
+  FScanFieldState  := TCSVParserScanFieldState.Create(Self);
+  FScanQuotedState := TCSVParserScanQuotedState.Create(Self);
+  FEndQuotedState  := TCSVParserEndQuotedState.Create(Self);
+  FGotErrorState   := TCSVParserGotErrorState.Create(Self);
+end;
+
+destructor TCSVParser.Destroy;
+begin
+  FFieldStartState.Free;
+  FScanFieldState.Free;
+  FScanQuotedState.Free;
+  FEndQuotedState.Free;
+  FGotErrorState.Free;
+  inherited;
+end;
+
+function TCSVParser.GetState: TParserStateClass;
+begin
+  Result := TParserStateClass(FState.ClassType);
+end;
+
+procedure TCSVParser.SetState(const Value: TParserStateClass);
+begin
+  if Value = TCSVParserFieldStartState then
+    FState := FFieldStartState
+  else if Value = TCSVParserScanFieldState then
+    FState := FScanFieldState
+  else if Value = TCSVParserScanQuotedState then
+    FState := FScanQuotedState
+  else if Value = TCSVParserEndQuotedState then
+    FState := FEndQuotedState
+  else if Value = TCSVParserGotErrorState then
+    FState := FGotErrorState;
+end;
+
+procedure TCSVParser.ExtractFields(const S: string; const pFieldList: TStrings);
+var
+  i: integer;
+  Ch: AnsiChar;
+begin
+  FCurrentLine := S;
+  FFieldList   := pFieldList;
+  Assert(Assigned(FFieldList), 'FieldList not assigned');
+  { Initialize by clearing the string list, and starting in FieldStart state }
+  FFieldList.Clear;
+  State        := TCSVParserFieldStartState;
+  FCurrField   := '';
+
+  { Read through all the characters in the string }
+  for i := 1 to Length(s) do
+  begin
+    { Get the next character }
+    Ch := s[i];
+    FState.ProcessChar(Ch, i);
+  end;
+
+  { If we are in the ScanQuoted or GotError state at the end of the string, 
+    there was a problem with a closing quote. You can add the second if test
+    for an extra failsafe!  }
+  if (State = TCSVParserScanQuotedState) then
+    //      or (State = TCSVParserGotErrorState) then
+    raise Exception.Create('Missing closing quote');
+
+  { If the current field is not empty, add it to the list }
+  if (FCurrField <> '') then
+    AddCurrFieldToList;
+end;
+
+procedure TCSVParser.AddCharToCurrField(Ch: char);
+begin
+  FCurrField := FCurrField + Ch;
+end;
+
+procedure TCSVParser.AddCurrFieldToList;
+begin
+  FFieldList.Add(FCurrField);
+  // Clear the field in preparation for collecting the next one
+  FCurrField := '';
+end;
+
+{ TCSVParserState }
+
+constructor TCSVParserState.Create(AParser: TCSVParser);
+begin
+  inherited Create;
+  FParser := AParser;
+end;
+
+procedure TCSVParserState.ChangeState(NewState: TParserStateClass);
+begin
+  FParser.State := NewState;
+end;
+
+procedure TCSVParserState.AddCharToCurrField(Ch: char);
+begin
+  FParser.AddCharToCurrField(Ch);
+end;
+
+procedure TCSVParserState.AddCurrFieldToList;
+begin
+  FParser.AddCurrFieldToList;
+end;
+
+{ TCSVParserFieldStartState }
+
+procedure TCSVParserFieldStartState.ProcessChar(Ch: AnsiChar; Pos: integer);
+begin
+  case Ch of
+    '"': ChangeState(TCSVParserScanQuotedState);
+    ',': AddCurrFieldToList;
+    else
+      AddCharToCurrField(Ch);
+      ChangeState(TCSVParserScanFieldState);
+  end;
+end;
+
+{ TCSVParserScanFieldState }
+
+procedure TCSVParserScanFieldState.ProcessChar(Ch: AnsiChar; Pos: integer);
+begin
+  if (Ch = ',') then
+  begin
+    AddCurrFieldToList;
+    ChangeState(TCSVParserFieldStartState);
+  end
+  else
+    AddCharToCurrField(Ch);
+end;
+
+{ TCSVParserScanQuotedState }
+
+procedure TCSVParserScanQuotedState.ProcessChar(Ch: AnsiChar; Pos: integer);
+begin
+  if (Ch = '"') then
+    ChangeState(TCSVParserEndQuotedState)
+  else
+    AddCharToCurrField(Ch);
+end;
+
+{ TCSVParserEndQuotedState }
+
+procedure TCSVParserEndQuotedState.ProcessChar(Ch: AnsiChar; Pos: integer);
+begin
+  if (Ch = ',') then
+  begin
+    AddCurrFieldToList;
+    ChangeState(TCSVParserFieldStartState);
+  end
+  else
+    ChangeState(TCSVParserGotErrorState);
+end;
+
+{ TCSVParserGotErrorState }
+
+procedure TCSVParserGotErrorState.ProcessChar(Ch: AnsiChar; Pos: integer);
+begin
+  raise Exception.Create(Format('Error in line at position %d: ' + #10 +
+    '<%s>', [Pos, FParser.CurrentLine]));
+end;
+
+
+initialization
+  uCSVParser := nil;
+
+finalization
+  if uCSVParser <> nil then
+    uCSVParser.Free;
+
+end.
+
diff --git a/src/corelib/gdi/fpgui_toolkit.lpk b/src/corelib/gdi/fpgui_toolkit.lpk
index f07e97c0..487a5e06 100644
--- a/src/corelib/gdi/fpgui_toolkit.lpk
+++ b/src/corelib/gdi/fpgui_toolkit.lpk
@@ -31,7 +31,7 @@
     <Description Value="fpGUI Toolkit"/>
     <License Value="LGPL 2 with static linking exception."/>
     <Version Major="1" Minor="3"/>
-    <Files Count="105">
+    <Files Count="107">
       <Item1>
         <Filename Value="..\stdimages.inc"/>
         <Type Value="Include"/>
@@ -452,6 +452,14 @@
         <Filename Value="..\..\gui\fpg_toggle.pas"/>
         <UnitName Value="fpg_toggle"/>
       </Item105>
+      <Item106>
+        <Filename Value="..\..\gui\fpg_stringgridbuilder.pas"/>
+        <UnitName Value="fpg_StringGridBuilder"/>
+      </Item106>
+      <Item107>
+        <Filename Value="..\fpg_csvparser.pas"/>
+        <UnitName Value="fpg_CSVParser"/>
+      </Item107>
     </Files>
     <LazDoc Paths="..\..\..\docs\xml\corelib;..\..\..\docs\xml\corelib\x11;..\..\..\docs\xml\corelib\gdi;..\..\..\docs\xml\gui"/>
     <RequiredPkgs Count="1">
diff --git a/src/corelib/gdi/fpgui_toolkit.pas b/src/corelib/gdi/fpgui_toolkit.pas
index a20c428f..4704d56a 100644
--- a/src/corelib/gdi/fpgui_toolkit.pas
+++ b/src/corelib/gdi/fpgui_toolkit.pas
@@ -22,7 +22,8 @@ uses
   fpg_style_win2k, fpg_style_motif, fpg_style_clearlooks, fpg_style_bluecurve, 
   fpg_style_bitmap, fpg_readonly, fpg_imgfmt_png, U_Command, U_Pdf, U_Report, 
   U_ReportImages, U_Visu, fpg_trayicon, Agg2D, fpg_dbugintf, fpg_dbugmsg,
-  fpg_style_carbon, fpg_style_plastic, fpg_style_win8, fpg_toggle;
+  fpg_style_carbon, fpg_style_plastic, fpg_style_win8, fpg_toggle,
+  fpg_StringGridBuilder, fpg_CSVParser;
 
 implementation
 
diff --git a/src/corelib/x11/fpgui_toolkit.lpk b/src/corelib/x11/fpgui_toolkit.lpk
index b46195d4..e59e4617 100644
--- a/src/corelib/x11/fpgui_toolkit.lpk
+++ b/src/corelib/x11/fpgui_toolkit.lpk
@@ -29,7 +29,7 @@
     <Description Value="fpGUI Toolkit"/>
     <License Value="LGPL 2 with static linking exception."/>
     <Version Major="1" Minor="3"/>
-    <Files Count="108">
+    <Files Count="110">
       <Item1>
         <Filename Value="../stdimages.inc"/>
         <Type Value="Include"/>
@@ -462,6 +462,14 @@
         <Filename Value="../../gui/fpg_toggle.pas"/>
         <UnitName Value="fpg_toggle"/>
       </Item108>
+      <Item109>
+        <Filename Value="../../gui/fpg_stringgridbuilder.pas"/>
+        <UnitName Value="fpg_StringGridBuilder"/>
+      </Item109>
+      <Item110>
+        <Filename Value="../fpg_csvparser.pas"/>
+        <UnitName Value="fpg_CSVParser"/>
+      </Item110>
     </Files>
     <LazDoc Paths="../../../docs/xml/corelib;../../../docs/xml/corelib/x11;../../../docs/xml/corelib/gdi;../../../docs/xml/gui"/>
     <RequiredPkgs Count="1">
diff --git a/src/corelib/x11/fpgui_toolkit.pas b/src/corelib/x11/fpgui_toolkit.pas
index 429d3497..be9f3b5a 100644
--- a/src/corelib/x11/fpgui_toolkit.pas
+++ b/src/corelib/x11/fpgui_toolkit.pas
@@ -23,7 +23,8 @@ uses
   fpg_style_bluecurve, fpg_style_bitmap, fpg_readonly, fpg_imgfmt_png, 
   U_Command, U_Pdf, U_Report, U_ReportImages, U_Visu, fpg_trayicon, Agg2D, 
   fpg_dbugintf, fpg_dbugmsg, fpg_fontcache, fpg_style_carbon, 
-  fpg_style_plastic, fpg_style_win8, fpg_scrollframe, fpg_toggle;
+  fpg_style_plastic, fpg_style_win8, fpg_scrollframe, fpg_toggle, 
+  fpg_StringGridBuilder, fpg_CSVParser;
 
 implementation
 
diff --git a/src/gui/fpg_stringgridbuilder.pas b/src/gui/fpg_stringgridbuilder.pas
new file mode 100644
index 00000000..fd3fe3b8
--- /dev/null
+++ b/src/gui/fpg_stringgridbuilder.pas
@@ -0,0 +1,178 @@
+{
+    fpGUI  -  Free Pascal GUI Toolkit
+
+    Copyright (C) 2006 - 2014 See the file AUTHORS.txt, included in this
+    distribution, for details of the copyright.
+
+    See the file COPYING.modifiedLGPL, included in this distribution,
+    for details about redistributing fpGUI.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+    Description:
+      This unit defines a helper class that can populate a StringGrid
+      from a CSV file. In future this could be expaned to other file
+      types or even data structures.
+}
+unit fpg_StringGridBuilder;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes,
+  SysUtils,
+  fpg_base,
+  fpg_grid;
+
+type
+  TStringGridBuilder = class(TObject)
+  private
+    FData: TStringList;
+    FGrid: TfpgStringGrid;
+    FCSVFile: TfpgString;
+    FHasHeader: boolean;
+  protected
+    procedure   InternalSetupColumns; virtual;
+    procedure   InternalSetupData; virtual;
+    procedure   InternalRepaintRow(const AData: TfpgString; const ARow: integer); virtual;
+  public
+    constructor Create;
+    constructor CreateCustom(const AGrid: TfpgStringGrid; const ACSVFile: TfpgString; const AWithHeader: boolean = True); virtual;
+    destructor  Destroy; override;
+    procedure   Run;
+    property    Grid: TfpgStringGrid read FGrid;
+  end;
+
+implementation
+
+uses
+  fpg_main,
+  fpg_utils,
+  fpg_CSVParser;
+
+{ TStringGridBuilder }
+
+procedure TStringGridBuilder.InternalSetupColumns;
+var
+  x: integer;
+  fields: TStringList;
+begin
+  fields := TStringList.Create;
+  try
+    gCsvParser.ExtractFields(FData[0], fields);
+    // setup correct column count
+    FGrid.ColumnCount := fields.Count;
+    // initialize columns
+    if FHasHeader then
+    begin
+      for x := 0 to fields.Count-1 do
+      begin
+        FGrid.ColumnTitle[x] := fields[x];
+//        FGrid.ColumnWidth[x] := StrToInt(FColumns.ValueFromIndex[x]);
+      end;
+    end;
+  finally
+    fields.Free;
+  end;
+end;
+
+procedure TStringGridBuilder.InternalSetupData;
+var
+  y: integer;
+begin
+  FGrid.BeginUpdate;
+  FGrid.MouseCursor := mcHourGlass;
+  try
+    try
+      // set correct row count. Columns have already been handled.
+      if FHasHeader then
+      begin
+        FGrid.RowCount := FData.Count-1;
+        for y := 1 to FData.Count-1 do  // rows
+        begin
+  //        writeln(' Row: ', y, '  Data: ', FData.Strings[y-1]);
+          InternalRepaintRow(FData.Strings[y], y-1);
+        end;
+      end
+      else
+      begin
+        FGrid.RowCount := FData.Count;
+        for y := 0 to FData.Count-1 do  // rows
+        begin
+  //        writeln(' Row: ', y, '  Data: ', FData.Strings[y-1]);
+          InternalRepaintRow(FData.Strings[y], y);
+        end;
+      end;
+    except
+      fpgApplication.HandleException(self);
+    end;
+  finally
+    if FGrid.RowCount > 0 then
+      FGrid.FocusRow := 0;
+    FGrid.EndUpdate;
+    FGrid.MouseCursor := mcDefault;
+  end;
+end;
+
+procedure TStringGridBuilder.InternalRepaintRow(const AData: TfpgString; const ARow: integer);
+var
+  x: integer;
+  fields: TStrings;
+  value: string;
+begin
+  fields := TStringList.Create;
+  try
+    gCsvParser.ExtractFields(AData, fields);
+    for x := 0 to FGrid.ColumnCount-1 do
+    begin
+      if x < fields.Count then
+        value := fields.Strings[x]
+      else
+        value := '';
+      FGrid.Cells[x, ARow] := value
+    end;
+  finally
+    fields.Free;
+  end;
+end;
+
+constructor TStringGridBuilder.Create;
+begin
+  FData := TStringList.Create;
+end;
+
+constructor TStringGridBuilder.CreateCustom(const AGrid: TfpgStringGrid; const ACSVFile: TfpgString; const AWithHeader: boolean);
+begin
+  Create;
+  FGrid := AGrid;
+  FCSVFile := ACSVFile;
+  FGrid.Clear;
+  FHasHeader := AWithHeader;
+  FGrid.ShowHeader := AWithHeader;
+end;
+
+destructor TStringGridBuilder.Destroy;
+begin
+  FGrid := nil;
+  FData.Free;
+  inherited Destroy;
+end;
+
+procedure TStringGridBuilder.Run;
+begin
+  if FCSVFile = '' then
+    raise Exception.Create('TStringGridBuilder: CSV filename is empty!');
+  if not fpgFileExists(FCSVFile) then
+    raise Exception.CreateFmt('TStringGridBuilder: The CSV file <%s> does not exist.', [FCSVFile]);
+  FData.LoadFromFile(fpgToOSEncoding(FCSVFile));
+  InternalSetupColumns;
+  InternalSetupData;
+end;
+
+
+end.
+