libraryaccesstester.pas

unit libraryaccesstester;

{$I videlibrilanguageconfig.inc}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, ComCtrls, Spin, Menus, TreeListView,
  libraryParser;

type

  { TlibraryTesterForm }

  TlibraryTesterForm = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    ComboBox1: TComboBox;
    Edit1: TEdit;
    Edit2: TEdit;
    editSearchProp: TEdit;
    editTitle: TEdit;
    EditAutor: TEdit;
    EditUser: TEdit;
    editPass: TEdit;
    filter: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    ListBox1: TListBox;
    Memo1: TMemo;
    MenuItem1: TMenuItem;
    PageControl1: TPageControl;
    Panel1: TPanel;
    Panel2: TPanel;
    PopupMenu1: TPopupMenu;
    SpinEdit1: TSpinEdit;
    SpinEdit2: TSpinEdit;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TreeListView1: TTreeListView;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
    procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
    procedure FormCreate(Sender: TObject);
    procedure MenuItem1Click(Sender: TObject);
    procedure TreeListView1CustomRecordItemDraw(sender: TObject; eventTyp_cdet: TCustomDrawEventTyp; recordItem: TTreeListRecordItem;
      var defaultDraw: Boolean);
    procedure TreeListView1Select(sender: TObject; item: TTreeListItem);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  libraryTesterForm: TlibraryTesterForm;

implementation

uses booklistreader, applicationconfig, internetaccess, bbutils, Clipbrd, librarySearcher,math, simplehtmltreeparser,strutils, xquery.internals.common,commoninterface, xquery;
{ TlibraryTesterForm }


procedure testISBN;
const testTo10: array[1..6] of string = (
  '978-3-462-04567-3', '3-462-04567-9', '3462045679',
  '978342104810X', '342104810X', '342104810X'
);
const testTo13: array[1..6] of string = (
  '346204567X', '978-3462045673', '9783462045673', //'978-3-462-04567-3'
  '0-13-085198-1', '978-0-13-085198-7', '9780130851987'
);
var
  i: Integer;
  temp: tbook;
begin
  i := 1;
  temp := tbook.create;
  while i <= high(testTo10) do begin
    temp.isbn := testTo10[i];
    if  temp.getNormalizedISBN(false, 10) <> testTo10[i+1] then
      raise Exception.Create('Failed: '+temp.isbn + ': ' + temp.getNormalizedISBN(false, 10) +'<>' +testTo10[i+1]);
    if  temp.getNormalizedISBN(true, 10) <> testTo10[i+2] then
      raise Exception.Create('Failed: '+temp.isbn + ': ' + temp.getNormalizedISBN(true, 10) +'<>' +testTo10[i+2]);
    i += 3;
  end;
  i := 1;
  while i <= high(testTo13) do begin
    temp.isbn := testTo13[i];
    if  temp.getNormalizedISBN(false, 13) <> testTo13[i+1] then
      raise Exception.Create('Failed: '+temp.isbn + ': ' + temp.getNormalizedISBN(false, 13) +'<>' +testTo13[i+1]);
    if  temp.getNormalizedISBN(true, 13) <> testTo13[i+2] then
      raise Exception.Create('Failed: '+temp.isbn + ': ' + temp.getNormalizedISBN(true, 13) +'<>' +testTo13[i+2]);
    i += 3;
  end;
  temp.free;
end;

var activeThreads, pendingThreads: integer;
const pendingLimit: integer = 50;
type

{ TTemplateAccountAccessTester }

 TTemplateAccountAccessTester = class(TTemplateAccountAccess)
  procedure init(apath, userID: string); override;
end;

 type TTestData = class
  lib: TLibrary;
  constructor create(thelib: TLibrary);
