← Back to branch summary

~ubuntu-branches/ubuntu/saucy/lazarus/saucy

« back to all changes in this revision

Viewing changes to components/wiki/wikiget.lpr

  • Committer: Package Import Robot
  • Author(s): Paul Gevers, Abou Al Montacir, Bart Martens, Paul Gevers
  • Date: 2013-06-08 14:12:17 UTC
  • mfrom: (1.1.9)
  • Revision ID: package-import@ubuntu.com-20130608141217-7k0cy9id8ifcnutc
Tags: 1.0.8+dfsg-1
http://bugs.debian.org/708695
[ Abou Al Montacir ]
* New upstream major release and multiple maintenace release offering many
  fixes and new features marking a new milestone for the Lazarus development
  and its stability level.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_fixes_branch
* LCL changes:
  - LCL is now a normal package.
      + Platform independent parts of the LCL are now in the package LCLBase
      + LCL is automatically recompiled when switching the target platform,
        unless pre-compiled binaries for this target are already installed.
      + No impact on existing projects.
      + Linker options needed by LCL are no more added to projects that do
        not use the LCL package.
  - Minor changes in LCL basic classes behaviour
      + TCustomForm.Create raises an exception if a form resource is not
        found.
      + TNotebook and TPage: a new implementation of these classes was added.
      + TDBNavigator: It is now possible to have focusable buttons by setting
        Options = [navFocusableButtons] and TabStop = True, useful for
        accessibility and for devices with neither mouse nor touch screen.
      + Names of TControlBorderSpacing.GetSideSpace and GetSpace were swapped
        and are now consistent. GetSideSpace = Around + GetSpace.
      + TForm.WindowState=wsFullscreen was added
      + TCanvas.TextFitInfo was added to calculate how many characters will
        fit into a specified Width. Useful for word-wrapping calculations.
      + TControl.GetColorResolvingParent and
        TControl.GetRGBColorResolvingParent were added, simplifying the work
        to obtain the final color of the control while resolving clDefault
        and the ParentColor.
      + LCLIntf.GetTextExtentExPoint now has a good default implementation
        which works in any platform not providing a specific implementation.
        However, Widgetset specific implementation is better, when available.
      + TTabControl was reorganized. Now it has the correct class hierarchy
        and inherits from TCustomTabControl as it should.
  - New unit in the LCL:
      + lazdialogs.pas: adds non-native versions of various native dialogs,
        for example TLazOpenDialog, TLazSaveDialog, TLazSelectDirectoryDialog.
        It is used by widgetsets which either do not have a native dialog, or
        do not wish to use it because it is limited. These dialogs can also be
        used by user applications directly.
      + lazdeviceapis.pas: offers an interface to more hardware devices such
        as the accelerometer, GPS, etc. See LazDeviceAPIs
      + lazcanvas.pas: provides a TFPImageCanvas descendent implementing
        drawing in a LCL-compatible way, but 100% in Pascal.
      + lazregions.pas. LazRegions is a wholly Pascal implementation of
        regions for canvas clipping, event clipping, finding in which control
        of a region tree one an event should reach, for drawing polygons, etc.
      + customdrawncontrols.pas, customdrawndrawers.pas,
        customdrawn_common.pas, customdrawn_android.pas and
        customdrawn_winxp.pas: are the Lazarus Custom Drawn Controls -controls
        which imitate the standard LCL ones, but with the difference that they
        are non-native and support skinning.
  - New APIs added to the LCL to improve support of accessibility software
    such as screen readers.
* IDE changes:
  - Many improvments.
  - The detailed list of changes can be found here:
    http://wiki.lazarus.freepascal.org/New_IDE_features_since#v1.0_.282012-08-29.29
    http://wiki.lazarus.freepascal.org/Lazarus_1.0_release_notes#IDE_Changes
* Debugger / Editor changes:
  - Added pascal sources and breakpoints to the disassembler
  - Added threads dialog.
