fpc/packages/libxml/examples/io1.pas

(**
 * section: InputOutput
 * synopsis: Example of custom Input/Output
 * purpose: Demonstrate the use of xmlRegisterInputCallbacks
 *          to build a custom I/O layer, this is used in an
 *          XInclude method context to show how dynamic document can
 *          be built in a clean way.
 * usage: io1
 * test: io1 > io1.tmp ; diff io1.tmp io1.res ; rm -f io1.tmp
 * author: Daniel Veillard
 * copy: see Copyright for the status of this software.
 *)

program io1;

{$mode objfpc}

uses
  ctypes,
  xml2,
  exutils,
  SysUtils;

const
  include: pchar =
    '<?xml version=''1.0''?>'#10+
    '<document xmlns:xi="http://www.w3.org/2003/XInclude">'#10+
      '<p>List of people:</p>'#10+
      '<xi:include href="sql:select_name_from_people"/>'#10+
    '</document>'#10;

var
  res: pchar = '<list><people>a</people><people>b</people></list>';
  cur: pchar = nil;
  rlen: cint = 0;


(**
 * sqlMatch:
 * @URI: an URI to test
 *
 * Check for an sql: query
 *
 * Returns 1 if yes and 0 if another Input module should be used
 *)
function sqlMatch(URI: pchar): cint; cdecl;
begin
  if assigned(URI) and (strlcomp(URI, 'sql:', 4) = 0) then
    result := 1
  else
    result := 0;
end;

(**
 * sqlOpen:
 * @URI: an URI to test
 *
 * Return a pointer to the sql: query handler, in this example simply
 * the current pointer...
 *
 * Returns an Input context or NULL in case or error
 *)
function sqlOpen(URI: pchar): pointer; cdecl;
begin
  if not assigned(URI) or (strlcomp(URI, 'sql:', 4) <> 0) then
    exit(nil);

  cur := res;
  rlen := strlen(res);

  result := pointer(cur);
end;

(**
 * sqlClose:
 * @context: the read context
 *
 * Close the sql: query handler
 *
 * Returns 0 or -1 in case of error
 *)
function sqlClose(context: pointer): cint; cdecl;
begin
  if not assigned(context) then
    exit(-1);

  cur := nil;
  rlen := 0;

  result := 0;
end;

(**
 * sqlRead:
 * @context: the read context
 * @buffer: where to store data
 * @len: number of bytes to read
 *
 * Implement an sql: query read.
 *
 * Returns the number of bytes read or -1 in case of error
 *)
function sqlRead(context: pointer; buffer: pchar; len: cint): cint; cdecl;
var
  ptr: pchar;
begin
  if not assigned(context) or not assigned(buffer) or (len < 0) then
    exit(-1);

  ptr := context;
  if len > rlen then
    len := rlen;

  move(ptr^, buffer^, len);
  rlen := rlen - len;

  result := len;
end;

var
  doc: xmlDocPtr;

begin
  (*
   * this initialize the library and check potential ABI mismatches
   * between the version it was compiled for and the actual shared
   * library used.
   *)
  LIBXML_TEST_VERSION;

  (*
   * register the new I/O handlers
   *)
  if xmlRegisterInputCallbacks(@sqlMatch, @sqlOpen, @sqlRead, @sqlClose) < 0 then
  begin
    printfn('failed to register SQL handler');
    halt(1);
  end;

  (*
   * parse include into a document
   *)
  doc := xmlReadMemory(include, strlen(include), 'include.xml', nil, 0);
  if doc = nil then
  begin
    printfn('failed to parse the including file');
    halt(1);
  end;

  (*
   * apply the XInclude process, this should trigger the I/O just
   * registered.
   *)
  if xmlXIncludeProcess(doc) <= 0 then
  begin
    printfn('XInclude processing failed');
    halt(1);
  end;

  (*
   * save the output for checking to stdout
   *)
//  xmlDocDump(stdout, doc);

  (*
   * Free the document
   *)
  //xmlDumpDoc(doc);
  docdump(doc);

  (*
   * Cleanup function for the XML library.
   *)
  xmlCleanupParser();
end.