Explorar o código

Temp cover cleanup: avoid recursive conversions, use short temp names, track session files, cleanup on startup and shutdown

- Add unitTempUtils: register and cleanup temp cover files; delete stale files older than 24h\n- book: skip converting PNGs or already-converted files; write to temp dir with short sanitized name; register session temp files\n- main: cleanup old temp covers on startup, cleanup session temp covers on shutdown
Codex CLI hai 4 meses
pai
achega
46effff8fa
Modificáronse 3 ficheiros con 170 adicións e 14 borrados
  1. 73 13
      src/book.pas
  2. 9 1
      src/main.pas
  3. 88 0
      src/unitTempUtils.pas

+ 73 - 13
src/book.pas

@@ -53,7 +53,7 @@ procedure SetPdfCoverGenerationEnabled(AEnabled: Boolean);
 
 
 implementation
 implementation
 
 
-uses UnitBookDialog, Forms, unitAppEvents, unitLog;
+uses UnitBookDialog, Forms, unitAppEvents, unitLog, LazUTF8, unitTempUtils;
 
 
 procedure TBook.OpenEditDialogAsync({%H-}Data: PtrInt);
 procedure TBook.OpenEditDialogAsync({%H-}Data: PtrInt);
 var
 var
@@ -168,6 +168,55 @@ var
   dstW, dstH, offX, offY: Integer;
   dstW, dstH, offX, offY: Integer;
   scale: Double;
   scale: Double;
   W, H: Integer;
   W, H: Integer;
+  convOut: String;
+
+  function TryConvertImageToPng(const InFile: String; out OutFile: String): Boolean;
+  var
+    proc: TProcess;
+    exe: String;
+    base, nameOnly, tmpDir: String;
+    i: Integer;
+  begin
+    Result := False;
+    OutFile := '';
+    // Only try to convert if not already a PNG and not already a converted temp file
+    if UTF8LowerCase(ExtractFileExt(InFile)) = '.png' then Exit(False);
+    if Pos('mybookshelf_cover_', UTF8LowerCase(InFile)) > 0 then Exit(False);
+
+    // Build a safe temp output path to avoid extremely long filenames
+    tmpDir := GetTempDir(False);
+    nameOnly := ExtractFileName(ChangeFileExt(InFile, ''));
+    // sanitize and truncate
+    for i := 1 to Length(nameOnly) do
+      if not (nameOnly[i] in ['A'..'Z','a'..'z','0'..'9','_','-']) then nameOnly[i] := '_';
+    if Length(nameOnly) > 48 then
+      SetLength(nameOnly, 48);
+    OutFile := IncludeTrailingPathDelimiter(tmpDir) + 'mybookshelf_cover_' + nameOnly + '.png';
+    // prefer ImageMagick v7 'magick', then v6 'convert'
+    exe := FindDefaultExecutablePath('magick');
+    if exe = '' then exe := FindDefaultExecutablePath('convert');
+    if exe = '' then
+    begin
+      LogWarn('TryConvertImageToPng: no ImageMagick found (magick/convert)');
+      Exit(False);
+    end;
+    proc := TProcess.Create(nil);
+    try
+      proc.Executable := exe;
+      // For 'magick', first arg is input; for 'convert' similar syntax works
+      // add -auto-orient to respect EXIF rotation
+      proc.Parameters.Add(InFile);
+      proc.Parameters.Add('-auto-orient');
+      proc.Parameters.Add(OutFile);
+      proc.Options := [poWaitOnExit];
+      proc.ShowWindow := swoHide;
+      LogInfoFmt('Converting image to PNG: %s -> %s via %s', [InFile, OutFile, exe]);
+      proc.Execute;
+      Result := FileExists(OutFile) and (proc.ExitStatus = 0);
+    finally
+      proc.Free;
+    end;
+  end;
 begin
 begin
   // Default state
   // Default state
   mImagePath := '';
   mImagePath := '';
@@ -222,22 +271,33 @@ begin
         LogInfoFmt('SetImage: applied image "%s" target=%dx%d (pre-scaled)', [mImagePath, W, H]);
         LogInfoFmt('SetImage: applied image "%s" target=%dx%d (pre-scaled)', [mImagePath, W, H]);
         Exit;
         Exit;
       except
       except
-        // If pre-scale/assignment failed, fall back to direct load + Stretch
+        // If pre-scale/assignment failed, try converting to PNG, else fall back to direct load + Stretch
         on E: Exception do
         on E: Exception do
         begin
         begin
           LogErrorFmt('SetImage: failed to pre-scale "%s": %s', [AValue, E.Message]);
           LogErrorFmt('SetImage: failed to pre-scale "%s": %s', [AValue, E.Message]);
-          try
-            mCover.Stretch := True;
-            mCover.Center  := True;
-            mCover.AutoSize:= False;
-            mCover.Picture.LoadFromFile(AValue);
-            mImagePath := AValue;
-            // Mark as scaled to current control to avoid immediate rescale loop
-            mScaledW := mCover.Width; mScaledH := mCover.Height;
-            LogInfoFmt('SetImage: applied image "%s" via direct load (stretch)', [mImagePath]);
+          // Some files are mislabeled or unsupported; attempt to transcode to PNG if ImageMagick is available
+          if TryConvertImageToPng(AValue, convOut) and FileExists(convOut) then
+          begin
+            LogInfoFmt('SetImage: retry with converted PNG "%s"', [convOut]);
+            RegisterTempCoverFile(convOut);
+            SetImage(convOut);
             Exit;
             Exit;
