<?vsp 
--  
--  $Id: html2wml.vsp,v 1.2.2.1 2012/03/08 12:55:15 source Exp $
--  
--  This file is part of the OpenLink Software Virtuoso Open-Source (VOS)
--  project.
--  
--  Copyright (C) 1998-2012 OpenLink Software
--  
--  This project is free software; you can redistribute it and/or modify it
--  under the terms of the GNU General Public License as published by the
--  Free Software Foundation; only version 2 of the License, dated June 1991.
--  
--  This program 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
--  General Public License for more details.
--  
--  You should have received a copy of the GNU General Public License along
--  with this program; if not, write to the Free Software Foundation, Inc.,
--  51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
--  
--  

     http_header('Content-type: text/vnd.wap.wml\n');

     declare tree any;
     declare _res, _target_uri, _http_method, _request_header, _request_body, _proxy varchar;
     declare _return_header any;
     declare _url, _root, _relative, _md5_filename, _cmd1 varchar;
     declare _doc_size, _counter1, _page, _page_size, _start_pos, _end_pos, _temp_end_pos, _start integer;
     declare tree, _this_url any;

     _url := get_keyword('url', params);
     _target_uri := 'http://dmoz.org/';

     _this_url := soap_current_url ();

     _http_method := 'GET';
     _request_header := 'User-Agent: Lynx/2.83dev18 libwww-FM/2.14\nAccept: text/plain, text/html, image/*\n';
     _request_header := '';
     _request_body := '';

     if (length(_url) > 1 and (matches_like(_url, 'http%://%')  or matches_like(_url, 'HTTP%://%')  ) )
     {
        _target_uri := _url;
     }

     _target_uri := trim (_target_uri);

     if (matches_like (_target_uri, 'http%://%')   or matches_like (_target_uri, 'HTTP%://%') )
     {
        _root := substring (  _target_uri, 1 , ( LOCATE('/', _target_uri, (LOCATE('//', _target_uri) + 2) ) -1));
     }

     if ( right(_target_uri, 1   ) = '/'  )
     {
        _relative := _target_uri;
     }else{
           _counter1 := 1;
           while (_counter1 < length(_target_uri) )
           {
              if (  matches_like( right(_target_uri, _counter1), '/%')  )
              {
                 _relative := substring (_target_uri, 1, (length(_target_uri) - _counter1 + 1)  );
                 _counter1 := length (_target_uri);
              }else{
                 _counter1 := _counter1 + 1;
              }
           }
     }

     _res := '';
     _res := http_get(_target_uri, _return_header, _http_method, _request_header, _request_body);
     _doc_size := length (_res);

     _page_size := 2000;

     if (length(get_keyword('start', params)) < 1)
     {
        _start_pos := 1;
     }else{
        _start_pos := atoi (get_keyword('start', params));
     }

     _temp_end_pos := _start_pos + _page_size - 1;

     _end_pos := locate ('>', _res, _temp_end_pos);

     if (gte (_end_pos, _temp_end_pos) = 1)
     {
          _res := substring (_res, _start_pos, (_end_pos - _start_pos + 1)  );
          _start := _end_pos + 1;
     }else{
          _res := substring (_res, _start_pos, _page_size);
          _start := _start_pos + _page_size;
     }

     _res := tidy_html (_res, 'word-2000:yes\nindent:auto\noutput-xhtml:yes\ninput-xml: no\r\nquote-nbsp: yes');
     http_xslt (TUTORIAL_XSL_DIR () || '/tutorial/wap/wa_b_1/html2wml.xsl', vector('base', _this_url));
     set http_charset='utf-8';
     tree := xtree_doc (_res, 0, '', 'UTF-8', 'x-any');

     http('<document>');
     http_value(tree);
     http('<wml1>');
     http('<root>');
     http_url(_root);
     http('</root>');
     http('<relative>');
     http_url(_relative);
     http('</relative>');
     http('<url>');
     http_url(_target_uri);
     http('</url>');
     if (_doc_size > _start)
     {
        http('<start>');
        http(sprintf('%d',_start));
        http('</start>');
     }
     http('</wml1>');
     http('</document>');
?>

