* Initial check-in

git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@11865 3ad0048d-3df7-0310-abae-a5850022a9f2

1 files changed, 633 insertions, 0 deletions

diff --git a/packages/cdrom/src/fpcddb.pp b/packages/cdrom/src/fpcddb.pp
new file mode 100644
index 0000000000..58c5fe346a
--- /dev/null
+++ b/packages/cdrom/src/fpcddb.pp
@@ -0,0 +1,633 @@
+{
+    Copyright (c) 2008 by Michael Van Canneyt
+
+    Unit to parse CDDB responses and construct a list
+    of tracks in a CD.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    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.
+
+ **********************************************************************}
+unit fpcddb;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils; 
+
+Type
+  TCDDisk = Class;
+
+  { TCDTrack }
+
+  TCDTrack = Class(TCollectionItem)
+  private
+    FDuration: TDateTime;
+    FExtra: String;
+    FPerformer: String;
+    FTitle: String;
+    function GetPerformer: String;
+  Public
+    Procedure Assign(Source : TPersistent); override;
+  Published
+    Property Title : String Read FTitle Write FTitle;
+    Property Performer : String Read GetPerformer Write FPerformer;
+    Property Extra : String Read FExtra Write FExtra;
+    Property Duration : TDateTime Read FDuration Write FDuration;
+  end;
+
+  { TCDTracks }
+
+  TCDTracks = Class(TCollection)
+  private
+    FCDDisk: TCDDisk;
+    function GetT(AIndex : Integer): TCDTrack;
+    procedure SetT(AIndex : Integer; const AValue: TCDTrack);
+  Public
+    Property CDDisk : TCDDisk Read FCDDisk;
+    Function AddTrack(Const ATitle,AExtra : String; ADuration : TDateTime) : TCDTrack;
+    Function AddTrack(Const ATitle,AExtra : String) : TCDTrack;
+    Function AddTrack(Const ATitle : String) : TCDTrack;
+    Property Track[AIndex : Integer] : TCDTrack Read GetT Write SetT; default;
+  end;
+
+
+  { TCDDisk }
+
+  TCDDisk = Class(TCollectionItem)
+  private
+    FDiskID: Integer;
+    FExtra: String;
+    FPerformer: String;
+    FPlayOrder: String;
+    FTitle: String;
+    FTracks: TCDTracks;
+    FYear: Word;
+    function GetDiskID: String;
+    procedure SetDiskID(const AValue: String);
+    procedure SetTracks(const AValue: TCDTracks);
+  Protected
+    Function CreateTracks : TCDTracks; virtual;
+  Public
+    Constructor Create(ADiskID : Integer);
+    Constructor Create(ACollection : TCollection); override;
+    Procedure Assign(Source : TPersistent); override;
+    Property IntDiscID : Integer Read FDiskID Write FDiskID;
+  Published
+    Property PlayOrder : String Read FPlayOrder Write FPlayOrder;
+    Property Year : Word Read FYear Write FYear;
+    Property Title : String Read FTitle Write FTitle;
+    Property Performer : String Read FPerformer Write FPerformer;
+    Property Extra : String Read FExtra Write FExtra;
+    Property DiscID : String Read GetDiskID Write SetDiskID;
+    property Tracks : TCDTracks Read FTracks Write SetTracks;
+  end;
+
+  { TCDDisks }
+
+  TCDDisks = Class(TCollection)
+  private
+    function GetD(AIndex : Integer): TCDDisk;
+    procedure SetD(AIndex : Integer; const AValue: TCDDisk);
+  Public
+    Function AddDisk(ADiscID : String) : TCDDisk;
+    Function AddDisk : TCDDisk;
+    Property Disk[AIndex : Integer] : TCDDisk Read GetD Write SetD; default;
+  end;
+
+  { TCDDBQueryMatch }
+  TCDDBQueryMatch = Class(TCollectionItem)
+  private
+    FCategory: String;
+    FDiscID: Integer;
+    FPerformer: String;
+    FTitle: String;
+  Public
+    Procedure Assign(Source : TPersistent); override;
+  Published
+    Property DiscID : Integer Read FDiscID Write FDiscID;
+    Property Category : String Read FCategory Write FCategory;
+    Property Title : String Read FTitle Write FTitle;
+    Property Performer : String Read FPerformer Write FPerformer;
+  end;
+
+  { TCDDBQueryMatches }
+
+  TCDDBQueryMatches = Class(TCollection)
+  private
+    function GetM(AIndex : Integer): TCDDBQueryMatch;
+    procedure SetM(AIndex : Integer; const AValue: TCDDBQueryMatch);
+  Public
+    Function AddMatch(Const ADiscID: Integer; Const ACategory,ATitle, APerformer : String) : TCDDBQueryMatch;
+    Function AddMatch(Const ADiscID,ACategory,ATitle, APerformer : String) : TCDDBQueryMatch;
+    Function AddMatch : TCDDBQueryMatch;
+    Property Match[AIndex : Integer] :TCDDBQueryMatch Read GetM Write SetM; default;
+  end;
+  { TCDDBParser }
+
+  TCDDBParser = Class(TComponent)
+  private
+    FDisks: TCDDisks;
+    FDisk : TCDDisk;
+    function ParseExtraDiskData(AData: String): Boolean;
+    function ParseExtraTrackData(ATrack: TCDTrack; AData: String): Boolean;
+    procedure SetDisks(const AValue: TCDDisks);
+    procedure SplitQueryResponse(AResponse: String; var ACategory, ADiscID, ATitle, APerformer: String);
+    procedure SplitTitle(const ALine: String; var AArtist, ATitle: String;
+      PreferTitle: boolean);
+    function StdReplacements(S: String): String;
+  Protected
+    Procedure CheckDisk;
+    function CheckCDDBCmdResult(var S: String): Integer;
+    Function CreateDisks :TCDDisks; virtual;
+    Function IsComment(Const L : String) : Boolean;
+    Function GetTrack(Const TrackNo : Integer) : TCDTrack;
+    Property Disk : TCDDisk Read FDisk;
+  Public
+    Constructor Create(AOwner : TComponent); override;
+    Destructor Destroy; override;
+    Function ParseCDDBReadResponse(Response : TStrings; WithHeader : Boolean = True) : Integer;
+    Function ParseCDDBReadResponse(Response : TStream; WithHeader : Boolean = True) : Integer;
+    Function ParseCDDBQueryResponse(Response : TStrings; Matches : TCDDBQueryMatches; WithHeader : Boolean = True) : Integer;
+    Function ParseCDDBQueryResponse(Response : TStream; Matches : TCDDBQueryMatches; WithHeader : Boolean = True) : Integer;
+  Published
+    Property Disks : TCDDisks Read FDisks Write SetDisks;
+  end;
+
+  ECDDBParser = Class(Exception);
+
+Function DiscIDToStr(ID : Integer) : String;
+Function StrToDiscID(S : String) : Integer;
+
+implementation
+
+Resourcestring
+  SErrNoDisk         = 'No disk active';
+  SErrInvalidTrackNo = 'Invalid track number: %d';
+  SErrParsingLine    = 'An error occured while parsing line %d of the response: %s';
+  SErrCDDBResponse   = 'CDDB error in command response: %s';
+
+function DiscIDToStr(ID: Integer): String;
+begin
+  Result:=LowerCase(Format('%.8x',[ID]));
+end;
+
+function StrToDiscID(S: String): Integer;
+begin
+  Result:=StrToIntDef('$'+S,-1);
+end;
+
+{ TCDTrack }
+
+function TCDTrack.GetPerformer: String;
+begin
+  Result:=FPerformer;
+  If (Result='') and Assigned(Collection) and (Collection is TCDTracks) then
+    If Assigned(TCDTracks(Collection).CDDisk) then
+      Result:=TCDTracks(Collection).CDDisk.Performer;
+end;
+
+procedure TCDTrack.Assign(Source: TPersistent);
+
+Var
+  T : TCDTrack;
+
+begin
+  if (Source is TCDTrack) then
+    begin
+    T:=Source as TCDTrack;
+    FTitle:=T.FTitle;
+    FExtra:=T.FExtra;
+    FPerformer:=T.FPerformer;
+    FDuration:=T.FDuration;
+    end
+  else
+    inherited Assign(Source);
+end;
+
+{ TCDDisk }
+
+procedure TCDDisk.SetTracks(const AValue: TCDTracks);
+begin
+  if FTracks=AValue then exit;
+  FTracks.Assign(AValue);
+end;
+
+function TCDDisk.GetDiskID: String;
+begin
+  Result:=DiscIDToStr(FdiskID);
+end;
+
+procedure TCDDisk.SetDiskID(const AValue: String);
+begin
+  FDiskID:=StrToDiscID(AValue);
+end;
+
+function TCDDisk.CreateTracks: TCDTracks;
+begin
+ Result:=TCDTracks.Create(TCDTrack);
+end;
+
+constructor TCDDisk.Create(ADiskID: Integer);
+begin
+  FDiskID:=ADiskID;
+  Create(Nil);
+end;
+
+constructor TCDDisk.Create(ACollection: TCollection);
+begin
+  FTracks:=CreateTracks;
+  FTracks.FCDDisk:=Self;
+  inherited Create(ACollection);
+end;
+
+procedure TCDDisk.Assign(Source: TPersistent);
+
+Var
+  D : TCDDisk;
+
+begin
+  if Source is TCDDisk then
+    begin
+    D:=Source as TCDDisk;
+    FTitle:=D.FTitle;
+    FExtra:=D.FExtra;
+    FPerformer:=D.FPerformer;
+    FYear:=D.FYear;
+    FTracks.Assign(D.FTracks);
+    FPLayOrder:=D.FPlayOrder;
+    end
+  else
+    inherited Assign(Source);
+end;
+
+{ TCDTracks }
+
+function TCDTracks.GetT(AIndex : Integer): TCDTrack;
+begin
+  Result:=Items[AIndex] as TCDTrack;
+end;
+
+procedure TCDTracks.SetT(AIndex : Integer; const AValue: TCDTrack);
+begin
+  Items[AIndex]:=AValue;
+end;
+
+function TCDTracks.AddTrack(const ATitle, AExtra: String; ADuration: TDateTime
+  ): TCDTrack;
+begin
+  Result:=Add as TCDTrack;
+  Result.Title:=ATitle;
+  Result.Extra:=AExtra;
+  Result.Duration:=ADuration;
+end;
+
+function TCDTracks.AddTrack(const ATitle, AExtra: String): TCDTrack;
+begin
+  Result:=AddTrack(ATitle,AExtra,0);
+end;
+
+function TCDTracks.AddTrack(const ATitle: String): TCDTrack;
+begin
+  Result:=AddTrack(ATitle,'',0);
+end;
+
+{ TCDDisks }
+
+function TCDDisks.GetD(AIndex : Integer): TCDDisk;
+begin
+  Result:=Items[AIndex] as TCDDisk;
+end;
+
+procedure TCDDisks.SetD(AIndex : Integer; const AValue: TCDDisk);
+begin
+  Items[AIndex]:=AValue;
+end;
+
+function TCDDisks.AddDisk(ADiscID: String): TCDDisk;
+begin
+  Result:=Self.AddDisk();
+  Result.DiscID:=ADiscID;
+end;
+
+function TCDDisks.AddDisk: TCDDisk;
+begin
+  Result:=Add as TCDDisk;
+end;
+
+{ TCDDBParser }
+
+procedure TCDDBParser.SetDisks(const AValue: TCDDisks);
+begin
+  if FDisks=AValue then exit;
+  FDisks.Assign(AValue);
+end;
+
+procedure TCDDBParser.CheckDisk;
+begin
+  If (FDisk=Nil) then
+    Raise ECDDBParser.Create(SErrNoDisk)
+end;
+
+function TCDDBParser.CreateDisks: TCDDisks;
+begin
+  Result:=TCDDisks.Create(TCDDisk);
+end;
+
+function TCDDBParser.IsComment(const L: String): Boolean;
+begin
+  Result:=(Length(L)=0) or (L[1]='#');
+end;
+
+function TCDDBParser.GetTrack(const TrackNo: Integer): TCDTrack;
+begin
+  If (TrackNo<0) then
+    Raise ECDDBParser.CreateFmt(SErrInvalidTrackNo,[TrackNo]);
+  CheckDisk;
+  If (TrackNo>FDisk.Tracks.Count) then
+    Raise ECDDBParser.CreateFmt(SErrInvalidTrackNo,[TrackNo]);
+  If (TrackNo=FDisk.Tracks.Count) then
+    Result:=FDisk.Tracks.AddTrack('')
+  else
+    Result:=FDisk.Tracks[TrackNo]
+end;
+
+constructor TCDDBParser.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FDisks:=CreateDisks;
+end;
+
+destructor TCDDBParser.Destroy;
+begin
+  FreeAndNil(FDisks);
+  inherited Destroy;
+end;
+
+Function TCDDBParser.StdReplacements(S : String) : String;
+
+begin
+  Result:=StringReplace(S,'\n',sLineBreak,[rfReplaceAll]);
+end;
+
+Function TCDDBParser.ParseExtraDiskData(AData : String) : Boolean;
+
+begin
+  FDisk.Extra:=FDisk.Extra+StdReplacements(AData);
+end;
+
+Function TCDDBParser.ParseExtraTrackData(ATrack : TCDTrack; AData : String) : Boolean;
+
+begin
+  ATrack.Extra:=ATrack.Extra+StdReplacements(AData);
+end;
+
+Procedure TCDDBParser.SplitTitle(Const ALine: String; Var AArtist, ATitle : String; PreferTitle : boolean);
+
+Var
+  P,L : Integer;
+
+begin
+  // Artist / Title
+  L:=Length(ALine);
+  P:=Pos('/',ALine);
+  If (P=0) and Not PreferTitle then
+    P:=L+1;
+  AArtist:=Trim(Copy(ALine,1,P-1));
+  ATitle:=Trim(Copy(ALine,P+1,L-P));
+end;
+
+Function TCDDBParser.ParseCDDBReadResponse(Response: TStrings; WithHeader : Boolean = True) : Integer;
+
+Var
+  I,P : Integer;
+  L,Args,A,T : String;
+  TrackID : Integer;
+  Track : TCDTrack;
+
+begin
+  Result:=-1;
+  FDisks.Clear;
+  If WithHeader and (Response.Count>0) then
+    begin
+    L:=Response[0];
+    If Not (CheckCDDBCmdResult(L) in [200,210]) then
+      Raise ECDDBParser.CreateFmt(SErrCDDBResponse,[L]);
+    end;
+  FDisk:=Nil;
+  Result:=0;
+  Try
+    Try
+      I:=Ord(WithHeader);
+      While (I<Response.Count) do
+        begin
+        L:=Response[i];
+        If Not IsComment(L) then
+          begin
+          P:=Pos('=',L);
+          Args:=Copy(L,P+1,Length(L)-P);
+          L:=Uppercase(Copy(L,1,P-1));
+          If (L='DISCID') then
+            FDisk:=FDisks.AddDisk(Args)
+          else
+            begin
+            CheckDisk;
+            If (L='DTITLE') then
+              begin
+              SplitTitle(Args,A,T,True);
+              FDisk.Title:=T;
+              FDisk.Performer:=A;
+              end
+            else if (L='EXTD') then
+              ParseExtraDiskData(Args)
+            else if (Copy(L,1,6)='TTITLE') then
+              begin
+              Delete(L,1,6);
+              TrackID:=StrToIntDef(L,-1);
+              Track:=GetTrack(TrackID);
+              SplitTitle(Args,A,T,True);
+              Track.Title:=T;
+              Track.Performer:=A;
+              end
+            else if (Copy(L,1,6)='EXTT') then
+              begin
+              Delete(L,1,6);
+              TrackID:=StrToIntDef(L,-1);
+              Track:=GetTrack(TrackID);
+              ParseExtraTrackData(Track,Args);
+              end
+            else if (Copy(L,1,9)='PLAYORDER') then
+              begin
+              FDisk.PlayOrder:=Trim(Args);
+              end;
+            end;
+          end;
+        Inc(I);
+        end;
+    except
+      On E : Exception do
+        begin
+        E.Message:=Format(SErrParsingLine,[I,E.MEssage]);
+        Raise;
+        end;
+    end;
+    Result:=FDisks.Count;
+  Finally
+    FDisk:=Nil;
+  end;
+end;
+
+Function TCDDBParser.ParseCDDBReadResponse(Response: TStream; WithHeader : Boolean = True) : Integer;
+
+Var
+  L : TStringList;
+
+begin
+  L:=TStringList.Create;
+  try
+    L.LoadFromStream(Response);
+    Result:=ParseCDDBReadResponse(L,WithHeader);
+  finally
+    L.Free;
+  end;
+end;
+
+function TCDDBParser.ParseCDDBQueryResponse(Response: TStrings;
+  Matches: TCDDBQueryMatches; WithHeader: Boolean): Integer;
+
+Var
+  I,CmdRes : Integer;
+  L : String;
+  D,C,T,P : String;
+
+begin
+  Matches.Clear;
+  Result:=-1;
+  If WithHeader and (Response.Count>0) then
+    begin
+    L:=Response[0];
+    CmdRes:=CheckCDDBCmdResult(L);
+    If (CmdRes=200) then
+      begin
+      SplitQueryResponse(L,C,D,T,P);
+      Matches.AddMatch(D,C,T,P);
+      Result:=1;
+      Exit;
+      end
+    else if (CmdRes<>210) then
+      Raise ECDDBParser.CreateFmt(SerrCDDBResponse,[L]);
+    end;
+  For I:=Ord(WithHeader) to Response.Count-1 do
+    begin
+    SplitQueryResponse(Response[i],C,D,T,P);
+    Matches.AddMatch(D,C,T,P);
+    end;
+  Result:=Matches.Count;
+end;
+
+function TCDDBParser.ParseCDDBQueryResponse(Response: TStream;
+  Matches: TCDDBQueryMatches; WithHeader: Boolean): Integer;
+
+Var
+  L : TStringList;
+
+begin
+  L:=TStringList.Create;
+  try
+    L.LoadFromStream(Response);
+    Result:=ParseCDDBQueryResponse(L,Matches,WithHeader);
+  finally
+    L.Free;
+  end;
+end;
+
+Function TCDDBParser.CheckCDDBCmdResult(Var S : String) : Integer;
+
+Var
+  P : integer;
+
+begin
+  P:=Pos(' ',S);
+  If (P=0) then
+    P:=Length(S)+1;
+  Result:=StrToIntDef(Copy(S,1,P-1),0);
+  Delete(S,1,P);
+end;
+
+Procedure TCDDBParser.SplitQueryResponse(AResponse :String; Var ACategory, ADiscID, ATitle, APerformer : String);
+
+Var
+  P : Integer;
+
+begin
+  P:=Pos(' ',AResponse);
+  ACategory:=Copy(AResponse,1,P-1);
+  Delete(AResponse,1,P);
+  P:=Pos(' ',AResponse);
+  ADiscId:=Copy(AResponse,1,P-1);
+  Delete(AResponse,1,P);
+  SplitTitle(AResponse,APerformer,ATitle,True);
+end;
+
+{ TCDDBQueryMatches }
+
+function TCDDBQueryMatches.GetM(AIndex : Integer): TCDDBQueryMatch;
+begin
+  Result:=TCDDBQueryMatch(Items[AIndex]);
+end;
+
+procedure TCDDBQueryMatches.SetM(AIndex : Integer; const AValue: TCDDBQueryMatch
+  );
+begin
+  Items[AIndex]:=AValue;
+end;
+
+function TCDDBQueryMatches.AddMatch(const ADiscID: Integer; const ACategory,
+  ATitle, APerformer: String): TCDDBQueryMatch;
+begin
+  Result:=AddMatch();
+  Result.DiscID:=ADiscID;
+  Result.Category:=ACategory;
+  Result.Title:=ATitle;
+  Result.Performer:=APerformer;
+end;
+
+function TCDDBQueryMatches.AddMatch(const ADiscID, ACategory, ATitle, APerformer : String): TCDDBQueryMatch;
+
+begin
+  Result:=AddMatch(StrToDiscID(ADiscID),ACategory,ATitle,APerformer);
+end;
+
+function TCDDBQueryMatches.AddMatch: TCDDBQueryMatch;
+begin
+  Result:=Add as TCDDBQueryMatch;
+end;
+
+{ TCDDBQueryMatch }
+
+procedure TCDDBQueryMatch.Assign(Source: TPersistent);
+
+Var
+  M : TCDDBQueryMatch;
+
+begin
+  if Source is TCDDBQueryMatch then
+    begin
+    M:=Source as TCDDBQueryMatch;
+    FDiscID:=M.FDiscID;
+    FCategory:=M.FCategory;
+    FPerformer:=M.FPerformer;
+    FTitle:=M.FTitle;
+    end
+  else
+    inherited Assign(Source);
+end;
+
+end.
+