-          except
-            on E2: Exception do LogErrorFmt('SetImage: direct load failed for "%s": %s', [AValue, E2.Message]);
+          end
+          else
+          begin
+            try
+              mCover.Stretch := True;
+              mCover.Center  := True;
+              mCover.AutoSize:= False;
+              mCover.Picture.LoadFromFile(AValue);
+              mImagePath := AValue;
+              // Mark as scaled to current control to avoid immediate rescale loop
+              mScaledW := mCover.Width; mScaledH := mCover.Height;
+              LogInfoFmt('SetImage: applied image "%s" via direct load (stretch)', [mImagePath]);
+              Exit;
+            except
+              on E2: Exception do LogErrorFmt('SetImage: direct load failed for "%s": %s', [AValue, E2.Message]);
+            end;
           end;
           end;
         end;
         end;
       end;
       end;

+ 9 - 1
src/main.pas

@@ -7,7 +7,7 @@ interface
 uses
 uses
   Classes, Sysutils, Fileutil, Forms, Controls, Graphics, Dialogs, ExtCtrls, LazFileUtils,
   Classes, Sysutils, Fileutil, Forms, Controls, Graphics, Dialogs, ExtCtrls, LazFileUtils,
   Book, BookCollection, LCLIntf, LResources, StdCtrls, LCLType, IniFiles, unitSettingsDialog,
   Book, BookCollection, LCLIntf, LResources, StdCtrls, LCLType, IniFiles, unitSettingsDialog,
-  unitCoverWorker, unitStorageXML, unitMetadata, unitAppEvents, unitLog, LazUTF8;
+  unitCoverWorker, unitStorageXML, unitMetadata, unitAppEvents, unitLog, unitTempUtils, LazUTF8;
 
 
 
 
 type
 type
@@ -361,6 +361,10 @@ begin
   if Assigned(LayoutTimer) then LayoutTimer.Enabled := False;
   if Assigned(LayoutTimer) then LayoutTimer.Enabled := False;
   // Ensure background worker thread is stopped before destroying books/controls
   // Ensure background worker thread is stopped before destroying books/controls
   CoverWorkerStop;
   CoverWorkerStop;
+  // Cleanup any session temp covers
+  try
+    CleanupSessionTempCovers;
+  except end;
   try
   try
     if Assigned(bookList) then
     if Assigned(bookList) then
       SaveBooksXML(dataXmlPath, bookList);
       SaveBooksXML(dataXmlPath, bookList);
@@ -598,6 +602,10 @@ begin
 
 
   // Register autosave callback for book edits (debounced)
   // Register autosave callback for book edits (debounced)
   OnBooksChanged := @ScheduleSaveBooks;
   OnBooksChanged := @ScheduleSaveBooks;
+  // Cleanup stale temporary cover files from previous runs (older than 24h)
+  try
+    CleanupOldTempCoverFiles(24);
+  except end;
 
 
   // speed up startup: we skipped synchronous PDF generation during load
   // speed up startup: we skipped synchronous PDF generation during load
   SetPdfCoverGenerationEnabled(False);
   SetPdfCoverGenerationEnabled(False);

+ 88 - 0
src/unitTempUtils.pas

@@ -0,0 +1,88 @@
+unit unitTempUtils;
+
+{$mode objfpc}{$H+}
+
+interface
+
+procedure RegisterTempCoverFile(const Path: string);
+procedure CleanupSessionTempCovers;
+procedure CleanupOldTempCoverFiles(MaxAgeHours: Integer);
+
+implementation
+
+uses
+  Classes, SysUtils, LazFileUtils, DateUtils;
+
+var
+  GTempCovers: TStringList;
+
+procedure EnsureList;
+begin
+  if GTempCovers = nil then
+  begin
+    GTempCovers := TStringList.Create;
+    GTempCovers.Sorted := False;
+    GTempCovers.Duplicates := dupIgnore;
+  end;
+end;
+
+procedure RegisterTempCoverFile(const Path: string);
+begin
+  if (Trim(Path) = '') then Exit;
+  if not FileExistsUTF8(Path) then Exit;
+  EnsureList;
+  GTempCovers.Add(Path);
+end;
+
+procedure CleanupSessionTempCovers;
+var i: Integer;
+begin
+  if GTempCovers = nil then Exit;
+  for i := 0 to GTempCovers.Count - 1 do
+  begin
+    try
+      if FileExistsUTF8(GTempCovers[i]) then
+        DeleteFileUTF8(GTempCovers[i]);
+    except
+      // ignore
+    end;
+  end;
+  FreeAndNil(GTempCovers);
+end;
+
+procedure CleanupOldTempCoverFiles(MaxAgeHours: Integer);
+var
+  sr: TSearchRec;
+  mask, tmpDir, path: string;
+  dt: TDateTime;
+  ageHours: Double;
+begin
+  if MaxAgeHours <= 0 then Exit;
+  tmpDir := GetTempDir(False);
+  mask := IncludeTrailingPathDelimiter(tmpDir) + 'mybookshelf_cover_*.png';
+  if FindFirstUTF8(mask, faAnyFile and faArchive, sr) = 0 then
+  try
+    repeat
+      path := IncludeTrailingPathDelimiter(tmpDir) + sr.Name;
+      try
+        if FileAgeUTF8(path, dt) then
+        begin
+          ageHours := HoursBetween(Now, dt);
+          if ageHours >= MaxAgeHours then
+            DeleteFileUTF8(path);
+        end;
+      except
+        // ignore per-file errors
+      end;
+    until FindNextUTF8(sr) <> 0;
+  finally
+    FindCloseUTF8(sr);
+  end;
+end;
+
+finalization
+  // ensure list is freed
+  if GTempCovers <> nil then
+    GTempCovers.Free;
+
+end.