http package (only partially working)

2010-06-23 11:52:34 +01:00
parent 6e956b879a
commit 4694a50fa5
98 changed files with 20952 additions and 4 deletions
--- a/packages/http/json.c
+++ b/packages/http/json.c
@@ -0,0 +1,152 @@
+/*  $Id$
+
+    Part of SWI-Prolog
+
+    Author:        Jan Wielemaker
+    E-mail:        wielemak@science.uva.nl
+    WWW:           http://www.swi-prolog.org
+    Copyright (C): 1985-2007, University of Amsterdam
+
+    This library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Lesser General Public
+    License as published by the Free Software Foundation; either
+    version 2.1 of the License, or (at your option) any later version.
+
+    This library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Lesser General Public License for more details.
+
+    You should have received a copy of the GNU Lesser General Public
+    License along with this library; if not, write to the Free Software
+    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+*/
+
+#include <SWI-Stream.h>
+#include <SWI-Prolog.h>
+#include <string.h>
+
+#define TRYPUTC(c, s) if ( Sputcode(c, s) < 0 ) { return -1; }
+
+static int
+json_put_code(IOSTREAM *out, int c)
+{ static char escape[128];
+  static int escape_initialized = FALSE;
+
+  if ( !escape_initialized )
+  { memset(escape, 0, sizeof(escape));
+
+    escape['"']  = '"';
+    escape['\\'] = '\\';
+    escape['\b'] = 'b';
+    escape['\f'] = 'f';
+    escape['\n'] = 'n';
+    escape['\r'] = 'r';
+    escape['\t'] = 't';
+
+    escape_initialized = TRUE;
+  }
+
+  if ( c < 128 )
+  { if ( escape[c] )
+    { TRYPUTC('\\', out);
+      TRYPUTC(escape[c], out);
+    } else if ( c < ' ' )	/* control characters *must* be escaped */
+    { TRYPUTC('\\', out);
+      if ( Sfprintf(out, "u%04x", c) < 0 )
+	return -1;
+    } else
+    { TRYPUTC(c, out);
+    }
+  } else
+  { TRYPUTC(c, out);
+  }
+
+  return 0;
+}
+
+#undef TRYPUTC
+#define TRYPUTC(c, s) if ( Sputcode(c, s) < 0 ) { rc = FALSE; goto out; }
+
+static foreign_t
+json_write_string(term_t stream, term_t text)
+{ IOSTREAM *out;
+  char *a;
+  pl_wchar_t *w;
+  size_t len;
+  int rc = TRUE;
+
+  if ( !PL_get_stream_handle(stream, &out) )
+    return FALSE;
+
+  if ( PL_get_nchars(text, &len, &a, CVT_ATOM|CVT_STRING|CVT_LIST) )
+  { const char *ap;
+    size_t todo;
+
+    TRYPUTC('"', out);
+    for(todo=len, ap=a; todo-- > 0; ap++)
+    { int c = *ap&0xff;
+
+      if ( json_put_code(out, c) < 0 )
+      { rc = FALSE; goto out;
+      }
+    }
+    TRYPUTC('"', out);
+  } else if ( PL_get_wchars(text, &len, &w, CVT_ATOM|CVT_STRING|CVT_LIST|CVT_EXCEPTION) )
+  { const pl_wchar_t *wp;
+    size_t todo;
+
+    TRYPUTC('"', out);
+    for(todo=len, wp=w; todo-- > 0; wp++)
+    { int c = *wp;
+
+      if ( json_put_code(out, c) < 0 )
+      { rc = FALSE; goto out;
+      }
+    }
+    TRYPUTC('"', out);
+  } else
+  { rc = FALSE;
+  }
+
+out:
+  PL_release_stream(out);
+
+  return rc;
+}
+
+
+static foreign_t
+json_write_indent(term_t stream, term_t indent, term_t tab)
+{ int i, t, n;
+  IOSTREAM *out;
+
+  if ( !PL_get_integer(indent, &i) ||
+       !PL_get_integer(tab, &t) )
+    return FALSE;
+
+  if ( PL_get_stream_handle(stream, &out) )
+  { int rc = TRUE;
+
+    if ( !out->position || out->position->linepos > 0 )
+    { TRYPUTC('\n', out);
+    }
+    for(n=0; n<i/t; n++)
+      TRYPUTC('\t', out);
+    for(n=0; n<i%t; n++)
+      TRYPUTC(' ', out);
+out:
+    PL_release_stream(out);
+    return rc;
+  }
+
+  return FALSE;
+}
+
+
+
+install_t
+install_json()
+{ PL_register_foreign("json_write_string", 2, json_write_string, 0);
+  PL_register_foreign("json_write_indent", 3, json_write_indent, 0);
+}