ucontactsync.pas

FMA is a free1 powerful phone editing tool allowing users to easily manage all of the personal data

unit uContactSync;

{
*******************************************************************************
* Descriptions: Main Contact Sync Unit
* $Source: /cvsroot/fma/fma/uContactSync.pas,v $
* $Locker:  $
*
* Todo:
*   - Let the OOD reflect the xml
*   - Filters on the external contacts
*   - Hash sperate items of a contact so less conflicts arise
*   - Do it using interfaces. IIdentifiable INameble IConflictSolver ISynchronizable
*
* Change Log:
* $Log: uContactSync.pas,v $
*
}

interface

uses
  Contnrs, Classes, TntClasses, SysUtils, TntSysUtils;

resourcestring
  sContactSyncConfirm = '%s.'+sLinebreak+sLinebreak+'Please, confirm to continue.';

const
  MaxCardinal = High(Cardinal);

type
  ESynchronize = class(Exception);

  TContactState = (csUnknown, csUnchanged, csNew, csChanged, csDeleted);
  TContactSollution = (slLeft, slRight, slNeither);
  TContactAction = (caAdd, caUpdate, caDelete, caUnlink);
  TContactActions = set of TContactAction;

  TBaseContact = class(TObject)
  private
    FTitle: WideString;
    FCellPhone: WideString;
    FFaxPhone: WideString;
    FOtherPhone: WideString;
    FOrganization: WideString;
    FEMail: WideString;
    FName: WideString;
    FWorkPhone: WideString;
    FSurName: WideString;
    FHomePhone: WideString;
    FCity: WideString;
    FRegion: WideString;
    FCountry: WideString;
    FStreet: WideString;
    FPostalCode: WideString;
    FBirthday: TDateTime;
    function GetFullName: WideString;
  public
  { REFFERENCE !!!
    TBaseContact = class;
    TFMAContactFieldMapper.Create;
    TContactFieldMapper.LoadStandardFields;
    TOutlookContactSource.Read/Write();
  }
    property Title: WideString read FTitle write FTitle;
    property Name: WideString read FName write FName;
    property SurName: WideString read FSurName write FSurName;
    property Organization: WideString read FOrganization write FOrganization;
    property EMail: WideString read FEMail write FEMail;
    property HomePhone: WideString read FHomePhone write FHomePhone;
    property WorkPhone: WideString read FWorkPhone write FWorkPhone;
    property CellPhone: WideString read FCellPhone write FCellPhone;
    property FaxPhone: WideString read FFaxPhone write FFaxPhone;
    property OtherPhone: WideString read FOtherPhone write FOtherPhone;
    property Street: WideString read FStreet write FStreet;
    property City: WideString read FCity write FCity;
    property Region: WideString read FRegion write FRegion;
    property PostalCode: WideString read FPostalCode write FPostalCode;
    property Country: WideString read FCountry write FCountry;

    property Birthday: TDateTime read FBirthday write FBirthday;

    property FullName: WideString read GetFullName;
  end;

  TContactSource = class;

  TContact = class(TBaseContact)
  private
    FSyncID: Cardinal;
    FID: Variant;
    FSyncHash: Cardinal;
    FLinkedContact: TContact;
    FSynchronized: Boolean;
    FContactSource: TContactSource;
    function GetHash: Cardinal;
  protected
    function GetHashString: String; virtual;
    function Exists: Boolean; virtual; abstract;
  public
    constructor Create(ContactSource: TContactSource);

    property ContactSource: TContactSource read FContactSource write FContactSource;

    property Synchronized: Boolean read FSynchronized write FSynchronized;

    property SyncID: Cardinal read FSyncID write FSyncID;
    property ID: Variant read FID write FID;
    property SyncHash: Cardinal read FSyncHash write FSyncHash;
    property Hash: Cardinal read GetHash;
    property LinkedContact: TContact read FLinkedContact write FLinkedContact;

    function IsUnchanged: Boolean;
    function IsNew: Boolean; virtual;
    function IsChanged: Boolean; virtual;
    function IsDeleted: Boolean; virtual;
    function GetContactState: TContactState;

    procedure Clone(Value: TContact);
  end;

  TContacts = class
  private
    FList: TObjectList;
    function GetItem(Index: Integer): TContact;
    function GetCount: Integer;
    procedure PutItem(Index: Integer; const Value: TContact);
  public
    constructor Create;
    destructor Destroy; override;

    function Add(Item: TContact): Integer;
    procedure Clear;
    procedure Delete(Index: Integer);
    procedure Remove(Item: TContact);
    function IndexOf(Item: TContact): Integer;
    property Count: Integer read GetCount;
    property Items[Index: Integer]: TContact read GetItem write PutItem; default;
    function FindByID(ID: Variant): TContact;
    function FindBySyncID(SyncID: Cardinal): TContact;
  end;

  TContactFieldMapper = class
  private
    FMappedFields: TStrings;
    FFields: TStrings;
    FStandardFields: TStrings;

    function GetCellPhone: WideString;
    function GetEMail: WideString;
    function GetFaxPhone: WideString;
    function GetHomePhone: WideString;
    function GetName: WideString;
    function GetOrganization: WideString;
    function GetOtherPhone: WideString;
    function GetSurName: WideString;
    function GetTitle: WideString;
    function GetWorkPhone: WideString;
    procedure SetCellPhone(const Value: WideString);
    procedure SetEMail(const Value: WideString);
    procedure SetFaxPhone(const Value: WideString);
    procedure SetHomePhone(const Value: WideString);
    procedure SetName(const Value: WideString);
    procedure SetOrganization(const Value: WideString);
    procedure SetOtherPhone(const Value: WideString);
    procedure SetSurName(const Value: WideString);
    procedure SetTitle(const Value: WideString);
    procedure SetWorkPhone(const Value: WideString);
    function GetCity: WideString;
    function GetCountry: WideString;
    function GetPostalCode: WideString;
    function GetRegion: WideString;
    function GetStreet: WideString;
    procedure SetCity(const Value: WideString);
    procedure SetCountry(const Value: WideString);
    procedure SetPostalCode(const Value: WideString);
    procedure SetRegion(const Value: WideString);
    procedure SetStreet(const Value: WideString);

    function GetMappedField(Field: String): String;
    procedure SetMappedFields(const Value: TStrings);
    function GetMappedValue(Field: String): Variant;
    procedure SetMappedValue(Field: String; const AValue: Variant);
    procedure SetFields(const Value: TStrings);

    procedure LoadStandardFields;
    function GetBirthday: TDateTime;
    procedure SetBirthday(const Value: TDateTime);
  protected
    function GetVariant(Field: String): Variant; virtual; abstract;
    procedure SetVariant(Field: String; const Value: Variant); virtual; abstract;
  public
    constructor Create;
    destructor Destroy; override;

    property Title: WideString read GetTitle write SetTitle;
    property Name: WideString read GetName write SetName;
    property SurName: WideString read GetSurName write SetSurName;
    property Organization: WideString read GetOrganization write SetOrganization;
    property EMail: WideString read GetEMail write SetEMail;
    property HomePhone: WideString read GetHomePhone write SetHomePhone;
    property WorkPhone: WideString read GetWorkPhone write SetWorkPhone;
    property CellPhone: WideString read GetCellPhone write SetCellPhone;
    property FaxPhone: WideString read GetFaxPhone write SetFaxPhone;
    property OtherPhone: WideString read GetOtherPhone write SetOtherPhone;
    property Street: WideString read GetStreet write SetStreet;
    property City: WideString read GetCity write SetCity;
    property Region: WideString read GetRegion write SetRegion;
    property PostalCode: WideString read GetPostalCode write SetPostalCode;
    property Country: WideString read GetCountry write SetCountry;

    property Birthday: TDateTime read GetBirthday write SetBirthday;

    property Fields: TStrings read FFields write SetFields;
    property MappedField[Field: String]: String read GetMappedField;
    property MappedFields: TStrings read FMappedFields write SetMappedFields;
    property VariantValue[Field: String]: Variant read GetVariant write SetVariant;
    property MappedValue[Field: String]: Variant read GetMappedValue write SetMappedValue;
    property StandardFields: TStrings read FStandardFields;
  end;

  TContactSource = class
  private
    FContacts: TContacts;
    FConfirmActions: TContactActions;
    FFieldMapper: TContactFieldMapper;
  protected
    function GetName: String; virtual; abstract;
    function DeformatPhoneNumber(PhoneNumber: String): String; virtual;
  public
    constructor Create;
    destructor Destroy; override;

    property FieldMapper: TContactFieldMapper read FFieldMapper write FFieldMapper;

    property Name: String read GetName;

    property Contacts: TContacts read FContacts;

    function New: TContact; virtual; abstract;
    function Add(Value: TContact): TContact; virtual; abstract;
    procedure Update(Contact, Value: TContact); virtual; abstract;
    procedure Delete(Contact: TContact); virtual; abstract;
    function Find(SyncID: Cardinal): TContact;
    procedure Unlink(Contact: TContact); virtual;

    procedure Load; virtual; abstract;

    property ConfirmActions: TContactActions read FConfirmActions write FConfirmActions;
  end;

  TPossibleLink = class
  private
    FScore: Integer;
    FContact: TContact;
  public
    property Contact: TContact read FContact write FContact;
    property Score: Integer read FScore write FScore;
  end;

  TPossibleLinks = class
  private
    FList: TObjectList;
    function GetItem(Index: Integer): TPossibleLink;
    function GetCount: Integer;
    procedure PutItem(Index: Integer; const Value: TPossibleLink);
  public
    constructor Create;
    destructor Destroy; override;

    function Add(Contact: TContact; Score: Integer): Integer;
    procedure Clear;
    procedure Delete(Index: Integer);
    procedure Remove(Item: TPossibleLink);
    function IndexOf(Item: TPossibleLink): Integer;
    property Count: Integer read GetCount;
    property Items[Index: Integer]: TPossibleLink read GetItem write PutItem; default;
    procedure Sort;
  end;

  TSyncContactsConflictEvent = procedure(Sender: TObject; Contact,OtherContact: TContact;
    const Description: WideString; const Item0Name, Item1Name: WideString; var SelectedItem: Integer) of object;
  TSyncContactsFirstTimeEvent = procedure(Sender: TObject; var Continue: Boolean) of object;
  TSyncContactsErrorEvent = procedure(Sender: TObject; const Message: String) of object;
  TSyncContactsConfirmEvent = procedure(Sender: TObject; Contact: TContact; Action: TContactAction;
    const Description: WideString; var Confirmed: Boolean) of object;
  TSyncContactsChooseContactEvent = procedure(Sender: TObject; Contact: TContact; PossibleLinks: TPossibleLinks;
    var OtherContact: TContact) of object;

  TSynchronizeContacts = class
  private
    FFMA: TContactSource;
    FExtern: TContactSource;
    FFileName: String;
    FOnConflict: TSyncContactsConflictEvent;
    FSWitched: Boolean;
    FOnFirstTime: TSyncContactsFirstTimeEvent;
    FOnError: TSyncContactsErrorEvent;
    FOnConfirm: TSyncContactsConfirmEvent;
    FOnChooseLink: TSyncContactsChooseContactEvent;
    procedure DoSynchronize(Left, Right: TContactSource);
    function CalculateLinkScore(Contact, OtherContact: TContact): Integer;
    function FindLink(Contact: TContact; OtherSource: TContactSource): TContact;
    function Conflict(Left, Right: TContact): TContactSollution;
    function Confirm(Action: TContactAction; Source: TContactSource; Contact: TContact): Boolean;
    function BuildCompareDescription(Contact, OtherContact: TContact): WideString;
    function BuildActionDescription(Action: TContactAction; Source: TContactSource; Contact: TContact): WideString;
    function Add(Source: TContactSource; Value: TContact): TContact;
    procedure Update(Source: TContactSource; Contact, Value: TContact);
    procedure Delete(Source: TContactSource; Contact, OtherContact: TContact);
    procedure Link(Contact, OtherContact: TContact);
  protected
    procedure DoConflict(Contact,OtherContact: TContact;
      const Description: WideString; const Item0Name, Item1Name: String;
      var SelectedItem: Integer); virtual;
    function DoFirstTime: Boolean; virtual;
    procedure DoError(const Message: String); virtual;
    procedure DoConfirm(Contact: TContact; Action: TContactAction;
      const Description: WideString; var Confirmed: Boolean); virtual;
    procedure DoChooseLink(Contact: TContact; PossibleLinks: TPossibleLinks; var OtherContact: TContact); virtual;
  public
    property FileName: String read FFileName write FFileName;
    property FMA: TContactSource read FFMA write FFMA;
    property Extern: TContactSource read FExtern write FExtern;
    property OnConflict: TSyncContactsConflictEvent read FOnConflict write FOnConflict;
    property OnFirstTime: TSyncContactsFirstTimeEvent read FOnFirstTime write FOnFirstTime;
    property OnError: TSyncContactsErrorEvent read FOnError write FOnError;
    property OnConfirm: TSyncContactsConfirmEvent read FOnConfirm write FOnConfirm;
    property OnChooseLink: TSyncContactsChooseContactEvent read FOnChooseLink write FOnChooseLink;

    procedure Load;
    procedure Synchronize;
    procedure Save;

    procedure Unlink(CDID: TGUID);
  end;