* Components changes:
  - TAChart: many fixes and new features
  - CodeTool: support Delphi style generics and new syntax extensions.
  - AggPas: removed to honor free licencing. (Closes: Bug#708695)
[Bart Martens]
* New debian/watch file fixing issues with upstream RC release.
[Abou Al Montacir]
* Avoid changing files in .pc hidden directory, these are used by quilt for
  internal purpose and could lead to surprises during build.
[Paul Gevers]
* Updated get-orig-source target and it compinion script orig-tar.sh so that they
  repack the source file, allowing bug 708695 to be fixed.

Show diffs side-by-side

added added

removed removed

Lines of Context:
components/wiki/wikiget.lpr
 
1
{ Console utility to download the Lazarus wiki.
 
2
  Maybe it also works for other MediaWikis sites.
 
3
 
 
4
  Copyright (C) 2012  Mattias Gaertner  mattias@freepascal.org
 
5
 
 
6
  This source is free software; you can redistribute it and/or modify it under
 
7
  the terms of the GNU General Public License as published by the Free
 
8
  Software Foundation; either version 2 of the License, or (at your option)
 
9
  any later version.
 
10
 
 
11
  This code is distributed in the hope that it will be useful, but WITHOUT ANY
 
12
  WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
 
13
  FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
 
14
  details.
 
15
 
 
16
  A copy of the GNU General Public License is available on the World Wide Web
 
17
  at <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing
 
18
  to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
 
19
  MA 02111-1307, USA.
 
20
 
 
21
ToDo:
 
22
  - get more than 500 changes
 
23
}
 
24
program wikiget;
 
25
 
 
26
{$mode objfpc}{$H+}
 
27
 
 
28
uses
 
29
  {$IFDEF UNIX}
 
30
  cthreads,
 
31
  {$ENDIF}
 
32
  Classes, SysUtils, LazFileUtils, laz2_XMLRead, laz2_DOM, laz2_XMLWrite,
 
33
  LazUTF8, LazLogger, CodeToolsStructs, CustApp, AVL_Tree,
 
34
  {$IF FPC_FULLVERSION<20701}
 
35
  myfphttpclient,
 
36
  {$ELSE}
 
37
  fphttpclient, HTTPDefs,
 
38
  {$ENDIF}
 
39
  WikiParser, WikiFormat;
 
40
 
 
41
const
 
42
  IgnorePrefixes: array[1..12] of string = (
 
43
    'Special:',
 
44
    'Help:',
 
45
    'Random:',
 
46
    'User:',
 
47
    'http:',
 
48
    'https:',
 
49
    'doc:',
 
50
    'Category:',
 
51
    'User:',
 
52
    'User_talk:',
 
53
    'Lazarus_wiki:',
 
54
    'index.php'
 
55
    );
 
56
type
 
57
 
 
58
  { TFetchWikiPage }
 
59
 
 
60
  TFetchWikiPage = class(TWikiPage)
 
61
  public
 
62
    PageName: string;
 
63
  end;
 
64
 
 
65
  { TWikiGet }
 
66
 
 
67
  TWikiGet = class(TCustomApplication)
 
68
  private
 
69
    FBaseURL: string;
 
70
    FFirstPage: string;
 
71
    FIgnoreFilesYoungerThanMin: integer;
 
72
    FImagesDir: string;
 
73
    FNoWrite: boolean;
 
74
    FOutputDir: string;
 
75
    FNeededPages: TStringToPointerTree; // PageName to TFetchWikiPage
 
76
    FAllPages: TStringToPointerTree; // PageName to TFetchWikiPage
 
77
    FAllImages: TStringToStringTree; // image name to filename
 
78
  protected
 
79
    procedure DoRun; override;
 
80
    procedure GetAll(Version: integer = 2; SaveTOC: boolean = false);
 
81
    procedure GetRecent(Days: integer; Version: integer = 2);
 
82
    procedure DownloadPage(Page: string);
 
83
    procedure DownloadFirstNeededPage;
 
84
    procedure CheckNotUsedPages(Show, Delete: boolean);
 
85
    procedure DownloadImages;
 
86
    procedure DownloadPageImages(Page: string);
 
87
    procedure OnParseForImages(Token: TWPToken);
 
88
    procedure CheckNotUsedImages(Show, Delete: boolean);
 
89
    function LoadPageFromDisk(Page: string): TFetchWikiPage;
 
90
    function AddWikiPage(Page: string): TFetchWikiPage;
 
91
    function NeedWikiPage(Page: string): TFetchWikiPage;
 
92
    function PageToFilename(Page: string; IsInternalLink: boolean): string;
 
93
    function ImageToFilename(Image: string; IsInternalLink, KeepScheme: boolean): string;
 
94
    function EscapeDocumentName(aName: string): string;
 
95
    function IsIgnoredPage(Page: string): boolean;
 
96
    procedure Test;
 
97
  public
 
98
    constructor Create(TheOwner: TComponent); override;
 
99
    destructor Destroy; override;
 
100
    procedure WriteHelp; virtual;
 
101
    property OutputDir: string read FOutputDir;
 
102
    property ImagesDir: string read FImagesDir;
 
103
    property BaseURL: string read FBaseURL;
 
104
    property NoWrite: boolean read FNoWrite;
 
105
    property IgnoreFilesYoungerThanMin: integer read FIgnoreFilesYoungerThanMin;
 
106
  end;
 
107
 
 
108
{ TWikiGet }
 
109
 
 
110
procedure TWikiGet.DoRun;
 
111
const
 
112
  pPage = '--page=';
 
113
 
 
114
  procedure E(Msg: string; DoWriteHelp: boolean = false);
 
115
  begin
 
116
    if Msg<>'' then begin
 
117
      writeln('ERROR: ',Msg);
 
118
      writeln;
 
119
    end;
 
120
    if DoWriteHelp then
 
121
      WriteHelp;
 
122
    Terminate;
 
123
    Halt;
 
124
  end;
 
125
 
 
126
var
 
127
  ErrorMsg: String;
 
128
  i: Integer;
 
129
  Param: String;
 
130
  NeedSinglePage: Boolean;
 
131
  RecentDays: Integer;
 
132
begin
 
133
  //Test;
 
134
  // quick check parameters
 
135
  ErrorMsg:=CheckOptions('h','help dir: images: baseurl: page: allmissing recent: ignore-recent: nowrite'
 
136
    +' shownotusedpages deletenotusedpages'
 
137
    +' shownotusedimages deletenotusedimages');
 
138
  if ErrorMsg<>'' then
 
139
    E(ErrorMsg,true);
 
140
 
 
141
  // parse parameters
 
142
  if HasOption('h','help') then
 
143
    E('',true);
 
144
 
 
145
  FNoWrite:=HasOption('nowrite');
 
146
 
 
147
  if HasOption('dir') then begin
 
148
    fOutputDir:=GetOptionValue('dir');
 
149
    if fOutputDir='' then
 
150
      E('output directory missing',true);
 
151
  end;
 
152
  fOutputDir:=CleanAndExpandDirectory(OutputDir);
 
153
 
 
154
  if HasOption('images') then begin
 
155
    FImagesDir:=GetOptionValue('images');
 
156
    if FImagesDir='' then
 
157
      E('images directory missing',true);
 
158
  end;
 
159
  FImagesDir:=CleanAndExpandDirectory(ImagesDir);
 
160
 
 
161
  if HasOption('baseurl') then
 
162
    FBaseURL:=GetOptionValue('baseurl');
 
163
  if HasOption('page') then
 
164
    fFirstPage:=GetOptionValue('page');
 
165
 
 
166
  // check parameters
 
167
  if not DirectoryExistsUTF8(OutputDir) then
 
168
    E('output directory not found "'+OutputDir+'"');
 
169
  if not DirectoryExistsUTF8(ImagesDir) then
 
170
    E('images directory not found "'+ImagesDir+'"');
 
171
  if copy(BaseURL,1,7)<>'http://' then
 
172
    E('invalid baseurl "'+BaseURL+'"');
 
173
 
 
174
  if HasOption('ignore-recent') then begin
 
175
    fIgnoreFilesYoungerThanMin:=StrToIntDef(GetOptionValue('ignore-recent'),-1);
 
176
    if IgnoreFilesYoungerThanMin<0 then
 
177
      E('invalid --ignore-recent value "'+GetOptionValue('ignore-recent')+'"');
 
178
  end;
 
179
 
 
180
  NeedSinglePage:=true;
 
181
  if HasOption('allmissing') or HasOption('recent') then begin
 
182
    NeedSinglePage:=false;
 
183
    RecentDays:=-1;
 
184
    if HasOption('recent') then begin
 
185
      RecentDays:=StrToIntDef(GetOptionValue('recent'),-1);
 
186
      if RecentDays<1 then
 
187
        E('invalid --recent value "'+GetOptionValue('recent')+'"');
 
188
    end;
 
189
    GetAll(2);
 
190
    if RecentDays>0 then
 
191
      GetRecent(RecentDays);
 
192
  end;
 
193
  for i:=1 to GetParamCount do begin
 
194
    Param:=GetParams(i);
 
195
    //writeln('TWikiGet.DoRun Param="',Param,'"');
 
196
    if copy(Param,1,length(pPage))=pPage then
 
197
      NeedWikiPage(WikiInternalLinkToPage(copy(Param,length(pPage)+1,length(Param))));
 
198
  end;
 
199
  if (NeedSinglePage) and (FNeededPages.Tree.Count=0) then
 
200
    E('nothing to do',true);
 
201
 
 
202
  while FNeededPages.Tree.Count>0 do
 
203
    DownloadFirstNeededPage;
 
204
 
 
205
  DownloadImages;
 
206
 
 
207
  CheckNotUsedPages(HasOption('shownotusedpages'),HasOption('deletenotusedpages'));
 
208
  CheckNotUsedImages(HasOption('shownotusedimages'),HasOption('deletenotusedimages'));
 
209
 
 
210
  // stop program loop
 
211
  Terminate;
 
212
end;
 
213
 
 
214
procedure TWikiGet.GetAll(Version: integer; SaveTOC: boolean);
 
215
var
 
216
  Client: TFPHTTPClient;
 
217
  Response: TMemoryStream;
 
218
  URL: String;
 
219
  Filename: String;
 
220
  s: string;
 
221
  p: SizeInt;
 
222
  StartPos: SizeInt;
 
223
  URLs: TStringList;
 
224
  i: Integer;
 
225
  Page: String;
 
226
begin
 
227
  Client:=nil;
 
228
  URLs:=TStringList.Create;
 
229
  try
 
230
    Client:=TFPHTTPClient.Create(nil);
 
231
    Response:=TMemoryStream.Create;
 
232
    // get list of range pages
 
233
    //URL:=BaseURL+'index.php?title=Special:AllPages&action=submit&namespace=0&from=';
 
234
    if Version=1 then
 
235
      URL:=BaseURL+'index.php?title=Special:Allpages'
 
236
    else
 
237
      URL:=BaseURL+'index.php?title=Special:AllPages';
 
238
    writeln('getting page "',URL,'" ...');
 
239
    Client.Get(URL,Response);
 
240
    //Client.ResponseHeaders.SaveToFile('responseheaders.txt');
 
241
    debugln(['TWikiGet.GetAll ',SaveTOC]);
 
242
    if Response.Size>0 then begin
 
243
      if SaveTOC then begin
 
244
        Response.Position:=0;
 
245
        Filename:='all.html';
 
246
        writeln('saving page "',Filename,'" ...');
 
247
        if not NoWrite then
 
248
          Response.SaveToFile(Filename);
 
249
      end;
 
250
      Response.Position:=0;
 
251
      SetLength(s,Response.Size);
 
252
      Response.Read(s[1],length(s));
 
253
      repeat
 
254
        if Version=1 then
 
255
          p:=Pos('<a href="/Special:Allpages/',s)
 
256
        else
 
257
          p:=Pos('<a href="/index.php?title=Special:AllPages&amp;from=',s);
 
258
        if p<1 then break;
 
259
        inc(p,length('<a href="'));
 
260
        StartPos:=p;
 
261
        while (p<=length(s)) and (s[p]<>'"') do inc(p);
 
262
        URL:=XMLValueToStr(copy(s,StartPos,p-StartPos));
 
263
        if (URL<>'') and (URLs.IndexOf(URL)<0) then begin;
 
264
          writeln('TWikiGet.GetAll URL="',URL,'"');
 
265
          URLs.Add(URL);
 
266
        end;
 
267
        System.Delete(s,1,p);
 
268
      until false;
 
269
    end;
 
270
 
 
271
    // get all range pages
 
272
    for i:=0 to URLs.Count-1 do begin
 
273
      URL:=EscapeDocumentName(URLs[i]);
 
274
      URL:=BaseURL+URL;
 
275
      Response.Clear;
 
276
      writeln('getting page "',URL,'" ...');
 
277
      Client.Get(URL,Response);
 
278
      //Client.ResponseHeaders.SaveToFile('responseheaders.txt');
 
279
      if SaveTOC then begin
 
280
        Response.Position:=0;
 
281
        Filename:='all_'+IntToStr(i+1)+'.html';
 
282
        writeln('saving page "',Filename,'" ...');
 
283
        if not NoWrite then
 
284
          Response.SaveToFile(Filename);
 
285
      end;
 
286
      if Response.Size>0 then begin
 
287
        Response.Position:=0;
 
288
        SetLength(s,Response.Size);
 
289
        Response.Read(s[1],length(s));
 
290
        repeat
 
291
          p:=Pos('<a href="/',s);
 
292
          if p<1 then break;
 
293
          inc(p,length('<a href="'));
 
294
          StartPos:=p;
 
295
          while (p<=length(s)) and (s[p]<>'"') do inc(p);
 
296
          Page:=copy(s,StartPos,p-StartPos);
 
297
          while (Page<>'') and (Page[1]='/') do
 
298
            System.Delete(Page,1,1);
 
299
          if (Page<>'') and (not IsIgnoredPage(Page)) then begin;
 
300
            //writeln('TWikiGet.GetAll Page="',Page,'"');
 
301
            Filename:=PageToFilename(Page,false);
 
302
            AddWikiPage(Page);
 
303
            if not FileExistsUTF8(Filename) then begin
 
304
              writeln('TWikiGet.GetAll missing Page="',Page,'"');
 
305
              NeedWikiPage(Page);
 
306
            end;
 
307
          end;
 
308
          System.Delete(s,1,p);
 
309
        until false;
 
310
      end;
 
311
    end;
 
312
  finally
 
313
    URLs.Free;
 
314
    Client.Free;
 
315
    Response.Free;
 
316
  end;
 
317
end;
 
318
 
 
319
procedure TWikiGet.GetRecent(Days: integer; Version: integer);
 
320
const
 
321
  linksstart = '<a href="/index.php?title=';
 
322
var
 
323
  Client: TFPHTTPClient;
 
324
  Response: TMemoryStream;
 
325
  URL: String;
 
326
  s: string;
 
327
  Page: String;
 
328
  href: String;
 
329
  p: SizeInt;
 
330
  Filename: String;
 
331
  NowDate: LongInt;
 
332
  AgeInMin: Integer;
 
333
  CheckedPages: TStringToStringTree;
 
334
begin
 
335
  //writeln('TWikiGet.GetRecent Days=',Days);
 
336
  Client:=nil;
 
337
  CheckedPages:=TStringToStringTree.Create(true);
 
338
  try
 
339
    Client:=TFPHTTPClient.Create(nil);
 
340
    Response:=TMemoryStream.Create;
 
341
    if Version=1 then
 
342
      URL:=BaseURL+'index.php?title=Special:Recentchanges&days='+IntToStr(Days)+'&limit=500'
 
343
    else
 
344
      URL:=BaseURL+'index.php?title=Special:RecentChanges&days='+IntToStr(Days)+'&limit=500';
 
345
    writeln('getting page "',URL,'" ...');
 
346
    Client.Get(URL,Response);
 
347
    //Client.ResponseHeaders.SaveToFile('responseheaders.txt');
 
348
    //Response.SaveToFile('test.html');
 
349
    NowDate:=DateTimeToFileDate(Now);
 
350
    if Response.Size>0 then begin
 
351
      SetLength(s,Response.Size);
 
352
      Response.Position:=0;
 
353
      Response.Read(s[1],length(s));
 
354
      repeat
 
355
        // find next a href tag
 
356
        p:=Pos(linksstart,s);
 
357
        if p<1 then break;
 
358
        Delete(s,1,p+length(linksstart)-1);
 
359
        // get href attribute
 
360
        p:=1;
 
361
        while (p<=length(s)) and (not (s[p] in ['"'])) do inc(p);
 
362
        if p>length(s) then break;
 
363
        href:=LeftStr(s,p-1);
 
364
        //writeln('TWikiGet.GetRecent href="'+href+'"');
 
365
        Delete(s,1,p);
 
366
        if Pos('&amp;diff=',href)<1 then begin
 
367
          // this is not a change
 
368
          continue;
 
369
        end;
 
370
        // a change
 
371
        Page:=LeftStr(href,Pos('&',href)-1);
 
372
        //writeln('TWikiGet.GetRecent page="'+Page+'"');
 
373
        if not (FAllPages.Contains(Page)) then
 
374
          continue; // deleted in the mean time
 
375
        if CheckedPages.Contains(Page) then continue;
 
376
        if IsIgnoredPage(Page) then continue;
 
377
        if FNeededPages.Contains(Page) then continue;
 
378
        CheckedPages[Page]:='1';
 
379
        Filename:=PageToFilename(Page,false);
 
380
        //writeln('TWikiGet.GetRecent recent diff page="'+Page+'" File="',Filename,'"');
 
381
        if FileExistsUTF8(Filename) then begin
 
382
          AgeInMin:=(NowDate-FileAgeUTF8(Filename)) div 60;
 
383
          //writeln('TWikiGet.GetRecent FileAge=',AgeInMin,' Ignore=',IgnoreFilesYoungerThanMin,' File="',Filename,'"');
 
384
          if AgeInMin<IgnoreFilesYoungerThanMin then continue;
 
385
        end;
 
386
        writeln('  recently changed: "',Page,'" File="',Filename,'"');
 
387
        NeedWikiPage(Page);
 
388
      until false;
 
389
    end;
 
390
 
 
391
  finally
 
392
    CheckedPages.Free;
 
393
    Client.Free;
 
394
    Response.Free;
 
395
  end;
 
396
end;
 
397
 
 
398
procedure TWikiGet.DownloadPage(Page: string);
 
399
var
 
400
  Response: TMemoryStream;
 
401
  Client: TFPHTTPClient;
 
402
  URL: String;
 
403
  Filename: String;
 
404
begin
 
405
  Filename:=PageToFilename(Page,false);
 
406
  Response:=nil;
 
407
  Client:=nil;
 
408
  try
 
409
    Client:=TFPHTTPClient.Create(nil);
 
410
    Response:=TMemoryStream.Create;
 
411
    URL:=BaseURL+'index.php?title=Special:Export&pages='+EscapeDocumentName(Page)+'&curonly=1&action=submit';
 
412
    writeln('getting page "',URL,'" ...');
 
413
    Client.Get(URL,Response);
 
414
    //Client.ResponseHeaders.SaveToFile('responseheaders.txt');
 
415
    Response.Position:=0;
 
416
    writeln('saving page "',Filename,'" ...');
 
417
    Response.Position:=0;
 
418
    if not NoWrite then
 
419
      Response.SaveToFile(Filename);
 
420
  finally
 
421
    Client.Free;
 
422
    Response.Free;
 
423
  end;
 
424
end;
 
425
 
 
426
procedure TWikiGet.DownloadFirstNeededPage;
 
427
var
 
428
  Node: TAVLTreeNode;
 
429
  Page: String;
 
430
begin
 
431
  Node:=FNeededPages.Tree.FindLowest;
 
432
  if Node=nil then exit;
 
433
  Page:=PStringMapItem(Node.Data)^.Name;
 
434
  FNeededPages.Remove(Page);
 
435
  DownloadPage(Page);
 
436
end;
 
437
 
 
438
procedure TWikiGet.CheckNotUsedPages(Show, Delete: boolean);
 
439
var
 
440
  Item: PStringToPointerTreeItem;
 
441
  Files: TFilenameToPointerTree;
 
442
  FileInfo: TSearchRec;
 
443
  Page: TFetchWikiPage;
 
444
  Filename: TFilename;
 
445
begin
 
446
  Files:=TFilenameToPointerTree.Create(false);
 
447
  try
 
448
    for Item in FAllPages do begin
 
449
      Page:=TFetchWikiPage(Item^.Value);
 
450
      Files[Page.Filename]:=Page;
 
451
    end;
 
452
    if Show then
 
453
      writeln('Not needed files in the output directory "',OutputDir,'":');
 
454
    if FindFirstUTF8(OutputDir+AllFilesMask,faAnyFile,FileInfo)=0 then begin
 
455
      repeat
 
456
        if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='') then
 
