Unit MySqlSupport;

{ The TMySqlConnection class is based on the DatabaseWithRetry class from the
  C++ code.  That module was an unqualified success.  The basic assumption is
  that if there is any type of error, we report the error, pause briefly, close
  and reopen the connection then retry.  The code will retry forever, if
  necessary.

  Much of the code for TMySqlConnection came from DumpCandles.pas.  The bulk of
  that file was dedicated to generic database code which was moved here.

  I used the MysqlResult class in the C++ code a guide to help me write the
  TMySqlResult class.  However, TMysqlResult is only a subset of MysqlResult.
  MysqlResult was also a great and useful idea, but we don't need it nearly as
  much in the Pascal code as in the C++ code.  The Pascal code doesn't read from
  the database very much.
}

Interface

  Uses
    mysql,
    MultiLog;

  Function SqlEscape(S : String) : String;

  Type
    TMySqlResult =
      Class(TObject)
      Private
        FResult : PMYSQL_RES;
        FRow : PMYSQL_ROW;
        FFieldCount : Integer;
        Constructor Create(Connection : PMYSQL);
      Public
        Function NumRows : Integer;
        Function RowIsValid : Boolean;
        Procedure NextRow;
        Function GetStringField(Column : Integer;
                                Default : String = '') : String;
        Function GetDoubleField(Column : Integer;
                                Default : Double) : Double;
        Function GetIntField(Column : Integer;
                             Default : Integer) : Integer;
        Destructor Destroy;  Override;
      End;

    TMySqlConnection =
      Class(TObject)
      Private
        Connection : PMYSQL;
        Host, User, Password, Database : String;
        Port : Integer;
        Procedure VerifyInit;
        Procedure CloseConnection;
        Procedure ReportSqlError(Sql : String = '');
      Public
        Destructor Destroy;  Override;
        Constructor Create(SectionName : String);
        Procedure SendSql(Query : String);
        Function LastResult : TMySqlResult;  { This is a new object which much be freed. }
      End;

Implementation

  Uses
    ConfigFile,
    SysUtils;

  /////////////////////////////////////////////////////////////////////////
  // GLOBAL
  /////////////////////////////////////////////////////////////////////////

  Function SqlEscape(S : String) : String;
    Var
      NewLength : Integer;
    Begin
      SetLength(Result, Succ(Length(S) * 2));
      NewLength := mysql_escape_string(PChar(Result), PChar(S), Length(S));
      SetLength(Result, NewLength)
    End;

  /////////////////////////////////////////////////////////////////////////
  // TMySqlConnection
  /////////////////////////////////////////////////////////////////////////

  Destructor TMySqlConnection.Destroy;
    Begin
      CloseConnection
    End;

  Constructor TMySqlConnection.Create(SectionName : String);
    Begin
      Host := GetConfigValue(SectionName, 'db_Host');
      User := GetConfigValue(SectionName, 'db_User');
      Password := GetConfigValue(SectionName, 'db_Password');
      Database := GetConfigValue(SectionName, 'db_Database');
      Port := StrToIntDef(GetConfigValue(SectionName, 'db_Port'), 0)
    End;

  Procedure TMySqlConnection.ReportSqlError(Sql : String);
    Begin
      If Sql <> '' Then
        Sql := ' executing ' + Sql + ' at';
      MultiWriteLn(Format('SQL Error #%d, "%s",%s %s.', [mysql_errno(Connection), mysql_error(Connection), sql, DateTimeToStr(Now)]))
    End;

  Procedure TMySqlConnection.VerifyInit;
    Var
      ConnectAttempt : PMYSQL;
    Begin
      While Not Assigned(Connection) Do
        Begin
          Assert(libmysql_status = LIBMYSQL_READY, 'Unable to initialize SQL');
          Connection := mysql_init(Nil);
          ConnectAttempt := mysql_real_connect(Connection, PChar(Host), PChar(User), PChar(Password), PChar(Database), Port, Nil, 0);
          If (Connection <> ConnectAttempt) Then
            Begin
              ReportSqlError;
              mysql_close(Connection);
              Connection := Nil;
              Sleep(5000)
            End
        End
    End;

  Procedure TMySqlConnection.CloseConnection;
    Begin
      If Assigned(Connection) Then
        Begin
          mysql_close(Connection);
          Connection := Nil
        End
    End;

  Procedure TMySqlConnection.SendSql(Query : String);
    Var
      QueryResult : Integer;
    Begin
      Repeat
        VerifyInit;
        QueryResult := mysql_real_query(Connection, PChar(Query), Length(Query));
        If QueryResult = 0 Then
          { Success! }
          Break;
        ReportSqlError(Query);
        CloseConnection
      Until False
    End;

  Function TMySqlConnection.LastResult : TMySqlResult;
    Begin
      Result := TMySqlResult.Create(Connection)
    End;

  /////////////////////////////////////////////////////////////////////////
  // TMySqlResult
  /////////////////////////////////////////////////////////////////////////

  Constructor TMySqlResult.Create(Connection : PMYSQL);
    Begin
      FResult := mysql_store_result(Connection);
      If Assigned(FResult) Then
        Begin
          FFieldCount := mysql_field_count(Connection);
          FRow := mysql_fetch_row(FResult)
        End
    End;

  Destructor TMySqlResult.Destroy;
    Begin
      If Assigned(FResult) Then
        mysql_free_result(FResult)
    End;

  Function TMySqlResult.NumRows : Integer;
    Begin
      If Assigned(FResult) Then
        Result := mysql_num_rows(FResult)
      Else
        Result := 0
    End;

  Function TMySqlResult.RowIsValid : Boolean;
    Begin
      Result := Assigned(FRow)
    End;

  Procedure TMySqlResult.NextRow;
    Begin
      If Assigned(FRow) Then
        FRow := mysql_fetch_row(FResult)
    End;

  Function TMySqlResult.GetStringField(Column : Integer;
                                       Default : String) : String;
    Begin
      If Assigned(FRow) And (Column < FFieldCount) And (Column >= 0)  Then
        Result := FRow^[Column]
      Else
        Result := Default
    End;

  Function TMySqlResult.GetDoubleField(Column : Integer;
                                       Default : Double) : Double;
    Begin
      Result := StrToFloatDef(GetStringField(Column), Default)
    End;

  Function TMySqlResult.GetIntField(Column : Integer;
                                    Default : Integer) : Integer;
    Begin
      Result := StrToIntDef(GetStringField(Column), Default)
    End;

End.