////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2026 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// Linux MIME globs - file extension to/from MIME mapping.                    //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20250929 - Created by A.K.                                                 //
////////////////////////////////////////////////////////////////////////////////

unit _crw_mimeglob; //  Unix MIME glob - map file extension to/from MIME

{$I _crw_sysdef.inc}

{$I _crw_sysmode.inc}

interface

uses
 //////////////////////////////////////////////////////
 {$I _crw_uses_first.inc} // NB: MUST BE FIRST USES !!!
 //////////////////////////////////////////////////////
 sysutils, classes, math,
 _crw_alloc, _crw_ef, _crw_proc, _crw_str, _crw_fio,
 _crw_spcfld, _crw_hl;

////////////////////////////////////////////////////////////////////////////////
// Class TMimeGlob has (normally) single instance object - MimeGlob.
// MimeGlob is object to map file extensions to MIME types and back.
// See XDG specification "Shared MIME-info Database" for details.
// Usually MIME globs located in /usr/share/mime and ~/.local/share/mime dirs.
////////////////////////////////////////////////////////////////////////////////
type
 TMimeGlob = class(TLatch)
 private
  myRootMimeGlobs  : LongString;
  myUserMimeGlobs  : LongString;
  myBuffMimeGlobs  : LongString;
  myRootMimeGlobs2 : LongString;
  myUserMimeGlobs2 : LongString;
  myBuffMimeGlobs2 : LongString;
  myListMimeToExt  : LongString;
  myListExtToMime  : LongString;
  myMapMimeToExt   : THashList;
  myMapExtToMime   : THashList;
 public
  constructor Create;
  destructor  Destroy; override;
  procedure   AfterConstruction; override;
  procedure   BeforeDestruction; override;
 public
  function ReadMimeGlobs(Mode:Integer=0):LongString;
  function ReadMimeGlobs2(Mode:Integer=0):LongString;
  function UpdateMimeMapping:Integer;
 public
  function  MapMimeToExt(aMime:LongString):LongString;
  function  MapExtToMime(aExt:LongString):LongString;
  property  MimeToExt[aMime:LongString]:LongString read MapMimeToExt;
  property  ExtToMime[aExt:LongString]:LongString read MapExtToMime;
 public
  function  ListMimeToExt:LongString;
  function  ListExtToMime:LongString;
  function  HasMimeToExt:Boolean;
  function  HasExtToMime:Boolean;
 public
  function  RootMimeGlobs:LongString;
  function  UserMimeGlobs:LongString;
  function  RootMimeGlobs2:LongString;
  function  UserMimeGlobs2:LongString;
  function  RootMimePath(sub:LongString=''):LongString;
  function  UserMimePath(sub:LongString=''):LongString;
 end;

function MimeGlob:TMimeGlob;

procedure Kill(var TheObject:TMimeGlob); overload;

implementation

///////////////////////////
// TMimeGlob implementation
///////////////////////////

constructor TMimeGlob.Create;
begin
 inherited Create;
 myMapMimeToExt:=NewHashList(false,HashList_DefaultHasher);
 myMapMimeToExt.Master:=@myMapMimeToExt;
 myMapExtToMime:=NewHashList(false,HashList_DefaultHasher);
 myMapExtToMime.Master:=@myMapExtToMime;
end;

destructor TMimeGlob.Destroy;
begin
 myRootMimeGlobs:='';
 myUserMimeGlobs:='';
 myBuffMimeGlobs:='';
 myRootMimeGlobs2:='';
 myUserMimeGlobs2:='';
 myBuffMimeGlobs2:='';
 myListMimeToExt:='';
 myListExtToMime:='';
 Kill(myMapMimeToExt);
 Kill(myMapExtToMime);
 inherited Destroy;
end;

procedure TMimeGlob.AfterConstruction;
begin
 inherited AfterConstruction;
 if IsUnix then begin
  myRootMimeGlobs:=RootMimePath('globs');
  myUserMimeGlobs:=UserMimePath('globs');
  myRootMimeGlobs2:=RootMimePath('globs2');
  myUserMimeGlobs2:=UserMimePath('globs2');
  if (ReadMimeGlobs='') then ReadMimeGlobs2;
  UpdateMimeMapping;
 end;
end;

