Refactoring to patterns. Yet another TDD example coded in Delphi

Long overdue here is my second article about Test Driven Development (TDD) in Delphi. This is a continuation of TDD in Delphi: The Basics, another post that I wrote a few months earlier. 

I would like to focus in a particular step within the TDD cycle: refactoring the code. Refactoring means optimizing, cleaning, shortening, beautifying, styling (put your own word here) the code without breaking the functionality; that is, without breaking your unit tests.
 
By having unit tests in place before refactoring, you guarantee that the changes to the code are safe. Refactoring can introduce bugs. To avoid those bugs you need your unit tests in place.

Refactoring can introduce something else: refactoring can introduce design patterns into your code. That means you don’t have to introduce the design patterns up-front, since your code can evolve from a “very rustic implementation” to a “pattern oriented implementation”. This is referred as “refactoring to patterns”. If you are interested on the topic, I advise you to read Refactoring To Patterns by Joshua Kerievsky.

I’ll take the chess game as the base to my example. For simplicity, I’ll just refer to a couple of pieces: the knight and the bishop. In this example, I will just focus in refactoring some code with unit tests already in place. A detailed walk-through for the TDD cycle can be found in my previous article, which is also based on the chess game.  
  
The code is easy enough to be self-explanatory: basically, there is a class hierarchy in which TPiece is the base class from which TKnight and TBishop derive. Take a quick look:

unit ChessGame;

interface

type

 TPiece = class
 private
   FX,
   FY: Byte;
 public
   constructor Create(aX, aY: Integer);
   function IsWithinBoard(aX, aY: Integer): Boolean;
 end;

 TBishop = class (TPiece)
 public
   function CanMoveTo(aX, aY: Byte): Boolean;
   function isValidMove(aX, aY: Byte): Boolean;
 end;

 TKnight = class(TPiece)
  public
    function CanMoveTo(aX, aY: Byte): Boolean;
    function isValidMove(aX, aY: Byte): Boolean;
 end;


implementation

{ TPiece }

constructor TPiece.Create(aX, aY: Integer);
begin
  inherited Create;
  // TODO: check that this assignment is valid.
  // Not now, ok? :-)
  FX:= aX;
  FY:= aY;
end;

function TPiece.IsWithinBoard(aX, aY: Integer): Boolean;
begin
  Result:= (aX > 0) and
           (aX < 9) and
           (aY > 0) and
           (aY < 9);
end;

{ TKnight }

function TKnight.isValidMove(aX, aY: Byte): Boolean;
var
  x_diff,
  y_diff: Integer;
begin
  x_diff:= abs(aX - FX) ;
  y_diff:= abs(aY - FY) ;

  Result:= ((x_diff = 2) and (y_diff = 1))
                         or
           ((y_diff = 2) and (x_diff = 1));
end;

function TKnight.CanMoveTo(aX, aY: Byte): Boolean;
begin
  Result:= IsWithinBoard(aX, aY) and
           IsValidMove(aX, aY);
end;

{ TBishop }

function TBishop.isValidMove(aX, aY: Byte): Boolean;
begin
  Result:= abs(aX - FX) = abs(aY - FY);
end;

function TBishop.CanMoveTo(aX, aY: Byte): Boolean;
begin
  Result:= IsWithinBoard(aX, aY) and
           IsValidMove(aX, aY);
end;

end. 



/////////////////////////////////////////////

 
unit TestChessGame;

interface

uses
  TestFramework, ChessGame;

type
  // Test methods for class TPiece
  TestTPiece = class(TTestCase)
  strict private
    FPiece: TPiece;
  public
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestIsWithinBoard;
  end;

  // Test methods for class TBishop
  TestTBishop = class(TTestCase)
  strict private
    FBishop: TBishop;
  public
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestCanMoveTo;
    procedure TestisValidMove;
  end;

  // Test methods for class TKnight
  TestTKnight = class(TTestCase)
  strict private
    FKnight: TKnight;
  public
    procedure SetUp; override;
    procedure TearDown; override;
  published
    procedure TestCanMoveTo;
    procedure TestisValidMove;
  end;

implementation

procedure TestTPiece.SetUp;
begin
  FPiece := TPiece.Create(4, 4);
end;

procedure TestTPiece.TearDown;
begin
  FPiece.Free;
  FPiece := nil;
end;

procedure TestTPiece.TestIsWithinBoard;
begin
  //Test trivial (normal) workflow
  Check(FPiece.IsWithinBoard(4, 4));

  //Tests boundaries
  Check(FPiece.IsWithinBoard(1, 1));
  Check(FPiece.IsWithinBoard(1, 8));
  Check(FPiece.IsWithinBoard(8, 1));
  Check(FPiece.IsWithinBoard(8, 8));

  //Test beyond the boundaries
  CheckFalse(FPiece.IsWithinBoard(3, 15));
  CheckFalse(FPiece.IsWithinBoard(3, -15));
  CheckFalse(FPiece.IsWithinBoard(15, 3));
  CheckFalse(FPiece.IsWithinBoard(15, 15));
  CheckFalse(FPiece.IsWithinBoard(15, -15));
  CheckFalse(FPiece.IsWithinBoard(-15, 3));
  CheckFalse(FPiece.IsWithinBoard(-15, 15));
  CheckFalse(FPiece.IsWithinBoard(-15, -15));
end;

procedure TestTBishop.SetUp;
begin
  FBishop := TBishop.Create(4, 4);
end;

procedure TestTBishop.TearDown;
begin
  FBishop.Free;
  FBishop := nil;
end;