457
          continue;
 
458
        if (faDirectory and FileInfo.Attr)<>0 then continue;
 
459
        Filename:=OutputDir+FileInfo.Name;
 
460
        if Files.Contains(Filename) then continue;
 
461
        if Show then
 
462
          writeln('page:',FileInfo.Name);
 
463
        if Delete then begin
 
464
          writeln('deleting page: ',FileInfo.Name);
 
465
          if (not NoWrite) and (not DeleteFileUTF8(Filename)) then
 
466
            writeln('failed to delete page "',Filename,'"');
 
467
        end;
 
468
      until FindNextUTF8(FileInfo)<>0;
 
469
    end;
 
470
    FindCloseUTF8(FileInfo);
 
471
  finally
 
472
    Files.Free;
 
473
  end;
 
474
end;
 
475
 
 
476
procedure TWikiGet.DownloadImages;
 
477
var
 
478
  Item: PStringToPointerTreeItem;
 
479
begin
 
480
  writeln('checking images of ',FAllPages.Tree.Count,' pages ...');
 
481
  for Item in FAllPages do
 
482
    DownloadPageImages(Item^.Name);
 
483
  writeln('total images: ',FAllImages.Tree.Count);
 
484
end;
 
485
 
 
486
procedure TWikiGet.DownloadPageImages(Page: string);
 
