unit fileunit;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Process;

type
  tInputThread = class (tThread)
    fertig: boolean;
    inhalt: pointer;
    len:    longint;
    proc:   tProcess;
    constructor create(p: tProcess; inh: pointer; l: longint);
    destructor destroy; override;
    procedure execute; override;
  end;

procedure saveToGeneric(name: string; pt: pointer; len: longint);
procedure saveToFile(name: string; pt: pointer; len: longint);
procedure saveToGz(name: string; pt: pointer; len: longint);
procedure saveToPgz(name: string; pt: pointer; len: longint);
procedure saveViaProcess(name: string; pr: tProcess; pt: pointer; len: longint);
procedure loadFromGeneric(name: string; out pt: pointer; out len: longint);
procedure loadFromFile(name: string; out pt: pointer; out len: longint);
procedure loadFromGz(name: string; out pt: pointer; out len: longint);
procedure loadFromPgz(name: string; out pt: pointer; out len: longint);
procedure loadFromProcess(pr: tProcess; out pt: pointer; out len: longint);

implementation

uses systemunit, math;

const
  minBufLen = 1024*1024;

procedure saveToGeneric(name: string; pt: pointer; len: longint);
begin
  if rightStr(name,3)='.gz' then
    saveToGz(name,pt,len)
  else if rightStr(name,4)='.pgz' then
    saveToPgz(name,pt,len)
  else
    saveToFile(name,pt,len);
end;

procedure saveToFile(name: string; pt: pointer; len: longint);
var
  f: file;
  n: string;
begin
  if fileExists(name) then
    n:=mkTemp(name+'.XXXXXX')
  else
    n:=name;
  assignFile(f,n);
  rewrite(f,1);
  blockWrite(f,pt^,len);
  closeFile(f);
  if name<>n then begin
    deleteFile(name);
    rename(f,name);
  end;
end;

procedure saveToGz(name: string; pt: pointer; len: longint);
var
  pr: tProcess;
begin
  pr:=tProcess.create(nil);
  pr.executable:='gzip';
  pr.parameters.add('--best');
  pr.parameters.add('-c');
  saveViaProcess(name,pr,pt,len);
end;

procedure saveToPgz(name: string; pt: pointer; len: longint);
var
  pr: tProcess;
begin
  pr:=tProcess.create(nil);
  pr.executable:='pigz';
  pr.parameters.add('--best');
  pr.parameters.add('-c');
  saveViaProcess(name,pr,pt,len);
end;

procedure saveViaProcess(name: string; pr: tProcess; pt: pointer; len: longint);
var
  buf:    array of byte;
  f:      file;
  rb:     longint;
  it:     tInputThread;
  datNam: string;
begin
  if fileExists(name) then
    datNam:=mkTemp(name+'.XXXXXX')
  else
    datNam:=name;

  pr.options:=pr.options + [poUsePipes];
  pr.execute;
  setLength(buf,minBufLen);
  fillchar(buf[0],length(buf)*sizeOf(buf[0]),$0);
  it:=tInputThread.create(pr,pt,len);
  assignFile(f,datNam);
  rewrite(f,1);
  while pr.running or (not it.fertig) or (pr.output.numBytesAvailable>0) do begin
    rb:=min(length(buf),pr.output.numBytesAvailable);
    if rb>0 then begin
      rb:=pr.output.read(buf[0],rb);
      blockWrite(f,buf[0],rb);
    end
    else
      sleep(1); // nix zu Schreiben, nix zu Lesen, also warten wir
  end;
  pr.free;
  it.free;
  closeFile(f);
  if name<>datNam then begin
    deleteFile(name);
    rename(f,name);
  end;
end;

procedure loadFromGeneric(name: string; out pt: pointer; out len: longint);
begin
  if rightStr(name,3)='.gz' then
    loadFromGz(name,pt,len)
  else if rightStr(name,4)='.pgz' then
    loadFromPgz(name,pt,len)
  else
    loadFromFile(name,pt,len);
end;

procedure loadFromFile(name: string; out pt: pointer; out len: longint);
var
  f: file;
begin
  assign(f,name);
  reset(f,1);
  len:=fileSize(f);
  getMem(pt,len);
  blockRead(f,pt^,len);
  close(f);
end;

procedure loadFromGz(name: string; out pt: pointer; out len: longint);
var
  pr: tProcess;
begin
  pr:=tProcess.create(nil);
  pr.executable:='zcat';
  pr.parameters.add(name);
  loadFromProcess(pr,pt,len);
end;

procedure loadFromPgz(name: string; out pt: pointer; out len: longint);
var
  pr: tProcess;
begin
  pr:=tProcess.create(nil);
  pr.executable:='pigz';
  pr.parameters.add('-d');
  pr.parameters.add('-c');
  pr.parameters.add(name);
  loadFromProcess(pr,pt,len);
end;

procedure loadFromProcess(pr: tProcess; out pt: pointer; out len: longint); inline;
var
  pTmp:       pByte;
  pLen,rb,br: longint;
begin
  pLen:=minBufLen;
  getMem(pTmp,pLen);
  br:=0;
  pr.options:=pr.options + [poUsePipes];
  pr.execute;
  while pr.running or (pr.output.numBytesAvailable>0) do begin
    rb:=pr.output.numBytesAvailable;
    if rb>0 then begin
      if pLen<br+rb then begin
        pt:=pTmp;
        len:=pLen;
        pLen:=br+rb+minBufLen;
        getMem(pTmp,pLen);
        move(pt^,pTmp^,len);
        freeMem(pt);
      end;
      rb:=pr.output.read((pTmp+br)^,rb);
      br:=br+rb;
    end
    else sleep(1);
  end;
  len:=br;
  getMem(pt,len);
  move(pTmp^,pt^,len);
  freeMem(pTmp);
  pr.free;
end;

// tInputThread ****************************************************************

constructor tInputThread.create(p: tProcess; inh: pointer; l: longint);
begin
 inherited create(true);
 fertig:=false;
 inhalt:=inh;
 len:=l;
 proc:=p;
 suspended:=false;
end;

destructor tInputThread.destroy;
begin
 inhalt:=nil;
 proc:=nil;
 inherited destroy;
end;

procedure tInputThread.execute;
var
  wb,cwb: longint;
begin
 wb:=0;
 while wb<len do begin
   cwb:=proc.input.write((inhalt+wb)^,len-wb);
   if cwb=0 then
     sleep(1)
   else
     wb:=wb+cwb;
 end;
 proc.closeInput;
 fertig:=true;
end;

end.