implementation

uses
  gnugettext, gnugettexthelpers, uLogger, uConnProgress, uThreadSafe,
  Forms, TntForms, Variants, uXMLContactSync, CRC32, uSyncPhonebook, Unit1;

{ TSynchronizeContacts }

procedure TSynchronizeContacts.DoSynchronize(Left, Right: TContactSource);
var I: Integer;
    LeftContact, RightContact: TContact;
    LeftState, RightState: TContactState;
    Sollution: TContactSollution;
begin
  for I := 0 to Left.Contacts.Count - 1 do begin
    LeftContact := Left.Contacts[I];
    if not LeftContact.Synchronized then begin
      LeftState := LeftContact.GetContactState;

      RightContact := LeftContact.LinkedContact;

      if LeftState = csNew then begin
        RightContact := FindLink(LeftContact, Right);
        if Assigned(RightContact) then
          Link(LeftContact, RightContact)
        else
          Add(Right, LeftContact);
      end
      else begin
        if not Assigned(RightContact) then
          raise ESynchronize.Create(_('Linked contact not found'));

        RightState := RightContact.GetContactState;

        if LeftState = csChanged then begin
          if RightState = csUnchanged then begin
            Update(Right, RightContact, LeftContact);
          end
          else if RightState = csChanged then begin
            Sollution := Conflict(LeftContact, RightContact);
            if Sollution = slLeft then begin
              Update(Right, RightContact, LeftContact);
            end
            else if Sollution = slRight then begin
              Update(Left, LeftContact, RightContact);
            end;
          end
          else if RightState = csDeleted then begin
            Sollution := Conflict(LeftContact, RightContact);
            if Sollution = slLeft then begin
              Add(Right, LeftContact);
            end
            else if Sollution = slRight then begin
              Delete(Left, LeftContact, RightContact);
            end;
          end;
        end
        else if LeftState = csDeleted then begin
          if RightState = csUnchanged then begin
            Delete(Right, RightContact, LeftContact);
          end
          else if RightState = csChanged then begin
            Sollution := Conflict(LeftContact, RightContact);
            if Sollution = slLeft then begin
              Delete(Right, RightContact, LeftContact);
            end
            else if Sollution = slRight then begin
              Add(Left, RightContact);
            end;
          end;
        end;
      end;
    end;
    { Allow synchronization to be canceled }
    Application.ProcessMessages;
    if ThreadSafe.AbortDetected then Abort;
  end;
