source: trunk/backup.lpr

program backup;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes, SysUtils, CustApp
  { you can add units after this }, UMemoryStreamEx, math;

type

  { TBackup }

  TBackup = class(TCustomApplication)
  protected
    procedure DoRun; override;
  public
    Counter: Integer;
    FileCount: Integer;
    BackupFileExtension: string;
    BackupFileName: string;
    ExponentBase: Double;
    Verbose: Boolean;
    constructor Create(TheOwner: TComponent); override;
    destructor Destroy; override;
    procedure WriteHelp; virtual;
    procedure MoveFiles;
    procedure CheckParameters;
    procedure PrintStatTable;
  end;

{ TBackup }

procedure TBackup.DoRun;
var
  CounterFile: TFileStream;
  CounterFileName: string;
begin
  CheckParameters;
  CounterFileName := BackupFileName + '.counter';
  if FileExists(CounterFileName) then begin
    CounterFile := TFileStream.Create(CounterFileName, fmOpenReadWrite);
    Counter := StrToInt(CounterFile.ReadAnsiString);
    CounterFile.Free;
  end else begin
    Counter := 0;
  end;
  if not FileExists(BackupFileName) then begin
    WriteLn('ZdrojovÜ soubor "' + BackupFileName + '" nenalezen.');
    Halt;
  end;
  if Verbose then WriteLn('Hodnota čítače kroků: ' + IntToStr(Counter));
  MoveFiles;
  CounterFile := TFileStream.Create(CounterFileName, fmCreate);
  CounterFile.WriteAnsiString(IntToStr(Counter));
  CounterFile.Free;
  Terminate;
end;

constructor TBackup.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);
  StopOnException := True;
  BackupFileExtension := '';
  BackupFileName := '';
  FileCount := 10;
  ExponentBase := 1;
  Verbose := False;
end;

destructor TBackup.Destroy;
begin
  inherited Destroy;
end;

procedure TBackup.WriteHelp;
begin
  WriteLn('PouÅŸití: backup [přepínače]');
  WriteLn('Vytváří kopie záloÅŸního souboru s exponenciálně rostoucím stářím.');
  WriteLn('  -f --file=SOUBOR     zálohovanÜ soubor');
  WriteLn('  -b --base=ČÍSLO      základ mocniny');
  WriteLn('  -c --count=ČÍSLO     max. počet zaloÅŸních souborů');
  WriteLn('  -e --file-extension=TEXT  rozšíření názvu vytvářenÃœch souborů');
  WriteLn('  -t --table           zobrazení tabulky stáří záloh');
  WriteLn('  -v --verbose         upovídanÜ reşim');
  WriteLn('     --version         zobrazení verze');
  WriteLn('  -h --help            zobrazení nápovědy');
end;

procedure TBackup.MoveFiles;
var
  I: Integer;
  NewFileName: string;
  OldFileName: string;
  ReducedBackupFileName: string;
begin
  if Copy(BackupFileName, 1 + Length(BackupFileName) - Length(BackupFileExtension), 255) = BackupFileExtension then
    ReducedBackupFileName := Copy(BackupFileName, 1, Length(BackupFileName) - Length(BackupFileExtension))
    else ReducedBackupFileName := BackupFileName;
  for I := FileCount downto 0 do begin
    if (Counter mod Trunc(Power(ExponentBase, I))) = 0 then begin
      if I = 0 then OldFileName := BackupFileName
        else OldFileName := ReducedBackupFileName + '-' + IntToStr(I) + BackupFileExtension;
      NewFileName := ReducedBackupFileName + '-' + IntToStr(I + 1) + BackupFileExtension;
      if FileExists(OldFileName) then begin
        if Verbose then
          WriteLn('Přesouvám "' + OldFileName + '" na "' + NewFileName + '". Perioda ' +
            IntToStr(Trunc(Power(ExponentBase, I))) + ' kroků.');
        if FileExists(NewFileName) then DeleteFile(PChar(NewFileName));
        RenameFile(OldFileName, NewFileName);
      end;
    end;
  end;

  Inc(Counter);
end;

procedure TBackup.CheckParameters;
//var
//  ErrorMsg: string;
begin
  // quick check parameters
  (*
  ErrorMsg := CheckOptions('h', 'help');
  WriteLn(ErrorMsg);
  if ErrorMsg <> '' then begin
    ShowException(Exception.Create(ErrorMsg));
    Halt;
  end;
  *)

  // parse parameters
  if HasOption('h', 'help') then begin
    WriteHelp;
    Halt;
  end;

  if HasOption('version') then begin
    WriteLn('backup version 1.0');
    Halt;
  end;

  if HasOption('c', 'count') then begin
    FileCount := StrToInt(GetOptionValue('c', 'count'));
  end;

  if HasOption('b', 'base') then begin
    ExponentBase := StrToFloat(GetOptionValue('b', 'base'));
    if ExponentBase < 1 then begin
      ShowException(Exception.Create('Základ mocniny musí bÃœt větší neÅŸ 1.'));
      Halt;
    end;
  end;

  if HasOption('f', 'file') then begin
    BackupFileName := GetOptionValue('f', 'file');
  end;

  if HasOption('e', 'file-extension') then begin
    BackupFileExtension := GetOptionValue('e', 'file-extension');
  end;

  if HasOption('t', 'table') then begin
    PrintStatTable;
    Halt;
  end;

  if HasOption('v', 'verbose') then begin
    Verbose := True;
  end;
end;

procedure TBackup.PrintStatTable;
var
  I: Integer;
  Period: Int64;
  PeriodSum: Int64;
begin
  PeriodSum := 0;
  WriteLn('Pořadové číslo   Perioda   Interval staří');
  for I := 0 to FileCount - 1 do begin
    Period := Trunc(Power(ExponentBase, I));
    PeriodSum := PeriodSum + Period;
    WriteLn(IntToStr(I + 1) + '   ' + IntToStr(Period) +
      '   ' + IntToStr(PeriodSum - Period + 1) + '-' + IntToStr(PeriodSum));
  end;
end;

var
  Application: TBackup;

{$IFDEF WINDOWS}{$R backup.rc}{$ENDIF}

{$R *.res}

begin
  Application:=TBackup.Create(nil);
  Application.Run;
  Application.Free;
end.