xx_report_soap_api

create or replace package xx_report_soap_api as

  type t_request is record(

    method       varchar2(256),

    namespace    varchar2(256),

    body         varchar2(32767),

    envelope_tag varchar2(30));

  type t_response is record(

    doc          xmltype,

    envelope_tag varchar2(30));

  function new_request(p_method       in varchar2,

                       p_namespace    in varchar2,

                       p_envelope_tag in varchar2 default 'soapenv')

    return t_request;

  procedure add_parameter(p_request in out nocopy t_request,

                          p_name    in varchar2,

                          p_value   in varchar2,

                          p_type    in varchar2 := null);

  procedure add_complex_parameter(p_request in out nocopy t_request,

                                  p_xml     in varchar2);

  function invoke(p_request in out nocopy t_request,

                  p_url     in varchar2,

                  p_action  in varchar2) return t_response;

  function get_return_value(p_response  in out nocopy t_response,

                            p_name      in varchar2,

                            p_namespace in varchar2) return clob;

  procedure debug_on;

  procedure debug_off;

  function getLengBClob(p_clob clob) return number;

end;

/

create or replace package body xx_report_soap_api as

  g_debug boolean := false;

  procedure show_envelope(p_env     in clob,

                          p_heading in varchar2 default null);

  -- ---------------------------------------------------------------------

  function new_request(p_method       in varchar2,

                       p_namespace    in varchar2,

                       p_envelope_tag in varchar2 default 'soapenv')

    return t_request as

    -- ---------------------------------------------------------------------

    l_request t_request;

  begin

    l_request.method       := p_method;

    l_request.namespace    := p_namespace;

    l_request.envelope_tag := p_envelope_tag;

    return l_request;

  end;

  -- ---------------------------------------------------------------------

  -- ---------------------------------------------------------------------

  procedure add_parameter(p_request in out nocopy t_request,

                          p_name    in varchar2,

                          p_value   in varchar2,

                          p_type    in varchar2 := null) as

    -- ---------------------------------------------------------------------

  begin

    if p_type is null then

      p_request.body := p_request.body || '<' || p_name || '>' || p_value || '</' ||

                        p_name || '>';

    else

      p_request.body := p_request.body || '<' || p_name || ' xsi:type="' ||

                        p_type || '">' || p_value || '</' || p_name || '>';

    end if;

  end;

  -- ---------------------------------------------------------------------

  -- ---------------------------------------------------------------------

  procedure add_complex_parameter(p_request in out nocopy t_request,

                                  p_xml     in varchar2) as

    -- ---------------------------------------------------------------------

  begin

    p_request.body := p_request.body || p_xml;

  end;

  -- ---------------------------------------------------------------------

  -- ---------------------------------------------------------------------

  procedure generate_envelope(p_request in out nocopy t_request,

                              p_env     in out nocopy varchar2) as

    -- ---------------------------------------------------------------------

  begin

    p_env := '<' || p_request.envelope_tag || ':Envelope xmlns:' ||

             p_request.envelope_tag ||

             '="http://schemas.xmlsoap.org/soap/envelope/" ' ||

             'xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" xmlns:xsd="http://www.w3.org/1999/XMLSchema">' || '<' ||

             p_request.envelope_tag || ':Body>' || '<' || p_request.method || ' ' ||

             p_request.namespace || ' ' || p_request.envelope_tag ||

             ':encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">' ||

             p_request.body || '</' || p_request.method || '>' || '</' ||

             p_request.envelope_tag || ':Body>' || '</' ||

             p_request.envelope_tag || ':Envelope>';

  end;

  -- ---------------------------------------------------------------------

  -- ---------------------------------------------------------------------

  procedure show_envelope(p_env     in clob,

                          p_heading in varchar2 default null) as

    -- ---------------------------------------------------------------------

    i     pls_integer;

    l_len pls_integer;

  begin

    if g_debug then

      if p_heading is not null then

        dbms_output.put_line('*****' || p_heading || '*****');

      end if;

      i     := 1;

      l_len := dbms_lob.getlength(p_env);

      dbms_output.put_line(l_len);

      while (i <= l_len) loop

        dbms_output.put_line(substr(p_env, i, 60));

        i := i + 60;

      end loop;

    end if;

  end;

  -- ---------------------------------------------------------------------

  -- ---------------------------------------------------------------------

  procedure check_fault(p_response in out nocopy t_response) as

    -- ---------------------------------------------------------------------

    l_fault_node   xmltype;

    l_fault_code   varchar2(256);

    l_fault_string varchar2(32767);

  begin

    l_fault_node := p_response.doc.extract('/' || p_response.envelope_tag ||

                                           ':Fault',

                                           'xmlns:' ||

                                           p_response.envelope_tag ||

                                           '="http://schemas.xmlsoap.org/soap/envelope/');

    if (l_fault_node is not null) then

      l_fault_code   := l_fault_node.extract('/' || p_response.envelope_tag ||':Fault/faultcode/child::text()','xmlns:' || p_response.envelope_tag ||'="http://schemas.xmlsoap.org/soap/envelope/')

                        .getstringval();

      l_fault_string := l_fault_node.extract('/' || p_response.envelope_tag ||':Fault/faultstring/child::text()','xmlns:' || p_response.envelope_tag ||'="http://schemas.xmlsoap.org/soap/envelope/')

                        .getstringval();

      raise_application_error(-20000,

                              l_fault_code || ' - ' || l_fault_string);

    end if;

  end;

  -- ---------------------------------------------------------------------

  -- ---------------------------------------------------------------------

  function invoke(p_request in out nocopy t_request,

                  p_url     in varchar2,

                  p_action  in varchar2) return t_response as

    -- ---------------------------------------------------------------------

    --l_envelope varchar2(32767);

    l_envelope      clob;

    l_http_request  utl_http.req;

    l_http_response utl_http.resp;

    l_response      t_response;

    l_text          VARCHAR2(32767);

    l_clob          CLOB;

  begin

    -- Initialize the CLOB.

    DBMS_LOB.createtemporary(l_clob, FALSE);

    generate_envelope(p_request, l_envelope);

    --show_envelope(l_envelope, 'Request');

    l_http_request := utl_http.begin_request(p_url, 'POST', 'HTTP/1.1');

    --Dung UTF8 (trong request co tieng Viet)

    utl_http.set_header(l_http_request,

                        'Content-Type',

                        'text/xml; charset=UTF-8');

    utl_http.set_header(l_http_request,

                        'Content-Length',

                        getLengBClob(convert(l_envelope, 'UTF8')));

    utl_http.set_header(l_http_request, 'Transfer-Encoding', 'chunked');

    utl_http.set_header(l_http_request, 'SOAPAction', p_action);

    dbms_output.put_line(l_envelope);

    -- MInhBD them. Start:

    utl_http.set_transfer_timeout(l_http_request, 1200);

    -- MinhBD them. End!

    utl_http.write_text(l_http_request, l_envelope);

    l_http_response := utl_http.get_response(l_http_request);

    -- Copy the response into the CLOB.

    BEGIN

      LOOP

        UTL_HTTP.read_text(l_http_response, l_text, 32766);

        DBMS_LOB.writeappend(l_clob, LENGTH(l_text), l_text);

      END LOOP;

    EXCEPTION

      WHEN UTL_HTTP.end_of_body THEN

        UTL_HTTP.end_response(l_http_response);

    END;

    l_response.doc := xmltype.createxml(l_clob);

    -- Relase the resources associated with the temporary LOB.

    DBMS_LOB.freetemporary(l_clob);

    l_response.envelope_tag := p_request.envelope_tag;

    l_response.doc          := l_response.doc.extract('/' ||

                                                      l_response.envelope_tag ||

                                                      ':Envelope/' ||

                                                      l_response.envelope_tag ||

                                                      ':Body/child::node()',

                                                      'xmlns:' ||

                                                      l_response.envelope_tag ||

                                                      '="http://schemas.xmlsoap.org/soap/envelope/"');

    check_fault(l_response);

    return l_response;

  EXCEPTION

    WHEN OTHERS THEN

      UTL_HTTP.end_response(l_http_response);

      DBMS_LOB.freetemporary(l_clob);

      RAISE;

  end;

  -- ---------------------------------------------------------------------

  -- ---------------------------------------------------------------------

  function get_return_value(p_response  in out nocopy t_response,

                            p_name      in varchar2,

                            p_namespace in varchar2) return clob as

    -- ---------------------------------------------------------------------

  begin

    return p_response.doc.extract('//' || p_name || '/child::text()',

                                  p_namespace).getclobval();

  end;

  -- ---------------------------------------------------------------------

  -- ---------------------------------------------------------------------

  procedure debug_on as

    -- ---------------------------------------------------------------------

  begin

    g_debug := true;

  end;

  -- ---------------------------------------------------------------------

  -- ---------------------------------------------------------------------

  procedure debug_off as

    -- ---------------------------------------------------------------------

  begin

    g_debug := false;

  end;

  -- ---------------------------------------------------------------------

  function getLengBClob(p_clob clob) return number is

    l_clob         CLOB := p_clob; -- the é will take two bytes!

    l_blob         BLOB;

    l_dest_offset  NUMBER := 1;

    l_src_offset   NUMBER := 1;

    l_lang_context NUMBER := 0;

    l_warning      NUMBER;

    v_number       number;

  BEGIN

    dbms_lob.createtemporary(l_blob, FALSE, dbms_lob.call);

    dbms_lob.converttoblob(dest_lob     => l_blob,

                           src_clob     => l_clob,

                           amount       => dbms_lob.lobmaxsize,

                           dest_offset  => l_dest_offset,

                           src_offset   => l_src_offset,

                           blob_csid    => nls_charset_id('AL32UTF8'),

                           lang_context => l_lang_context,

                           warning      => l_warning);

    v_number := dbms_lob.getlength(l_blob);

    dbms_lob.freetemporary(l_blob);

    return v_number;

  END;

end;

/