procedure TMimeGlob.BeforeDestruction;
begin
 myMapMimeToExt.Clear;
 myMapExtToMime.Clear;
 inherited BeforeDestruction;
end;

function TMimeGlob.RootMimeGlobs:LongString;
begin
 if Assigned(Self)
 then Result:=myRootMimeGlobs
 else Result:='';
end;

function TMimeGlob.UserMimeGlobs:LongString;
begin
 if Assigned(Self)
 then Result:=myUserMimeGlobs
 else Result:='';
end;

function TMimeGlob.RootMimeGlobs2:LongString;
begin
 if Assigned(Self)
 then Result:=myRootMimeGlobs2
 else Result:='';
end;

function TMimeGlob.UserMimeGlobs2:LongString;
begin
 if Assigned(Self)
 then Result:=myUserMimeGlobs2
 else Result:='';
end;

function TMimeGlob.RootMimePath(sub:LongString=''):LongString;
begin
 if not IsUnix then Exit('');
 if HasChars(sub,JustSpaces) then sub:=Trim(sub);
 if (sub<>'') then sub:=AddPathDelim('mime')+sub;
 Result:=GetSpecialShellFolderPath(CSIDL_XDG_DATA_DIR,sub);
end;

function TMimeGlob.UserMimePath(sub:LongString=''):LongString;
begin
 if not IsUnix then Exit('');
 if HasChars(sub,JustSpaces) then sub:=Trim(sub);
 if (sub<>'') then sub:=AddPathDelim('mime')+sub;
 Result:=GetSpecialShellFolderPath(CSIDL_XDG_DATA_HOME,sub);
end;

function TMimeGlob.ReadMimeGlobs(Mode:Integer=0):LongString;
var rBuff,uBuff:LongString;
begin
 Result:='';
 if Assigned(Self) then
 try
  rBuff:=''; uBuff:='';
  if not IsUnix then Exit;
  if HasFlags(Mode,1) then myBuffMimeGlobs:='';
  if (myBuffMimeGlobs<>'') then Exit(myBuffMimeGlobs);
  if FileIsReadable(UserMimeGlobs) then uBuff:=StringFromFile(UserMimeGlobs,0);
  if FileIsReadable(RootMimeGlobs) then rBuff:=StringFromFile(RootMimeGlobs,0);
  myBuffMimeGlobs:=rBuff+EOL+uBuff;
  Result:=myBuffMimeGlobs;
 except
  on E:Exception do BugReport(E,Self,'ReadMimeGlobs');
 end;
end;

function TMimeGlob.ReadMimeGlobs2(Mode:Integer=0):LongString;
var rBuff,uBuff:LongString;
begin
 Result:='';
 if Assigned(Self) then
 try
  rBuff:=''; uBuff:='';
  if not IsUnix then Exit;
  if HasFlags(Mode,1) then myBuffMimeGlobs2:='';
  if (myBuffMimeGlobs2<>'') then Exit(myBuffMimeGlobs2);
  if FileIsReadable(UserMimeGlobs2) then uBuff:=StringFromFile(UserMimeGlobs2,0);
  if FileIsReadable(RootMimeGlobs2) then rBuff:=StringFromFile(RootMimeGlobs2,0);
  myBuffMimeGlobs2:=rBuff+EOL+uBuff;
  Result:=myBuffMimeGlobs2;
 except
  on E:Exception do BugReport(E,Self,'ReadMimeGlobs2');
 end;
end;