end;
type TTestThread = class(TThread)
  lib: TLibrary;
  row: TTreeListItem;
  fakeUser, fakePwd: string;
  title,author,moreSearchProp: string;
  resultSearch, resultAccount, resultHomepage: string;
  search, account, homepage: boolean;
  searchCount: integer;

  pending: boolean;
  constructor Create(arow: TTreeListItem; dosearch, doaccount, dohomepage: boolean; asearchCount: integer; atitle,anauthor,asearchprop, afakeUser, afakePwd: string);
  procedure Execute; override;
  procedure showResult;
  procedure checkPending;
end;

{ TTemplateAccountAccessTester }

procedure TTemplateAccountAccessTester.init(apath, userID: string);
begin
  self.path:='/tmp';
  self.user:=userID;
  ;
  DeleteFile('/tmp/test.history');
  DeleteFile('/tmp/test.current');
  fbooks:=TBookLists.create(self,'/tmp/test.history','/tmp/test.current');
  reader.books:=fbooks.currentUpdate;
end;

procedure TlibraryTesterForm.Button1Click(Sender: TObject);
var t: TTemplateAccountAccessTester;
  lib: TLibrary;
  i: Integer;
  internet: TInternetAccess;
begin
  internet := createVideLibriInternetAccess;
  lib := libraryManager[ListBox1.ItemIndex];
  if lib = nil then exit;
  t := TTemplateAccountAccessTester.create(lib);
  memo1.Lines.Clear;
  if (ComboBox1.ItemIndex > 0) <> lib.segregatedAccounts then memo1.lines.add('segregation mismatch');
  t.init('', edit1.text);
  t.passWord:=edit2.Text;
  t.accountType:=ComboBox1.ItemIndex;
  try
    t.connect(internet);
    t.updateAll;
    for i := 0 to t.books.currentUpdate.Count-1do
      memo1.Lines.Add(t.books.currentUpdate[i].toLimitString());
  finally
    t.free;

  end;
end;

procedure TlibraryTesterForm.Button2Click(Sender: TObject);
var
  Message: String;
begin
  while ListBox1.ItemIndex < ListBox1.Items.Count - 1 do begin
    if libraryManager[ListBox1.ItemIndex] <> nil then
    if  (filter.Text = '') or (pos(filter.Text, libraryManager[ListBox1.ItemIndex].template.name) > 0) then begin
      try
        button1.Click;
        Message := 'PASS!';
      except
        on e: EBookListReader do begin
          message := e.Message;;
        end;
      end;
      memo1.Lines.Add(ListBox1.Items[ListBox1.ItemIndex] +': '+ trim(Message));
      Application.ProcessMessages;
    end;
    ListBox1.ItemIndex:=ListBox1.ItemIndex+1;
  end;
end;

procedure TlibraryTesterForm.Button3Click(Sender: TObject);
var
  i: Integer;
begin
  memo1.Lines.Clear;
  for i := 0 to libraryManager.count - 1 do
    if libraryManager[i] <> nil then
      Memo1.Lines.Add(libraryManager[i].id+':§: '+libraryManager[i].prettyNameShort+':§: '+libraryManager[i].catalogUrl);
end;

procedure TlibraryTesterForm.Button4Click(Sender: TObject);
var
  i: Integer;
begin
  pendingLimit := SpinEdit2.Value;
  for i := 0 to TreeListView1.Items.Count - 1 do
    if CheckBox1.Checked or TreeListView1.Items[i].Selected then
      TTestThread.Create(TreeListView1.Items[i],CheckBox2.Checked,CheckBox3.Checked, CheckBox4.Checked, SpinEdit1.Value,
                         editTitle.Text, EditAutor.Text, editSearchProp.Text,
                         EditUser.Text,editPass.text);
  Caption := 'Active Threads: ' + IntToStr(activeThreads) + ' Pending Threads: ' + IntToStr(pendingThreads);
end;

procedure TlibraryTesterForm.Button5Click(Sender: TObject);
var
  i: Integer;
  tocp: String;