487
var
 
488
  p: TFetchWikiPage;
 
489
begin
 
490
  p:=LoadPageFromDisk(Page);
 
491
  if p=nil then exit;
 
492
  //writeln('TWikiGet.DownloadPageImages ',p.Filename,' ',length(p.Src));
 
493
  p.Verbosity:=wpvError;
 
494
  p.Parse(@OnParseForImages,p);
 
495
end;
 
496
 
 
497
procedure TWikiGet.OnParseForImages(Token: TWPToken);
 
498
var
 
499
  p: TFetchWikiPage;
 
500
  LinkToken: TWPLinkToken;
 
501
  Link: String;
 
502
  Filename: String;
 
503
  Client: TFPHTTPClient;
 
504
  Response: TMemoryStream;
 
505
  URL: String;
 
506
  i: SizeInt;
 
507
  StartPos: SizeInt;
 
508
  ImageLink: String;
 
509
  ColonPos: SizeInt;
 
510
  Prefix: String;
 
511
  Data: string;
 
512
  SrcLink: String;
 
513
  j: Integer;
 
514
  Header: String;
 
515
begin
 
516
  p:=TFetchWikiPage(Token.UserData);
 
517
  if Token.Token=wptInternLink then begin
 
518
    LinkToken:=Token as TWPLinkToken;
 