function globsIter(n:SizeInt; Line:LongString; Custom:Pointer):Boolean;
var Glob:TMimeGlob; Mime,Pattern,Ext:LongString;
begin
 Result:=True;
 if IsEmptyStr(Line) then Exit;
 if (Custom=nil) then Exit(False);
 Mime:=''; Pattern:=''; Ext:=''; Glob:=Custom;
 if HasChars(Line,['#']) then Line:=Trim(StrAheadOf(Line,'#'));
 if (CountChars(Line,[':'])=2) then Line:=StrAfterOf(Line,':');
 if (ExtractNameValuePair(Line,Mime,Pattern,':')<2) then Exit;
 if IsEmptyStr(Mime) or IsEmptyStr(Pattern) then Exit;
 if StartsText('*.',Pattern) then Ext:=Copy(Pattern,2) else Exit;
 if HasChars(Ext,['*','?','[',']','\','/']) then Exit;
 Glob.myMapMimeToExt.KeyedParams[Mime]:=Ext;
 Glob.myMapExtToMime.KeyedParams[Ext]:=Mime;
end;

function TMimeGlob.UpdateMimeMapping:Integer;
var ListME,ListEM:TStringList; i:Integer;
begin
 Result:=0;
 if IsUnix then
 if Assigned(Self) then
 try
  ListME:=TStringList.Create; ListME.Sorted:=True; ListME.Duplicates:=dupIgnore;
  ListEM:=TStringList.Create; ListEM.Sorted:=True; ListEM.Duplicates:=dupIgnore;
  Lock;
  try
   myListMimeToExt:='';
   myListExtToMime:='';
   myMapMimeToExt.Clear;
   myMapExtToMime.Clear;
   if (Result=0) then begin
    ForEachStringLine(ReadMimeGlobs,globsIter,Self);
    Result:=myMapExtToMime.Count;
   end;
   if (Result=0) then begin
    ForEachStringLine(ReadMimeGlobs2,globsIter,Self);
    Result:=myMapExtToMime.Count;
   end;
   for i:=0 to myMapMimeToExt.Count-1 do begin
    ListME.Add(Format('%s=%s',[myMapMimeToExt.Keys[i],myMapMimeToExt.Params[i]]));
   end;
   for i:=0 to myMapExtToMime.Count-1 do begin
    ListEM.Add(Format('%s=%s',[myMapExtToMime.Keys[i],myMapExtToMime.Params[i]]));
   end;
   myListMimeToExt:=ListME.Text;
   myListExtToMime:=ListEM.Text;
  finally
   Unlock;
   Kill(ListME);
   Kill(ListEM);
  end;
 except
  on E:Exception do BugReport(E,Self,'UpdateMimeMapping');
 end;
end;

function TMimeGlob.MapMimeToExt(aMime:LongString):LongString;
begin
 Result:='';
 if IsUnix then
 if (aMime<>'') then
 if Assigned(Self) then
 try
  Lock;
  try
   if (myMapMimeToExt.Count=0) then UpdateMimeMapping;
   Result:=myMapMimeToExt.KeyedParams[Trim(aMime)];
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'MapMimeToExt');
 end;
end;

function TMimeGlob.MapExtToMime(aExt:LongString):LongString;
begin
 Result:='';
 if IsUnix then
 if (aExt<>'') then
 if Assigned(Self) then
 try
  Lock;
  try
   if (myMapExtToMime.Count=0) then UpdateMimeMapping;
   Result:=myMapExtToMime.KeyedParams[Trim(aExt)];
  finally
   Unlock;
  end;
 except
  on E:Exception do BugReport(E,Self,'MapExtToMime');
 end;
end;

function TMimeGlob.ListMimeToExt:LongString;
begin
 if Assigned(Self)
 then Result:=myListMimeToExt
 else Result:='';
end;

function TMimeGlob.ListExtToMime:LongString;
begin
 if Assigned(Self)
 then Result:=myListExtToMime
 else Result:='';
end;

function TMimeGlob.HasMimeToExt:Boolean;
begin
 if Assigned(Self)
 then Result:=(myListMimeToExt<>'')
 else Result:=False;
end;

function TMimeGlob.HasExtToMime:Boolean;
begin
 if Assigned(Self)
 then Result:=(myListExtToMime<>'')
 else Result:=False;
end;

//////////////////////////
// MimeGlob implementation
//////////////////////////

const TheMimeGlob:TMimeGlob=nil;

function MimeGlob:TMimeGlob;
begin
 if not Assigned(TheMimeGlob) then begin
  TheMimeGlob:=TMimeGlob.Create;
  TheMimeGlob.Master:=@TheMimeGlob;
 end;
 Result:=TheMimeGlob;
end;

procedure Kill(var TheObject:TMimeGlob); overload;
begin
 try
  FreeAndNil(TheObject);
 except
  on E:Exception do BugReport(E,nil,'Kill');
 end;
end;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_mimeglob;
begin
 MimeGlob.Ok;
end;

procedure Free_crw_mimeglob;
begin
 Kill(TheMimeGlob);
end;

initialization

 Init_crw_mimeglob;

finalization

 Free_crw_mimeglob;

end.

//////////////
// END OF FILE
//////////////