begin
  tocp := '';
  for i := 0 to TreeListView1.Items.Count - 1 do
    if  CheckBox1.Checked or TreeListView1.Items[i].Selected then
      tocp += TTestData(TreeListView1.Items[i].data.obj).lib.id +'.xml' + LineEnding +TreeListView1.Items[i].RecordItemsText[1] + LineEnding
              + TTestData(TreeListView1.Items[i].data.obj).lib.catalogUrl + LineEnding
              + TreeListView1.Items[i].RecordItemsText[2] +LineEnding+TreeListView1.Items[i].RecordItemsText[3] + LineEnding+TreeListView1.Items[i].RecordItemsText[4]
              + LineEnding+LineEnding+ LineEnding+LineEnding;
  Clipboard.AsText := tocp;
end;

procedure TlibraryTesterForm.Button6Click(Sender: TObject);
const testingRecords: string = '/home/benito/hg/programs/internet/VideLibri/_meta/testingrecords/';
var   buffer, searchres: string;
      builder: TStrBuilder;
      d: RawByteString;
      i: Integer;
      sysname: string;
  procedure appendAttribute(const name, value: string);
  begin
    builder.append(' ');
    builder.append(name);
    builder.append('="');
    builder.append(xmlStrEscape(value, true));
    builder.append('"');
  end;

begin
  builder.init(@buffer);
  d := dateTimeFormat('yyyy-mm-dd', currentDate);
  builder.append('<?xml version="1.0" encoding="UTF-8"?>'); builder.append(LineEnding);
  builder.append('<tests'); appendAttribute('date', d); builder.append('>'); builder.append(LineEnding);
  for i := 0 to TreeListView1.Items.Count - 1 do
     if  CheckBox1.Checked or TreeListView1.Items[i].Selected then begin
       searchres := TreeListView1.Items[i].RecordItemsText[2];
       if searchres = '' then continue;
       if strBeginsWith(searchres, '1-') then continue; //unclear
       if strBeginsWith(searchres, '2-EInternetException: Internet Error: -4') then
         continue;//that is not a bug, but a unreachable server (timeout, openssl cert mismatch)
       builder.append('  <test');
       appendAttribute('date', d);
       appendAttribute('id', (TreeListView1.Items[i].data.obj as TTestData).lib.id);
       appendAttribute('search', ifthen(strBeginsWith(searchres, '2-'),'no','yes'));
       sysname := (TreeListView1.Items[i].data.obj as TTestData).lib.template.name;
       if strContains(sysname, '|') then begin
         sysname := strJoin(stableSort(strSplit(sysname, '|')), ' ');
       end;
       appendAttribute('system', sysname);
      builder.append('/>'); builder.append(LineEnding);
     end;
  builder.append('</tests>');
  builder.final;
  ForceDirectories(testingRecords);
  strSaveToFile(testingRecords + 'tests.' + d+'T'+dateTimeFormat('hhnnss', Time)+'.xml', buffer);
end;

procedure TlibraryTesterForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  CloseAction:=caFree;
end;

procedure TlibraryTesterForm.FormCloseQuery(Sender: TObject; var CanClose: boolean);
begin

end;



procedure TlibraryTesterForm.FormCreate(Sender: TObject);
var
  i: Integer;
  lib: TLibrary;
begin
  testISBN;
  TreeListView1.BeginUpdate;
  for i := 0 to libraryManager.count - 1 do begin
    lib := libraryManager[i];
    if lib = nil then continue;
    ListBox1.Items.Add(lib.prettyName);
    TreeListView1.Items.Add([lib.prettyCountryState, lib.prettyName]).data.obj := TTestData.create(lib);
    TreeListView1.Items[TreeListView1.Items.Count-1].RecordItemsText[5] := lib.template.name;
  end;
  TreeListView1.EndUpdate;
  TreeListView1.RowHeight := TreeListView1.RowHeight + 5;
  TreeListView1.UpdateScrollSize;
end;

procedure TlibraryTesterForm.MenuItem1Click(Sender: TObject);
var
  i: Integer;
  fn, f: String;
  fview: TStringView;
  h, e: pchar;