519
    SrcLink:=LinkToken.Link;
 
520
    Link:=SrcLink;
 
521
    ColonPos:=Pos(':',Link);
 
522
    //writeln('TWikiGet.OnParseForImages Link="',Link,'" ColonPos=',ColonPos);
 
523
    if ColonPos<1 then exit;
 
524
    if ColonPos=length(Link) then exit;
 
525
    Prefix:=lowercase(copy(Link,1,ColonPos-1));
 
526
    if Prefix<>'image' then exit;
 
527
    Link:=UTF8Trim(copy(Link,ColonPos+1,length(Link)));
 
528
    if Link='' then exit;
 
529
    Filename:=ImageToFilename(Link,true,true);
 
530
    //writeln('TWikiGet.OnParseForImages page="',p.Filename,'" Link="',Link,'" => ',Filename);
 
531
    if FAllImages.Contains(Link) then exit; // already tried
 
532
    FAllImages[Link]:=Filename;
 
533
    if FileExistsUTF8(Filename) then exit;
 
534
    //writeln('TWikiGet.OnParseForImages ',FileExists(Filename),' ',FileExistsUTF8(Filename),' "',Filename,'"');
 
535
    // download image page
 
536
    Response:=nil;
 
537
    Client:=nil;
 
538
    try
 
