/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