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 saveToFile(name: string; pt: pointer; len: longint); inline;
procedure saveToGz(name: string; pt: pointer; len: longint); inline;
procedure loadFromFile(name: string; out pt: pointer; out len: longint); inline;
procedure loadFromGz(name: string; out pt: pointer; out len: longint); inline;

implementation

uses systemunit, math;

const
  minBufLen = 1024*1024;

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;
  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:=tProcess.create(nil);
  pr.executable:='gzip';
  pr.parameters.add('--best');
  pr.parameters.add('-c');
  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 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;
  pTmp:       pByte;
  pLen,rb,br: longint;
begin
  pr:=tProcess.create(nil);
  pr.executable:='zcat';
  pr.parameters.add(name);
  pr.options:=pr.options + [poUsePipes];
  pLen:=minBufLen;
  getmem(pTmp,pLen);
  br:=0;
  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);
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.