begin
  for i := 0 to TreeListView1.Items.Count - 1 do
    if TreeListView1.Items[i].Selected then begin
      fn := 'data/libraries/' + TTestData(TreeListView1.Items[i].data.obj).lib.id+'.xml';
      f := strLoadFromFile(fn);
      //ShowMessage(f);
      fview := f.view;
      h := fview.find('<homepage');
      e := fview.viewRightOf(h).find('/>');
      repeat dec(h) until not (h^ in [' ',#9]);
      if h^ = #10 then dec(h);
      if h^ = #13 then dec(h);
      delete(f, h - pchar(f), e + 3 - h);
      //ShowMessage(f);
      strSaveToFile(fn, f);
    end;
end;

procedure TlibraryTesterForm.TreeListView1CustomRecordItemDraw(sender: TObject; eventTyp_cdet: TCustomDrawEventTyp;
  recordItem: TTreeListRecordItem; var defaultDraw: Boolean);
begin
  if eventTyp_cdet <> cdetPrePaint then exit ;
  if not recordItem.Parent.SeemsSelected then begin
    if strBeginsWith(recordItem.Text, '1-') then begin
      TreeListView1.canvas.Brush.Color := clYellow;
    end else if strBeginsWith(recordItem.Text, '2-') then begin
      TreeListView1.canvas.Brush.Color := clRed;
    end else exit;
    TreeListView1.canvas.Brush.Style := bsSolid;
    TreeListView1.Canvas.FillRect(TreeListView1.DrawingRecordItemRect);
  end;
end;

procedure TlibraryTesterForm.TreeListView1Select(sender: TObject; item: TTreeListItem);
begin
  if item <> nil then
    CheckBox1.Checked := false;
end;


constructor TTestData.create(thelib: TLibrary);
begin
  lib := thelib;
end;

constructor TTestThread.Create(arow: TTreeListItem; dosearch, doaccount, dohomepage: boolean; asearchCount: integer; atitle, anauthor,
  asearchprop, afakeUser, afakePwd: string);
begin
  inherited Create(false);
  row := arow;
  lib := TTestData(arow.data.obj).lib;
  resultSearch := row.RecordItemsText[2];
  resultAccount := row.RecordItemsText[3];
  resultHomepage := row.RecordItemsText[4];
  fakeUser := afakeUser;
  fakePwd := afakePwd;
  resultAccount := '';
  search := dosearch;
  account := doaccount;
  homepage := dohomepage;
  title := atitle;
  author := anauthor;
  moreSearchProp := asearchprop;
  searchCount := asearchCount;

  pending := activeThreads > pendingLimit;
  if pending then inc(pendingThreads)
  else inc(activeThreads);
end;

type EDoNotTestThis = class(Exception);
procedure TTestThread.Execute;
var t: TTemplateAccountAccessTester;
  i, acctype: Integer;
  internet: TInternetAccess = nil;
  searcher: TLibrarySearcher;
  critSection: TRTLCriticalSection;
  tree: TTreeDocument;
  tp: TTreeParser;
  temp: String;
begin
  while pending do begin
    sleep(500);
    ReadBarrier;
    if activeThreads < pendingLimit then //sychronize is heavy. if we synchronize all the ckecking, the active thread cannot use synchronize to quit
      Synchronize(@checkPending);
  end;
  if account then begin
    try
      if lib.testingAccount in [tiBroken, tiNo] then raise EDoNotTestThis.Create('');
      resultAccount := '';
      for acctype := 1 to ifthen(lib.segregatedAccounts, 2, 1) do begin
        internet := createVideLibriInternetAccess;
        t := TTemplateAccountAccessTester.create(lib);
        t.init('', fakeUser);
        t.accountType:=acctype;
        t.passWord:=fakePwd;


        try
          t.connect(internet);
          t.updateAll;
          for i := 0 to t.books.currentUpdate.Count-1do
            resultAccount += t.books.currentUpdate[i].toLimitString();
        except
          on e: ELoginException do
            resultAccount += '0-'+e.ClassName +': '+ e.Message + ' '+resultAccount;
          on e: EBookListReader do
            resultAccount += '1-'+e.ClassName +': '+ e.Message + ' '+resultAccount;
          on e: Exception do
            resultAccount += '2-' + e.ClassName +': '+ e.Message + ' '+resultAccount;
        end;

        t.free;
      end;
    except
      on e: EDoNotTestThis do resultAccount := '0b-known broken';
      on e: exception do resultAccount := '2-UNHANDLED EXCEPTION: '+e.Message;
    end;
  end;
  if search then begin
    try
      if lib.testingSearch in [tiBroken, tiNo] then raise EDoNotTestThis.Create('');
      InitCriticalSection(critSection);
      searcher := TLibrarySearcher.create(lib.template);
      Searcher.bookListReader.bookAccessSection:=@critSection;
      searcher.addLibrary(lib);

      try
        searcher.SearchOptions.title := title;
        searcher.SearchOptions.author := author;
        if moreSearchProp <> '' then begin
          searcher.SearchOptions.setProperty(strBefore(moreSearchProp, '='), strAfter(moreSearchProp, '=') );
        end;
        searcher.connect;
        searcher.search;
        if searcher.SearchNextPageAvailable then
          searcher.searchNext;
        resultSearch := inttostr(searcher.SearchResult.Count) + '/'+ inttostr(searcher.SearchResultCount) +': ';
        for i := 0 to min(searchCount, searcher.SearchResult.Count - 1) do begin
          searcher.details(searcher.SearchResult[i]);
          if i <> 0 then resultSearch += ', ';
          resultSearch += searcher.SearchResult[i].toSimpleString();
        end;
        if searcher.SearchResultCount = 0 then resultSearch := '1-' + resultSearch;
      except
        on e: EBookListReader do resultSearch := '1-'+e.ClassName +': '+ e.Message;
        on e: Exception do       resultSearch := '2-' + e.ClassName +': '+ e.Message;
      end;
      searcher.free;
      DoneCriticalsection(critSection);
    except
      on e: EDoNotTestThis do  resultSearch := '0b-known broken';
      on e: exception do
        resultSearch := '2-UNHANDLED EXCEPTION: '+e.Message;
    end;
  end;
  if (homepage) and (lib.fhomepageUrl <> '') then begin
    try
      tp := TTreeParser.Create;
      tp.parsingModel := pmHTML;
      internet := createVideLibriInternetAccess;  //need new internet. above on is freed by the account class
      temp := internet.get(lib.fhomepageUrl);
      tree := tp.parseTree(temp, lib.fhomepageUrl, internet.getLastContentType);
      resultHomepage := 'ok ' + tree.findNext(tetOpen, 'title', []).innerHTML();
      tp.free;
    except
      on e: EInternetException do
        resultHomepage := '2- '+ e.Message + ' '+e.details;
    end
  end;
  Synchronize(@showResult);
  freeThreadVars;
end;

procedure TTestThread.showResult;
begin
  if search then
    row.RecordItemsText[2] := resultSearch;
  if account then
    row.RecordItemsText[3] := resultAccount;
  if homepage then
    row.RecordItemsText[4] := resultHomepage;
  dec(activeThreads);
  (row.TreeListView.Owner as tform).Caption := 'Active Threads: ' + IntToStr(activeThreads) + ' Pending Threads: ' + IntToStr(pendingThreads);
end;

procedure TTestThread.checkPending;
begin
  if activeThreads < pendingLimit then begin
    dec(pendingThreads);
    inc(activeThreads);
    pending := false;
    (row.TreeListView.Owner as tform).Caption := 'Active Threads: ' + IntToStr(activeThreads) + ' Pending Threads: ' + IntToStr(pendingThreads);
  end;
end;

initialization
  {$I libraryaccesstester.lrs}

end.