procedure TestTBishop.TestCanMoveTo;
begin
  // Hey developer, indulge me here: believe
  // that I fully wrote the code for this
  // test already before writing anything else.
end;

procedure TestTBishop.TestisValidMove;
begin
  // Hey developer, indulge me here: believe
  // that I fully wrote the code for this
  // test already before writing anything else.
end;

procedure TestTKnight.SetUp;
begin
  FKnight := TKnight.Create(4, 4);
end;

procedure TestTKnight.TearDown;
begin
  FKnight.Free;
  FKnight := nil;
end;

procedure TestTKnight.TestCanMoveTo;
begin
  // Hey developer, indulge me here: believe
  // that I fully wrote the code for this
  // test already before writing anything else.
end;

procedure TestTKnight.TestisValidMove;
begin
  // Hey developer, indulge me here: believe
  // that I fully wrote the code for this
  // test already before writing anything else.
end;

initialization
  // Register any test cases with the test runner
  RegisterTest(TestTPiece.Suite);
  RegisterTest(TestTBishop.Suite);
  RegisterTest(TestTKnight.Suite);
end.


Note that the method CanMoveTo is duplicated in both TKnight  and TBishop; that’s not nice isn’t it? In order to fix this, we can pull-up the CanMoveTo method to the TPiece base class. Note this now: the CanMoveTo has now become a “template method”; because is a general algorithm applicable to all kind of chess pieces (TKnight ,TBishop, etc) .

This general algorithm has deferred some steps to be implemented in the subclasses; I mean, the isValidMove method is still coded in the subclasses. Isn’t this a beauty?  You have now refactored your code and when doing so, you have introduced the Template Method Design Pattern.

What’s even best, (don’t forget this because it is a key part): is that we can guarantee that our fancy refactoring didn’t break our pre-existing functionality. Why? Because we had unit tests in place written a long time ago. Writing unit test from the beginning gives a huge peace of mind to the developer :-) See the new refactored code below:

unit ChessGameRefactored;

interface

type

 TPiece = class
 private
   FX,
   FY: Byte;
 public
   constructor Create(aX, aY: Integer);
   function IsWithinBoard(aX, aY: Integer): Boolean;

   function CanMoveTo(aX, aY: Byte): Boolean;
   function isValidMove(aX, aY: Byte): Boolean; virtual; abstract;
 end;

 TBishop = class (TPiece)
 public
   function isValidMove(aX, aY: Byte): Boolean; override;
 end;

 TKnight = class(TPiece)
  public
    function isValidMove(aX, aY: Byte): Boolean; override;
 end;


implementation

{ TPiece }

constructor TPiece.Create(aX, aY: Integer);
begin
  inherited Create;
  // TODO: check that this assignment is valid.
  // Not now, ok? :-)
  FX:= aX;
  FY:= aY;
end;

function TPiece.IsWithinBoard(aX, aY: Integer): Boolean;
begin
  Result:= (aX > 0) and
           (aX < 9) and
           (aY > 0) and
           (aY < 9);
end;

function TPiece.CanMoveTo(aX, aY: Byte): Boolean;
begin
  Result:= IsWithinBoard(aX, aY) and
           IsValidMove(aX, aY);
end;

{ TKnight }

function TKnight.isValidMove(aX, aY: Byte): Boolean;
var
  x_diff,
  y_diff: Integer;
begin
  x_diff:= abs(aX - FX) ;
  y_diff:= abs(aY - FY) ;

  Result:= ((x_diff = 2) and (y_diff = 1))
                         or
           ((y_diff = 2) and (x_diff = 1));
end;

{ TBishop }

function TBishop.isValidMove(aX, aY: Byte): Boolean;
begin
  Result:= abs(aX - FX) = abs(aY - FY);
end;

end.

Conclusion, in addition to all the cool things of TDD there’s the possibility of refining your design not up-front, but when refactoring your code. Design patterns can be introduced at any time and we know that such introduction, if late, is not going to break our logic, because we have unit tests in place to prevent that from happening.

Some related reading below:

What kind of cell phones are used in Cuba?


All mobile phones in Cuba are linked together by a GSM cellular network, operating in the 900MHz band throughout the island.

The 850MHz band is also operational (with limited coverage) in selected locations, namely: Havana City, Varadero, Ciego de Avila, Cayo Coco, Cayo Guillermo and Holguin (Guardalavaca and in the airport area).

3G is only available for the Roaming IN service in the Northern Keys of Cuba (Havana, Varadero, Villa Clara keys and Ciego de Avila keys) and in the provincial capitals.

If you were to buy a cellphone for a person in Cuba, I would recommend acquiring an unlocked quad-band phone (GPRS compatible).

It is important for the cellular phone to be unlocked; otherwise it won’t work with the Cuban mobile operator: Cubacell. Of course, a locked phone could be unlocked, but why to bother? You can buy a brand new unlocked phone and you will save the money and the time for unlocking it after.

Quad -band phones operate in the four major GSM bands: 850, 900, 1800 y 1900 MHz. With this kind of phone you will be able to get mobile coverage in the whole island. Technically speaking you don’t need the 1800 and 1900 MHz bands in Cuba, but it does not hurt to have them as well.

Another tip: the MMS service is available in Cuba. Most people don’t know this. This service allows you to send multimedia messages containing text, images, audio y video to a Cuban cellphone. Now, in order to use this service, your cell should support GPRS technology. Note that not all GSM mobile phones support GPRS technology. It depends on the model, brand and year of production.

The MMS service is not activated by default. In order to use it, you should activate the service following these steps (in Spanish).