end;

procedure TSynchronizeContacts.Synchronize;
begin
  Log.AddSynchronizationMessage(_('Synchronize started'));
  try
    FSwitched := False;
    DoSynchronize(FMA, Extern);
    FSwitched := True;
    DoSynchronize(Extern, FMA);

    Log.AddSynchronizationMessage(_('Synchronize completed'));
  except
    on E: ESynchronize do begin
      Log.AddSynchronizationMessageFmt(_('Synchronize error: %s'), [E.Message], lsError);
      DoError(E.Message);
    end;
  end;
end;

function TSynchronizeContacts.Conflict(Left, Right: TContact): TContactSollution;
var Contact, OtherContact: TContact;
    SelectedItem: Integer;
    Description: WideString;
begin
  if FSwitched then begin
    Contact := Right;
    OtherContact := Left;
  end
  else begin
    Contact := Left;
    OtherContact := Right;
  end;
  SelectedItem := 0;
  Description := BuildCompareDescription(Contact, OtherContact);
  Log.AddSynchronizationMessageFmt(_('%s has a conflict: %s'), [Contact.FullName, Description], lsDebug);
  DoConflict(Contact, OtherContact, Description, Contact.ContactSource.Name, Contact.LinkedContact.ContactSource.Name, SelectedItem);
  case SelectedItem of
    0: begin
      if Contact = Left then
        Result := slLeft
      else
        Result := slRight;
      Log.AddSynchronizationMessageFmt(_('Conflict has been solved in favor of %s'), [Contact.ContactSource.Name], lsDebug);
    end;
    1: begin