Przeglądaj źródła

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 4 miesięcy temu
rodzic
commit
46effff8fa
3 zmienionych plików z 170 dodań i 14 usunięć
  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
 
-uses UnitBookDialog, Forms, unitAppEvents, unitLog;
+uses UnitBookDialog, Forms, unitAppEvents, unitLog, LazUTF8, unitTempUtils;
 
 procedure TBook.OpenEditDialogAsync({%H-}Data: PtrInt);
 var
@@ -168,6 +168,55 @@ var
   dstW, dstH, offX, offY: Integer;
   scale: Double;
   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
   // Default state
   mImagePath := '';
@@ -222,22 +271,33 @@ begin
         LogInfoFmt('SetImage: applied image "%s" target=%dx%d (pre-scaled)', [mImagePath, W, H]);
         Exit;
       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
         begin
           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;
-          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;

+ 9 - 1
src/main.pas

@@ -7,7 +7,7 @@ interface
 uses
   Classes, Sysutils, Fileutil, Forms, Controls, Graphics, Dialogs, ExtCtrls, LazFileUtils,
   Book, BookCollection, LCLIntf, LResources, StdCtrls, LCLType, IniFiles, unitSettingsDialog,
-  unitCoverWorker, unitStorageXML, unitMetadata, unitAppEvents, unitLog, LazUTF8;
+  unitCoverWorker, unitStorageXML, unitMetadata, unitAppEvents, unitLog, unitTempUtils, LazUTF8;
 
 
 type
@@ -361,6 +361,10 @@ begin
   if Assigned(LayoutTimer) then LayoutTimer.Enabled := False;
   // Ensure background worker thread is stopped before destroying books/controls
   CoverWorkerStop;
+  // Cleanup any session temp covers
+  try
+    CleanupSessionTempCovers;
+  except end;
   try
     if Assigned(bookList) then
       SaveBooksXML(dataXmlPath, bookList);
@@ -598,6 +602,10 @@ begin
 
   // Register autosave callback for book edits (debounced)
   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
   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.