A final tip: it would be better if the cellphone has Android. The reason is that now the Cubans can access WIFI points to make video calls and chat with the family abroad. In order to do this they need to install an app to make the video calls. There are plenty of these apps in Android.

This service, called Nauta Internet, also allows the Cubans to access email directly from the cellphone, but again, the phone requires an email client, which is available in Android. If you want to read more about Nauta click here.

I have hand-picked below a selection of phones that you can buy through Amazon. All these phones are unlocked, quad –band (GSM) and GPRS compatible. These phones will work in Cuba.

Amazon is a trustable online retailer, probably the largest and better known in the world.

 

For more phones with these specifications please use the following link: unlocked, quad –band (GSM) and GPRS phones at Amazon.

If you live in Canada, you can still use the Amazon US links/banners above, but  at the expense of buying in American dollars. If you prefer to buy in Canadian dollars, then click here: unlocked, quad –band (GSM) and GPRS phones at Amazon Canada.

    Would you be so kind to recommend this article by clicking the Google Plus (G+)  button at the beginning of the post? Thanks!

    To read this article in Spanish click the following link: ¿Qué tipo de teléfonos celulares se usan en Cuba?

    Related articles (Telephony in Cuba)

    Check your Brick Platinum Card balance online

    Note from the blog owner: This article might be outdated. I no longer have a Brick Platinum Card and I don’t know if what’s written in this article is still applicable today.

    If you want to check your Brick Platinum Card balance over the Internet, the first thing you need to do is to register with the HSBC Online Customer Care.  For that just click here: Enrollment form

    You will be redirected to a registration form in which you will have to type in some information like: 
    • Account Number: The Brick Card number preceded with a zero to the left. For instance, if your Brick Card number is 0000 1234 5678 999, then you should type 0000 0123 4567 8999.
    • Date of Birth: The Brick Platinum cardholder’s date of birth.
    • Postal Code: The Brick Platinum cardholder’s postal code
    • Loing ID and Password: A login and password for accessing the Online Customer Care.
    • Two security questions: Just in case you forget your credentials in the future (login ID and password)
    • Email Address: The Brick Platinum cardholder’s email address.
    • Statement Delivery Preference: Whether you prefer to receive paper statements over regular mail or electronic statements over email. I particularly prefer the electronic statements.
    • Email Alerts: Check this out if you want to receive email alerts when a payment has been received, when your payment is past due and when a new statement becomes available.
    Finally, just click the Submit button at the end of the form. With that you'll have completed the registration process. Shortly after, you will receive an email from HSBC Retail Services welcoming you to the Online Customer Care.

    If you want to check your Brick Platinum Card balance just login with your Login ID and Password in the Online Customer Care web portal.

    Important: you cannot make online payments from within the Online Customer Care portal. You can only review your statements and balance. If you want to make online contributions to your Brick Platinum Card refer to the following article:

    Make payments to your Brick Platinum Card from the RBC Online Banking

    Note from the blog owner: This article might be outdated. I no longer have a Brick Platinum Card and I don’t know if what’s written in this article is still applicable today.

    If you financed some new furniture at The Brick by getting a Brick Platinum Card, then you can arrange your payments thought the RBC online banking.  I prefer to do the contributions from the comfort of my home as opposed to physically paying at the store.  

    Your Brick Platinum Card should look like this:

    Brick Platinum Card - The Brick
    This is a comprehensive step by step guideline that will allow you to contribute to your Brick Platinum Card balance from the RBC Online Baking:
    1. Sign-in to RBC online baking. Once you sign-in, you’ll see the Accounts Summary page.
    2. Find and click the Pay Bills & Transfer Funds link. You will be redirected to the Pay Bills & Transfer Funds page.
    3. Find and click the Add Payee link. You will be redirected to the Add Payee page.
    4. In the Payee name text box type HSBC RETAIL SERVICES and click the Search button. You will be redirected to a page containing a list of possible payee matches.  Select the radio button labeled HSBC RETAIL SERVICES and click the Continue button. You will be redirected to the Payee Information page.
    5. Type in your Brick Platinum Card number in the edit box. When doing so, add a leading zero to the 15 digit card number.   For example, if your Brick Card number is 0000 1234 5678 999, then you should type 0000 0123 4567 8999. Once you do this, click the Continue button. You will be redirected to the Add Payee Confirmation page. 
    6. Click the Confirm button. You will be redirected to the Add Payee Completed page. At this point you have successfully added your Brick Platinum Card to your list of payees.
    7. To make a payment go to the Accounts Summary page and use the Quick Payments & Transfers dialog. It’s as easy as specifying the source from which you want to take your funds (checking account, saving account, etc.), selecting Brick Platinum HSBC as the receiver of the payment and entering the amount of money that you would like to transfer.
    The online transfer should be done 7 days in advance to the payment due date to guarantee it comes in time for processing.

    That’s all folks :-) If you find this tutorial helpful, would you mind sharing it by clicking the Google Plus (G+) button at the beginning of this post? Thanks!

    Test Driven Development in Delphi: The Basics

    I intend to write a Test Driven Development (TDD) series, targeted for Delphi developers. I will use DUnit, the unit testing framework for Delphi.

    Note folks that the purpose of this is NOT to discuss the Pros and Cons of TDD, Unit Testing or whatsoever. The purpose is just to give a few examples. I would love if you help me when the complexity starts climbing.

    If needed, for a quick understanding of what TDD or Unit Testing is, refer to the links above, or check out the book at the end of the article.

    In TDD you don’t write the application code first, instead you write the test cases first. The TDD cycle is as follows:
    1. At the beginning you just write one test, and later on, more tests can be added.
    2. Make sure the initial test fails; this will validate the test harness.
    3. Write some code to pass the test. Important: don’t over-code. Just add the code needed to pass the test and period. The code does not have to be elegant at this point.
    4. Run the test: if it fails, then you have to go back to step 3 and fix your code in order to pass the test. When you succeed, then move on to step 5.
    5. Improve and optimize your code: make it elegant, more efficient, avoid duplications, etc, etc. This is called code refactoring.
    6. When refactoring your code, maybe, by accident, you break the functionality. How can you be sure that everything is working as it should? Just re-run your test and it will tell you if the previous refactoring introduced a failure or not.
    7. Go to step 1 and add a new test if needed.
    The example: let’s consider the chess game. The goal will be to implement the code to verify whether a piece is placed in a valid position within the board. We are only going to implement one test: SetPositionTest.

    I will number the columns (X coordinate) from 1 to 8 starting at the bottom left-hand corner. In the same way, I will number the rows (Y coordinate) from 1 to 8 starting at the bottom left-hand corner.

    8
    7
    6
    5
    4
    3
    2
    1 2 3 4 5 6 7 8

    For a step by step tutorial of how to use, configure and setup DUnit you can read the English or Chinese versions of the tutorial.

    Initially, the testing code should look like this:

    unit ChessPiecesTests;

    interface

    uses
       TestFrameWork;

    type
      TPieceTest = class(TTestCase)
      published
        procedure SetPositionTest;
      end;

    implementation

    uses
      ChessPieces;

    { TPieceTest }

    procedure TPieceTest.SetPositionTest;
    begin
    end;

    initialization
      TestFramework.RegisterTest(TPieceTest.Suite);

    end.

    If you run that test, it will succeed since no checks are being performed within the SetPositionTest procedure.

    Each test is composed by one or more checks. I suggest adding the checks little by little. Every time you add a check, you should add business code to pass the corresponding test.

    Now, let’s make the test fail on purpose. For that, let’s add one check to the SetPositionTest procedure.

    procedure TPieceTest.SetPositionTest;
    begin
      Check(True = False, '');
    end;

    True is never False. So, this test will fail. If it doesn’t fail, then something is wrong with you test harness. Fix it. You can remove this initial check once you run the test and it fails.

    Now, let’s add a real check to our test. Something like this:

    procedure TPieceTest.SetPositionTest;
    var
      Piece: TPiece;
    begin
      Piece:= TPiece.Create;
      try
        //Test trivial (normal) workflow
        Check(Piece.SetPosition(4, 4) = True, '');
      finally
        Piece.Free;
      end;
    end;

    If you run this test, you will get a compilation error! Yes, that’s right. You don’t have business code yet. You just have the test. This is what TDD is all about: test first, business code later. Get the point?

    To avoid the compilation error, we will code a separate unit (ChessPieces) and we will add it to the uses clause of our ChessPiecesTests unit.

    unit ChessPieces;

    interface

    type
      TPiece = class
      private
      public
        function SetPosition(aX, aY: Integer): Boolean;
      end;

    implementation

    { TPiece }

    function TPiece.SetPosition(aX, aY: Integer): Boolean;
    begin
    end;

    end.

    Run the test again and now the compilation error is gone. Nonetheless, the test fails, because the Piece.SetPosition(4, 4) evaluates to False.

    Let’s add the minimum business code possible to pass this test:

    function TPiece.SetPosition(aX, aY: Integer): Boolean;
    begin
      Result:= True;
    end;

    This passes the test. What? Yes, this passes the test, right?

    OK, what now? Well, we keep adding new checks to the test and every time this happens, we need to add new business code in order to pass it. It is very important to add checks to test the boundaries of whatever we are trying to code. I think you are getting the point, so I will just add a bunch of checks at once:

    procedure TPieceTest.SetPositionTest;
    var
      Piece: TPiece;
    begin
      Piece:= TPiece.Create;
      try
        //Test trivial (normal) workflow
        Check(Piece.SetPosition(4, 4) = True, '');

        //Tests boundaries
        Check(Piece.SetPosition(1, 1) = True, '');
        Check(Piece.SetPosition(1, 8) = True, '');
        Check(Piece.SetPosition(8, 1) = True, '');
        Check(Piece.SetPosition(8, 8) = True, '');

        //Test beyond the boundaries
        Check(Piece.SetPosition(3, 15) = False, '');
        Check(Piece.SetPosition(3, -15) = False, '');
        Check(Piece.SetPosition(15, 3) = False, '');
        Check(Piece.SetPosition(15, 15) = False, '');
        Check(Piece.SetPosition(15, -15) = False, '');
        Check(Piece.SetPosition(-15, 3) = False, '');
        Check(Piece.SetPosition(-15, 15) = False, '');
        Check(Piece.SetPosition(-15, -15) = False, '');
      finally
        Piece.Free;
    end;

    The test above is even checking for the attempts of positioning a piece outside the chess board.

    To pass that test let’s write some business code:

    function TPiece.SetPosition(aX, aY: Integer): Boolean;
    begin
      Result:= True;
      if (aY < 1) or (aY > 8) then Result:= False
      else if (aX < 1) or (aX > 8) then Result:= False;
    end;

    Run the test and see how it passes.

    The code above could be refactored or even rewritten. The tests will remain the same, allowing us to catch any bugs introduced with the code change.

    For instance, we could write the procedure above as follows:

    function TPiece.SetPosition(aX, aY: Integer): Boolean;
    begin
      Result:= (aX > 0) and
               (aX < 9) and 

               (aY > 0) and
               (aY < 9);
    end;

    Run the test, and it will tell you if this refactoring (or reimplementation) works ok.

    It’s important to note that a good test should cover all possible scenarios and workflows. Pay special attention to the boundaries. At this point, a good understanding of the requisites is indispensable.

    Finally, more and more tests will be needed in a real world application. Each test will have its own checks. Each test will cover one piece of the functionality: this is what unit testing is intended for.

    I wrote a second article about TDD, code refactoring and design patterns in Delphi (click here). I would appreciate any comments you could provide about it.

    For further reading I recommend you Test Driven Development: By Example by Kent Beck. Check it out just below:

    Deep copying (cloning) objects in Delphi

    When I first took a look at the prototype design pattern in GoF(years ago), I realized that there was a big obstacle (challenge) to implement it in Delphi: How to write a routine to really clone (not just recreate) an object? In other words, how to perform a deep-copy of a living object in Delphi.

    There are approaches out there mimicking the deep copy by simply calling the constructor and reassigning the state of the object by hand (I don’t like it). There are others exposing that a deep copy could be accomplished for the descendants of TPersistent by calling the Assign method (I don’t like it either).

    With the new RTTI extensions it seemed to me (and to others) that a deep copy could be accomplished using reflection.

    I was reluctant to write the routine myself since the work is not trivial. It could get really nasty because there might be composition, aggregation and God knows what within an arbitrary object.

    So I waited….

    Just a few days ago, I realized that I could use the JSON marshalling and unmarshalling features introduced in Delphi (2010?) to write the deep copy method. So I came with this:

    .....

    uses
      DBXJSON, DBXJSONReflect;
    .....
     

    function DeepCopy(aValue: TObject): TObject;
    var
      MarshalObj: TJSONMarshal;
      UnMarshalObj: TJSONUnMarshal;
      JSONValue: TJSONValue;
    begin
      Result:= nil;
      MarshalObj := TJSONMarshal.Create;
      UnMarshalObj := TJSONUnMarshal.Create;
      try
        JSONValue := MarshalObj.Marshal(aValue);
        try
          if Assigned(JSONValue) then
            Result:= UnMarshalObj.Unmarshal(JSONValue);
        finally
          JSONValue.Free;
        end;
      finally
        MarshalObj.Free;
        UnMarshalObj.Free;
      end;
    end;

    You can now use it like this:

    .....

    var
      MyObject1,
      MyObject2: TMyObject;
    begin
      //Regular object construction
      MyObject1:= TMyObject.Create;

      //Deep copying an object
      MyObject2:= TMyObject(DeepCopy(MyObject1));

      try
        //Do something here

      finally
        MyObject1.Free;
        MyObject2.Free;
      end;
    end;

    I tested it with some complex cases and it seems to be working quite well. Anyhow, if you find any problems or limitations, please, let me know.

    Now that you get the idea we can do more crazy things like patching TObject (or any other class hierarchy) by using helpers. Look at this:

    .....

    interface

    uses
       DBXJSON, DBXJSONReflect;

    type
      TObjectHelper = class helper for TObject
        function Clone: TObject;
      end;

    implementation

    function TObjectHelper.Clone: TObject;
    var
      MarshalObj: TJSONMarshal;
      UnMarshalObj: TJSONUnMarshal;
      JSONValue: TJSONValue;
    begin
      Result:= nil;
      MarshalObj := TJSONMarshal.Create;
      UnMarshalObj := TJSONUnMarshal.Create;
      try
        JSONValue := MarshalObj.Marshal(Self);
        try
          if Assigned(JSONValue) then
            Result:= UnMarshalObj.Unmarshal(JSONValue);
        finally
          JSONValue.Free;
        end;
      finally
        MarshalObj.Free;
        UnMarshalObj.Free;
      end;
    end;

    All of a sudden, TObject has a Clone method! Call it like this:

    .....

    var
      MyObject1,
      MyObject2: TMyObject;
    begin
      //Regular object construction
      MyObject1:= TMyObject.Create;

      //Cloning an object
      MyObject2:= TMyObject(MyObject1.Clone);

      try
        //Do something here

      finally
        MyObject1.Free;
        MyObject2.Free;
      end;
    end;

    If you think that helpers are an aberration, you can still create a TCloneable class with a Clone method and inherit from it, right? You can even use the decorator pattern to attach a Clone method to an object. You can do more…Share it with me, please. Thanks!

    String comparison in Delphi

    Have you ever wondered how utilities like Beyond Compare or DIFF are comparing files? They do it (I guess) by solving the longest common subsequence (LCS) problem.

    After reading the Wikipedia article linked above, I obtained an overall view of the problem and I looked at the possible resolutions. So, I decided to implement a Delphi class to do the string comparison trick, which is the base for the text file comparison.

    Let me put it as follows: given two strings to be compared, I want to highlight in blue the characters added to the first string and in red the characters removed from it. The common (unchanged) characters will keep the default color.
     
    For example:

    String 1 = Delphi allows both structural and object oriented programming.

    String 2 = Does Delphi allow object oriented programming?

    Highlighted differences:

    Does Delphi allows both structural and object oriented programming.?

    The Delphi class looks like this:

    type
      TDiff = record
        Character: Char;
        CharStatus: Char;  //Possible values: [+, -, =]
      end;

      TStringComparer = class
      ……………
      public
        class function Compare(aString1, aString2: string): TList<TDiff>;
      end;

    When you call TStringComparer.Compare, a generic list of TDiff records is created. A TDiff record contains a character and whether this character was added (CharStatus = ‘+’), removed (CharStatus = ‘-’) or unchanged (CharStatus = ‘=’) in both strings under comparison.

    Let’s drop two edits (Edit1, Edit2), a rich edit (RichEdit1) and a button (Button1) on a Delphi form. To highlight the differences put the following code in the OnClick event of the button:

    procedure TForm1.Button1Click(Sender: TObject);
    var
      Differences: TList<TDiff>;
      Diff: TDiff;
    begin
      //Yes, I know...this method could be refactored ;-)
      Differences:= TStringComparer.Compare(Edit1.Text, Edit2.Text);
      try
        RichEdit1.Clear;
        RichEdit1.SelStart:= RichEdit1.GetTextLen;
        for Diff in Differences do
          if Diff.CharStatus = '+' then
          begin
            RichEdit1.SelAttributes.Color:= clBlue;
            RichEdit1.SelText := Diff.Character;
          end
          else if Diff.CharStatus = '-' then
          begin
            RichEdit1.SelAttributes.Color:= clRed;
            RichEdit1.SelText:= Diff.Character;
          end
          else
          begin
            RichEdit1.SelAttributes.Color:= clDefault;
            RichEdit1.SelText:= Diff.Character;
          end;
      finally
        Differences.Free;
      end;
    end;

    It looks like in the image below:


    For the full implementation read further down. Note that various optimizations could be added to the code below, but I didn’t implement them. Anyway, I hope this helps. Feedback is welcome! Feel free to find and correct bugs ;-)

    Testing the World Away: Recovery mission

    I was recently reviewing the DUnit website and I noticed there is a broken link to an article titled “Testing The World Away”. It was written by Will Watts for QBS Software. November, 2000.

    I said “OK, maybe the article was relocated somewhere else in the QBS Software website”; so I tried a custom Google search "Testing the World Away" site:qbssoftware.com. As you can see the article was either banned from Google or removed completely from the QBS Software website.

    Once again I said “OK, maybe there’s a copy of the article somewhere else on the Internet” and I tried a second custom Google search "Testing the World Away". At this point I convinced myself that the article was gone for good.

    I am a curious guy, so I tried one final thing: I looked up the broken link[1] in the Internet Archive website and wallah!, they came with an archived version of the article.

    I have shared below a copy of the article so that we can take a look. As I said, this article is not mine, and if the author(owner) at some point request me to deleted it from my blog, I will do so.

    [1] http://www.qbss.com/html/news/news_body.asp?content=ARTICLE&link=368&zone= 

    Testing the World Away (01 November 2000)

    Testing the World Away

    The software methodology of the hour is Kent Beck’s ‘Extreme Programming’. Mr Beck is a Smalltalk programmer by trade and, I think, a bit of a lad by inclination (evidence: the bibliography of his book Extreme Programming Explained, as well as citing standards such as The Mythical Man-Month and Design Patterns, also recommends Cynthia Heimel’s Sex Tips for Girls. Right on!). I find some of his ideas unconvincing. Pair Programming for example, where one programmer sits at the keyboard and works while the other does something else - possibly flower-arranging, my concentration lapsed at this point in the text as I tried to imagine any manager I’ve met who would permit this exciting way of increasing his costs - seems too beautiful and delicate for our mortal coil. On the other hand his approach to testing, and the free libraries based on his design that are around to back it up, comes much nearer to hitting, as I suppose Ms Heimel might put it, my programming G-spot.

    Multiple Entries to the US with the same I-94 Form: Just for Canadian Residents

    I am a Permanent Resident of Canada (Landed Immigrant) and I got a B-2 Visitor Visa which I used in order to travel to the United States of America for 15 days.

    I crossed the border at the Rainbow Bridge at Niagara Falls. In the American side of the bridge there is a US Point of Entry, in which I was requested for my papers. I presented my Cuban Passport with a one time B-2 Visitor Visa to the American Officer controlling the crossing. The officer kept my passport and redirected me to one office located just a few meters further.

    I waited for 40 minutes and I was called for an interview with another officer. He asked for the purpose of the trip, the intended duration of the stay, my destinations within the States, the means of returning back (flight and bus tickets) [1], my relation to the people I was visiting in the US, and things like that.

    The officer issued an I-94 Form, that he stapled onto my passport. I paid a $6.00 USD fee for the I-94 Form and my passport was returned to me. - Make sure you have exactly $6.00 USD (cash) if you want to get this done quickly. You can pay with credit card as well, but it takes more time-

    The I-94 Form was issued for 6 moths, meaning that I was permitted to stay in the US until the expiry date, 6 months later.

    In my way back to Canada I crossed the Rainbow Bridge again (in the opposite direction). This time I was stopped by a Canadian Custom Officer. She asked for my papers: I gave her my passport and my Canadian Resident Card [2]. She asked pretty much the same questions that the American Officer did, and she also inquired about any merchandize that I was bringing from the US.

    I was expecting her to remove the I-94 from the passport, but she didn’t. Usually, you need to surrender your I-94 when leaving the US, but it seems that Canadian Residents can use the same I-94 Form (if not expired) to re-entry to the US multiple times. It seems that you can do this regardless of the validity of your Visa: the only thing taken into consideration is that the I-94 Form has to be valid.

    Looking for extra validation of my theory I found this post. I am extracting the main juice below:

    You don't have to get a new I-94 every time
    you enter the USA. How do I know ?, because
    I've being traveling to the USA for the past
    4.5 years and using the same I-94 until its
    expiry date. In fact the INS officer told me
    that I did not have to turn in the I-94 if I
    intent to enter the USA prior to the expiry
    date.

    I also talked to a few friends who confirmed that they used the I-94 Form to re-enter the US from Canada, even after their visa was expired. 

    I looked furthermore to validate this theory and I found out that:

    If taking short trips (30 days or less) to Canada, Mexico, or the Caribbean Islands during the course of your visit to the U.S., hold onto your I-94 or I-94 (W); it should only be turned in when you leave the U.S. to return home. [U.S. Department of State]

    After this, I was pretty confident of my theory and I went to the US a second time. This time I crossed the border at the Peace Bridge. I was not expecting any problems: my visa was expired, but my I-94 was not. You know what? I did have a problem…

    The American officer told me that they allow most people visiting the US to re-enter by just using the I-94 (if not expired). The problem in my case is that I am a Cuban national. Cubans (among other nationalities) are taken especial care by the US government. That meant that I was not able to use my I-94 Form to re-enter the US.

    I was very disappointed, but the American officer wanted to support my case. She noticed that I made an honest mistake. So, she took my finger prints, made me fill some forms and with that, she supported my case with her superiors. Not even her immediate superior was able to allow me enter the US. So, the whole process took like 3 hours and of course, I lost my bus and the plane.

    After all this, they gave me a waiver, which is a one time permit to enter the US without a visa. I was glad at this point, because those Americans officers helped me while they were enforcing the law. They removed the original 6 months I-94 from my passport, and they re-issued a new one for just one week (I was going this time for the weekend; so it was good enough for me).

    They explicitly told me to surrender this new I-94 Form to the Canadian custom officer in my way back to Canada. I did that of course. Note that you have to advise the Canadian officer to remove the I-94 from your passport. The Canadian officer does not remove it if you don’t ask.

    So, the conclusion if that you can use the I-94 Form (if not expired) to re-enter the US from Canada, but this does NOT apply to nationals of Cuba, Iran, Syria, and Sudan. This list could change at any moment. 

    Disclaimer: This is based on my own experience as a Permanent Resident of Canada. You should not consider this a legal advice or whatsoever.

    Just one more thing, after all this hassle I got a new B2-Visitor Visa to enter the US. So, I will be going soon to the States. This time I don’t expect any problems :-)

    If you find this post informational, please, share it with others: just click the Google+ button at the start of this article.
    [1] I was traveling from Toronto to Buffalo by land; passing though Niagara Falls. Then, I was traveling from Buffalo to Miami by air. I used that route backwards in my way back.
    [2] Don’t forget your Canadian Resident Card. You need it to re-enter Canada.

    Delphi Implementation for the OpenSubtitles API

    OpenSubtitles.org allows searching and hosting subtitles in several formats (SRT, SUB, etc.) and pretty much every language. It currently has a vast database of subtitles (expanding every day). OpenSubtitles.org also exposes a XML-RPC based API that can be used in order to build third party applications with subtitle features.

    I am writing a Delphi app to search subtitles in the OpenSubtitles.org database... I thought it would be nice to have a Delphi wrapper for the whole API. Below is my three cents contribution. I will probably implement and share more methods in the future, but feel free to contribute as well.  Take a look at the full API methods list

    XML-RPC stands for XML Remote Procedure Call. It allows “remote procedure calling using HTTP as the transport and XML as the encoding”. [http://xmlrpc.scripting.com/spec]. XML-RPC is really easy to implement: in the code below I have used formatted strings to conform the XML requests (XML encoding pending) and the Indy TIdHTTP component to send the requests.

    unit OpensubtitlesAPI;

    interface

    uses
      IdHTTP, Classes, SysUtils;

      function LogIn(aUsername, aPassword,
                     aLanguage, aUserAgent: string): string;
      function LogOut(aToken: string): string;
      function SearchSubtitles(aToken, aSublanguageID,
                               aMovieHash: string;
                               aMovieByteSize: Cardinal): string;  overload;
      function SearchSubtitles(aToken, aSublanguageID: string;
                               aImdbID: Cardinal): string; overload;
      function SearchSubtitles(aToken, aSublanguageID,
                               aQuery: string): string;  overload;

    implementation

    function XML_RPC(aRPCRequest: string): string;
    const
      cURL= 'http://api.opensubtitles.org/xml-rpc';
    var
      lHTTP: TIdHTTP;
      Source,
      ResponseContent: TStringStream;
    begin
      lHTTP := TIdHTTP.Create(nil);
      lHTTP.Request.ContentType := 'text/xml';
      lHTTP.Request.Accept := '*/*';
      lHTTP.Request.Connection := 'Keep-Alive';
      lHTTP.Request.Method := 'POST';
      lHTTP.Request.UserAgent := 'OS Test User Agent';
      Source := TStringStream.Create(aRPCRequest);
      ResponseContent:= TStringStream.Create;
      try
        try
          lHTTP.Post(cURL, Source, ResponseContent);
          Result:= ResponseContent.DataString;
        except
          Result:= '';
        end;
      finally
        lHTTP.Free;
        Source.Free;
        ResponseContent.Free;
      end;
    end;

    function LogIn(aUsername, aPassword, aLanguage, aUserAgent: string): string;
    const
      LOG_IN = '<?xml version="1.0"?>' +
               '<methodCall>' +
               '  <methodName>LogIn</methodName>' +
               '  <params>'   +
               '    <param>'  +
               '      <value><string>%0:s</string></value>' +
               '    </param>' +
               '    <param>'  +
               '      <value><string>%1:s</string></value>' +
               '    </param>' +
               '    <param>'  +
               '      <value><string>%2:s</string></value>' +
               '    </param>' +
               '    <param>'  +
               '      <value><string>%3:s</string></value>' +
               '    </param>' +
               '  </params>'  +
               '</methodCall>';
    begin
      //TODO: XML Encoding
      Result:= XML_RPC(Format(LOG_IN, [aUsername, aPassword, aLanguage, aUserAgent]));
    end;

    function LogOut(aToken: string): string;
    const
      LOG_OUT = '<?xml version="1.0"?>' +
               '<methodCall>' +
               '  <methodName>LogOut</methodName>' +
               '  <params>'   +
               '    <param>'  +
               '      <value><string>%0:s</string></value>' +
               '    </param>' +
               '  </params>'  +
               '</methodCall>';
    begin
      //TODO: XML Encoding
      Result:= XML_RPC(Format(LOG_OUT, [aToken]));
    end;

    function SearchSubtitles(aToken, aSublanguageID, aMovieHash: string; aMovieByteSize: Cardinal): string;
    const
      SEARCH_SUBTITLES = '<?xml version="1.0"?>' +
                         '<methodCall>' +
                         '  <methodName>SearchSubtitles</methodName>' +
                         '  <params>' +
                         '    <param>' +
                         '      <value><string>%0:s</string></value>' +
                         '    </param>' +
                         '  <param>' +
                         '   <value>' +
                         '    <array>' +
                         '     <data>' +
                         '      <value>' +
                         '       <struct>' +
                         '        <member>' +
                         '         <name>sublanguageid</name>' +
                         '         <value><string>%1:s</string>' +
                         '         </value>' +
                         '        </member>' +
                         '        <member>' +
                         '         <name>moviehash</name>' +
                         '         <value><string>%2:s</string></value>' +
                         '        </member>' +
                         '        <member>' +
                         '         <name>moviebytesize</name>' +
                         '         <value><double>%3:d</double></value>' +
                         '        </member>' +
                         '       </struct>' +
                         '      </value>' +
                         '     </data>' +
                         '    </array>' +
                         '   </value>' +
                         '  </param>' +
                         ' </params>' +
                         '</methodCall>';

    begin
      //TODO: XML Encoding
      Result:= XML_RPC(Format(SEARCH_SUBTITLES, [aToken, aSublanguageID, aMovieHash, aMovieByteSize]));
    end;

    function SearchSubtitles(aToken, aSublanguageID: string;
      aImdbID: Cardinal): string;
    const
      SEARCH_SUBTITLES = '<?xml version="1.0"?>' +
                         '<methodCall>' +
                         '  <methodName>SearchSubtitles</methodName>' +
                         '  <params>' +
                         '    <param>' +
                         '      <value><string>%0:s</string></value>' +
                         '    </param>' +
                         '  <param>' +
                         '   <value>' +
                         '    <array>' +
                         '     <data>' +
                         '      <value>' +
                         '       <struct>' +
                         '        <member>' +
                         '         <name>sublanguageid</name>' +
                         '         <value><string>%1:s</string>' +
                         '         </value>' +
                         '        </member>' +
                         '        <member>' +
                         '         <name>imdbid</name>' +
                         '         <value><string>%2:d</string></value>' +
                         '        </member>' +
                         '       </struct>' +
                         '      </value>' +
                         '     </data>' +
                         '    </array>' +
                         '   </value>' +
                         '  </param>' +
                         ' </params>' +
                         '</methodCall>';

    begin
      //TODO: XML Encoding
      Result:= XML_RPC(Format(SEARCH_SUBTITLES, [aToken, aSublanguageID, aImdbID]));
    end;

    function SearchSubtitles(aToken, aSublanguageID,
      aQuery: string): string;
    const
      SEARCH_SUBTITLES = '<?xml version="1.0"?>' +
                         '<methodCall>' +
                         '  <methodName>SearchSubtitles</methodName>' +
                         '  <params>' +
                         '    <param>' +
                         '      <value><string>%0:s</string></value>' +
                         '    </param>' +
                         '  <param>' +
                         '   <value>' +
                         '    <array>' +
                         '     <data>' +
                         '      <value>' +
                         '       <struct>' +
                         '        <member>' +
                         '         <name>sublanguageid</name>' +
                         '         <value><string>%1:s</string>' +
                         '         </value>' +
                         '        </member>' +
                         '        <member>' +
                         '         <name>query</name>' +
                         '         <value><string>%2:s</string></value>' +
                         '        </member>' +
                         '       </struct>' +
                         '      </value>' +
                         '     </data>' +
                         '    </array>' +
                         '   </value>' +
                         '  </param>' +
                         ' </params>' +
                         '</methodCall>';

    begin
      //TODO: XML Encoding
      Result:= XML_RPC(Format(SEARCH_SUBTITLES, [aToken, aSublanguageID, aQuery]));
    end;

    end.


    Finally, I present you some sample calls:

    Logging- in anonymously (empty credentials) and getting the token:

    LogIn('', '', 'en', 'OS Test User Agent');

    Logging- out (disposing the token):

    LogOut('81nt6bgl9vde06l3ptq7v1a7r1');

    Search English subtitles for the movie whose ImdbID is 120737

    SearchSubtitles(Edit1.Text, 'eng', 120737);

    Search English subtitles for The Lord of the Rings

    SearchSubtitles(Edit1.Text, 'eng', 'The Lord of the Rings');


    Search English subtitles for the movie whose hash is 7d9cd5def91c9432 and size is 735934464.

    SearchSubtitles(Edit1.Text, 'eng', '7d9cd5def91c9432', 735934464);