539
      try
 
540
        Client:=TFPHTTPClient.Create(nil);
 
541
        Response:=TMemoryStream.Create;
 
542
        URL:=BaseURL+EscapeDocumentName('Image:'+WikiInternalLinkToPage(Link));
 
543
        writeln('getting image page "',URL,'" ...');
 
544
        Client.Get(URL,Response);
 
545
        //Client.ResponseHeaders.SaveToFile('responseheaders.txt');
 
546
        Response.Position:=0;
 
547
        SetLength(Data,Response.Size);
 
548
        if Data<>'' then
 
549
          Response.Read(Data[1],length(Data));
 
550
        i:=Pos('class="fullImageLink"',Data);
 
551
        if i<1 then begin
 
552
          writeln('TWikiGet.OnParseForImages WARNING: image page has no fullImageLink marker: "',URL,'"');
 
553
          writeln('saving responseheaders.txt ...');
 
554
          if not NoWrite then
 
555
            Client.ResponseHeaders.SaveToFile('responseheaders.txt');
 
556
          writeln('saving response.txt ...');
 
557
          if not NoWrite then
 
558
            Response.SaveToFile('response.txt');
 
559
          exit;
 
560
        end;
 
561
        while i<=length(Data) do begin
 
562
          if (copy(Data,i,5)='src="') then begin
 
563
            //writeln('TWikiGet.OnParseForImages src found ...');
 
564
            inc(i,5);
 
565
            StartPos:=i;
 
566
            while (i<=length(Data)) and (Data[i]<>'"') do
 
567
              inc(i);
 
568
            ImageLink:=UTF8Trim(copy(Data,StartPos,i-StartPos));
 
569
            if ImageLink='' then exit;
 
570
            //writeln('TWikiGet.OnParseForImages Img="',ImageLink,'"');
 
571
            URL:=BaseURL+EscapeDocumentName(ImageLink);
 
