/pliant/protocol/http/export.pli
 
 1  module "/pliant/language/compiler.pli" 
 2  module "/pliant/language/stream.pli" 
 3  module "/pliant/admin/file.pli" 
 4  module "/pliant/admin/execute.pli" 
 5  module "server.pli" 
 6  module "/pliant/protocol/http/style/common.pli" 
 7  module "/pliant/protocol/http/style/default.style" 
 8  module "/pliant/protocol/http/client.pli" 
 9   
 10  constant htmldoc (file_query "embedded:/usr/bin/htmldoc" standard)=defined 
 11  constant html2ps (file_query "embedded:/usr/bin/html2ps" standard)=defined 
 12   
 13   
 14  function html_to_postscript html page options ps -> status 
 15    arg Str html ; arg HtmlPage page ; arg Str options ps ; arg ExtendedStatus status 
 16    if htmldoc 
 17      var Str temp := replace file_temporary+"/" "file:/" "embedded:/" 
 18      (var Stream s) open html in+safe 
 19      (var Stream d) open temp+"pliant.html" out+safe+mkdir 
 20      while not s:atend 
 21        var Str l := s readline 
 22        while (l eparse any:(var Str head) "<img src=[dq]" any:(var Str url) "[dq]" any:(var Str tail)) 
 23          var Str id := url (url search_last "/" -1)+1 url:len 
 24          if (url 0 1)="/" 
 25            if (file_copy url temp+id)=failure 
 26              file_copy "http://localhost"+url temp+id 
 27          else 
 28            console "unsupported image " url eol 
 29          l := head+"<IMG src=[dq]"+file_os_name:(replace temp "embedded:/" "file:/")+id+"[dq]"+tail 
 30        d writeline l 
 31      s close ; d close 
 32      file_copy temp+"pliant.html" "file:/tmp/pliant.html" 
 33      var Str extra := "" 
 34      var Int margin := options option "margin" Int 
 35      var Int left_margin := options option "left_margin" Int 
 36      var Int top_margin := options option "top_margin" Int 
 37      var Int right_margin := options option "right_margin" Int 
 38      var Int bottom_margin := options option "bottom_margin" Int 
 39      var Int font_size := options option "font_size" Int  
 40      if margin=defined or (left_margin=defined and top_margin=defined and right_margin=defined and bottom_margin=defined) 
 41        extra := " --top "+string:(shunt top_margin=defined top_margin margin)+"mm --bottom "+string:(shunt bottom_margin=defined bottom_margin margin)+"mm --left "+string:(shunt left_margin=defined left_margin margin)+"mm --right "+string:(shunt right_margin=defined right_margin margin)+"mm" 
 42      var Int err := execute "/usr/bin/htmldoc -t ps1"+extra+" --continuous --bodycolor white --fontsize "+string:font_size+" --size 210x297mm -" input temp+"pliant.html" output ps error "device:/null" root "embedded:/" path "embedded:/" 
 43      file_tree_delete temp 
 44      if err=0 
 45        return success 
 46      # if (execute "/usr/bin/htmldoc -t ps1 --continuous -" input html output ps root "embedded:/" path "embedded:/")=0 
 47      #   return success 
 48    if html2ps 
 49      if (execute "/usr/bin/html2ps -b http://"+page:http_request:site_name+page:http_request:encoded_path input html output ps error "device:/null" root "embedded:/" path "embedded:/")=0 
 50        return success 
 51    if htmldoc or html2ps 
 52      status := failure "Failed to convert HTML to PostScript" 
 53    else 
 54      status := failure "Cannot convert from HTML to PostScript since none of htmldoc or html2ps utlity is available" 
 55   
 56   
 57  method p begin_end_hook_prototype fun 
 58    arg_rw HtmlPage p ; arg Function fun 
 59    indirect 
 60   
 61  method page export_dynamic_page pagename options where -> status 
 62    arg_rw HtmlPage page ; arg Str pagename options where ; arg ExtendedStatus status 
 63    var Str ext := where (where search_last "." where:len) where:len 
 64    var CBool direct := not (where parse "printer:" any) and ext<>".ps" and not (options option "postscript") 
 65    var Str html := shunt direct where file_temporary 
 66    var Link:Stream s :> new Stream 
 67    s open html out+safe 
 68    var Link:HtmlPage subpage :> new HtmlPage 
 69    subpage bind page:http_request 
 70    subpage read_only true 
 71    subpage options := options 
 72    subpage http_stream :> s 
 73    subpage begin_end_hook_prototype subpage:begin_hook 
 74    status := subpage execute_dynamic_page pagename 
 75    subpage begin_end_hook_prototype subpage:end_hook 
 76    subpage unbind 
 77    if s:close=failure 
 78      file_delete html 
 79      return failure:"Failed to write HTML file" 
 80    if direct 
 81      return success 
 82    var Str ext := where (where search_last "." where:len) where:len 
 83    if (where parse "printer:" any:(var Str queue)) 
 84      var Str ps := replace (replace file_temporary "file:/" "embedded:/") ".tmp" ".ps" 
 85      status := html_to_postscript html page options ps 
 86      if status=success 
 87        if (execute "/usr/bin/lpr"+(shunt queue<>"" " -P"+queue "")+" "+file_os_name:(replace ps "embedded:/" "file:/") root "embedded:/" path "embedded:/")<>0 
 88          status := failure "Failed to add job to print queue "+queue  
 89      file_delete ps 
 90    eif ext=".ps" or (options option "postscript") 
 91      var Str ps := file_temporary 
 92      status := html_to_postscript html page options ps 
 93      if status=success 
 94        if (file_copy ps where)=failure 
 95          status := failure "Failed to store PostScript output in "+where 
 96      file_delete ps 
 97    file_delete html 
 98   
 99  method page export_dynamic_page pagename where -> status 
 100    arg_rw HtmlPage page ; arg Str pagename where ; arg ExtendedStatus status 
 101    status := page export_dynamic_page pagename "light_view" where 
 102   
 103  export '. export_dynamic_page' 
 104