572
            writeln('getting image "',URL,'" ...');
 
573
            Response.Clear;
 
574
            Client.Get(URL,Response);
 
575
            for j:=0 to Client.ResponseHeaders.Count-1 do begin
 
576
              Header:=Client.ResponseHeaders[j];
 
577
              if LeftStr(Header,length('Content-Type:'))='Content-Type:' then begin
 
578
                if Pos('image/',Header)<1 then begin
 
579
                  writeln('this is not an image: ',Header);
 
580
                  exit;
 
581
                end;
 
582
              end;
 
583
            end;
 
584
            writeln('saving image to "',Filename,'" ...');
 
585
            if not NoWrite then
 
586
              Response.SaveToFile(Filename);
 
587
            exit;
 
588
          end;
 
589
          inc(i);
 
590
        end;
 
591
      except
 
592
        on E: EHTTPClient do begin
 
593
          writeln('TWikiGet.OnParseForImages WARNING: page="'+p.Filename+'" Link="'+Link+'" SrcLink="'+SrcLink+'" URL="'+URL+'": '+E.Message);
 
594
        end;
 
595
      end;
 
596
    finally
 
597
      Client.Free;
 
598
      Response.Free;
 
599
    end;
 
600
  end;
 
601
end;
 
602
 
 
603
procedure TWikiGet.CheckNotUsedImages(Show, Delete: boolean);
 
604
var
 
605
  Files: TFilenameToStringTree;
 
606
  FileInfo: TSearchRec;
 
607
  Filename: string;
 
608
  Item: PStringToStringTreeItem;
 
609
begin
 
610
  Files:=TFilenameToStringTree.Create(false);
 
611
  try
 
612
    for Item in FAllImages do begin
 
613
      Filename:=Item^.Value;
 
614
      Files[Filename]:='1';
 
615
    end;
 
616
    if Show then
 
617
      writeln('Not needed files in the images directory "',ImagesDir,'":');
 
618
    if FindFirstUTF8(ImagesDir+AllFilesMask,faAnyFile,FileInfo)=0 then begin
 
619
      repeat
 
620
        if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='') then
 
621
          continue;
 
622
        if (faDirectory and FileInfo.Attr)<>0 then continue;
 
623
        Filename:=ImagesDir+FileInfo.Name;
 
624
        if Files.Contains(Filename) then continue;
 
625
        if Show then
 
626
          writeln('image:',FileInfo.Name);
 
627
        if Delete then begin
 
628
          writeln('deleting image: ',FileInfo.Name);
 
629
          if (not NoWrite) and (not DeleteFileUTF8(Filename)) then
 
630
            writeln('failed to delete image "',Filename,'"');
 
631
        end;
 
632
      until FindNextUTF8(FileInfo)<>0;
 
633
    end;
 
634
    FindCloseUTF8(FileInfo);
 
635
  finally
 
636
    Files.Free;
 
637
  end;
 
638
end;
 
639
 
 
640
function TWikiGet.LoadPageFromDisk(Page: string): TFetchWikiPage;
 
641
var
 
642
  Filename: String;
 
643
begin
 
644
  Result:=AddWikiPage(Page);
 
645
  if (Result=nil) or (Result.Src<>'') then exit;
 
646
  Filename:=PageToFilename(Page,false);
 
647
  //writeln('TWikiGet.LoadPageFromDisk ',Page,' File=',Filename);
 
648
  if not FileExistsUTF8(Filename) then begin
 
649
    writeln('TWikiGet.LoadPageFromDisk page "',Page,'": file not found "',Filename,'"');
 
650
    exit;
 
651
  end;
 
652
  Result.LoadFromFile(Filename);
 
653
end;
 
654
 
 
655
function TWikiGet.AddWikiPage(Page: string): TFetchWikiPage;
 
656
begin
 
657
  if Page='' then exit(nil);
 
658
  Result:=TFetchWikiPage(FAllPages[Page]);
 
659
  if Result=nil then begin
 
660
    Result:=TFetchWikiPage.Create;
 
661
    Result.PageName:=Page;
 
662
    Result.Filename:=PageToFilename(Page,false);
 
663
    FAllPages[Page]:=Result;
 
664
  end;
 
665
end;
 
666
 
 
667
function TWikiGet.NeedWikiPage(Page: string): TFetchWikiPage;
 
668
begin
 
669
  Result:=AddWikiPage(Page);
 
670
  if Result=nil then exit;
 
671
  FNeededPages[Page]:=Result;
 
672
end;
 
673
 
 
674
function TWikiGet.PageToFilename(Page: string; IsInternalLink: boolean): string;
 
675
begin
 
676
  Result:=OutputDir+WikiPageToFilename(Page,IsInternalLink,true)+'.xml';
 
677
end;
 
678
 
 
679
function TWikiGet.ImageToFilename(Image: string; IsInternalLink,
 
680
  KeepScheme: boolean): string;
 
681
begin
 
682
  Result:=ImagesDir+WikiImageToFilename(Image,IsInternalLink,true,KeepScheme);
 
683
end;
 
684
 
 
685
function TWikiGet.EscapeDocumentName(aName: string): string;
 
686
var
 
687
  i: Integer;
 
688
  s: String;
 
689
begin
 
690
  Result:=aName;
 
691
  i:=1;
 
692
  while i<=length(Result) do begin
 
693
    s:=Result[i];
 
694
    case s[1] of
 
695
    ':': s:='%'+HexStr(ord(s[1]),2);
 
696
    end;
 
697
    if s<>Result[i] then
 
698
      ReplaceSubstring(Result,i,1,s);
 
699
    inc(i,length(s));
 
700
  end;
 
701
 
 
702
  if (Result<>'') and (Result[1]='/') then
 
703
    Delete(Result,1,1);
 
704
end;
 
705
 
 
706
function TWikiGet.IsIgnoredPage(Page: string): boolean;
 
707
var
 
708
  i: Integer;
 
709
begin
 
710
  for i:=low(IgnorePrefixes) to high(IgnorePrefixes) do begin
 
711
    if LeftStr(Page,length(IgnorePrefixes[i]))=IgnorePrefixes[i] then
 
712
      exit(true);
 
713
  end;
 
714
  Result:=false;
 
715
end;
 
716
 
 
717
procedure TWikiGet.Test;
 
718
 
 
719
  procedure w(URL: string);
 
720
  var
 
721
    Page: String;
 
722
    Filename: String;
 
723
  begin
 
724
    debugln(['TWikiGet.Test [',URL,']']);
 
725
    Page:=WikiInternalLinkToPage(URL);
 
726
    debugln(['  URL=[',dbgstr(URL),']  Page=[',Page,']']);
 
727
    Filename:=WikiImageToFilename(Page,false,true);
 
728
    debugln(['  URL=[',dbgstr(URL),']  Filename="',Filename,'"']);
 
729
  end;
 
730
 
 
731
begin
 
732
  //w('Image:Acs_demos.jpg');
 
733
  //w('Image:Acs demos.jpg');
 
734
  w('Image:Acs%20demos.jpg');
 
735
  //w('Image:Acs demos.JPG');
 
736
 
 
737
  Halt;
 
738
end;
 
739
 
 
740
constructor TWikiGet.Create(TheOwner: TComponent);
 
741
begin
 
742
  inherited Create(TheOwner);
 
743
  StopOnException:=True;
 
744
  fOutputDir:='wikixml';
 
745
  FImagesDir:='images';
 
746
  FBaseURL:='http://wiki.lazarus.freepascal.org/';
 
747
  fFirstPage:='Lazarus_Documentation';
 
748
  FAllPages:=TStringToPointerTree.Create(true);
 
749
  FNeededPages:=TStringToPointerTree.Create(true);
 
750
  FAllImages:=TStringToStringTree.Create(true);
 
751
  FIgnoreFilesYoungerThanMin:=60;
 
752
end;
 
753
 
 
754
destructor TWikiGet.Destroy;
 
755
begin
 
756
  FAllImages.Free;
 
757
  FAllPages.Free;
 
758
  FNeededPages.Free;
 
759
  inherited Destroy;
 
760
end;
 
761
 
 
762
procedure TWikiGet.WriteHelp;
 
763
begin
 
764
  writeln('Usage: ',ExeName,' -h');
 
765
  writeln;
 
766
  writeln('--dir=<directory>     : directory where to store the files. Default: ',OutputDir);
 
767
  writeln('--images=<directory>  : directory where to store the images. Default: ',ImagesDir);
 
768
  writeln('--baseurl=<URL>       : URL of the wiki. Default: ',BaseURL);
 
769
  writeln('--page=<pagename>     : download this wiki page. Can be given multiple times.');
 
770
  writeln('--allmissing          : download all wiki pages, if file not already there.');
 
771
  writeln('--recent=<days>       : download pages again if changed in the last days on the site.');
 
772
  writeln('                        includes --allmissing.');
 
773
  writeln('                 ToDo: check more than last 500 changes.');
 
774
  writeln('--ignore-recent=<minutes> : do not download again files younger than this on disk.');
 
775
  writeln('                        combine with --recent. Default: ',IgnoreFilesYoungerThanMin);
 
776
  writeln('--shownotusedpages    : show not used files in the output directory.');
 
777
  writeln('--deletenotusedpages  : delete the files in the output directory that are not used.');
 
778
  writeln('--shownotusedimages   : show not used files in the images directory.');
 
779
  writeln('--deletenotusedimages : delete the files in the images directory that are not used.');
 
780
  writeln('--nowrite             : do not write files, just print what would be written.');
 
781
  writeln;
 
782
  writeln('Example: download one page');
 
783
  writeln('  ',ExeName,' --dir=html --images=images --page=Install_Packages');
 
784
  writeln('Example: download the whole wiki');
 
785
  writeln('  ',ExeName,' --allmissing');
 
786
  writeln('Example: call this to download new files once per week');
 
787
  writeln('  ',ExeName,' --recent=8 --deletenotusedpages --deletenotusedimages');
 
788
end;
 
789
 
 
790
var
 
791
  Application: TWikiGet;
 
792
begin
 
793
  Application:=TWikiGet.Create(nil);
 
794
  Application.Title:='Wiki Get';
 
795
  Application.Run;
 
796
  Application.Free;
 
797
end.
 
798