1# -*- tcl -*-
2# ### ### ### ######### ######### #########
3
4## This package provides custom plugin management specific to PAGE. It
5## is built on top of the generic plugin management framework (See
6## ---> pluginmgr).
7
8# ### ### ### ######### ######### #########
9## Requisites
10
11package require fileutil
12package require pluginmgr           ; # Generic plugin management framework
13
14namespace eval ::page::pluginmgr {}
15
16# ### ### ### ######### ######### #########
17## API (Public, exported)
18
19proc ::page::pluginmgr::reportvia {cmd} {
20    variable reportcmd $cmd
21    return
22}
23
24proc ::page::pluginmgr::log {cmd} {
25    variable reader
26    variable writer
27    variable transforms
28
29    set     iplist {}
30    lappend iplist [$reader interpreter]
31    lappend iplist [$writer interpreter]
32    foreach t $transforms {
33	lappend iplist [$t interpreter]
34    }
35
36    if {$cmd eq ""} {
37	# No logging. Disable with empty command,
38	# to allow the system to completely remove
39	# them from the bytecode (= No execution
40	# overhead).
41
42	foreach ip $iplist {
43	    $ip eval [list proc page_log_error   args {}]
44	    $ip eval [list proc page_log_warning args {}]
45	    $ip eval [list proc page_log_info    args {}]
46	}
47    } else {
48	# Activate logging. Make the commands in
49	# the interpreters aliases to us.
50
51	foreach ip $iplist {
52	    interp alias $ip page_log_error   {} ${cmd}::error
53	    interp alias $ip page_log_warning {} ${cmd}::warning
54	    interp alias $ip page_log_info    {} ${cmd}::info
55	}
56    }
57    return
58}
59
60proc ::page::pluginmgr::reader {name} {
61    variable reader
62
63    $reader load $name
64    return [$reader do page_roptions]
65}
66
67proc ::page::pluginmgr::rconfigure {dict} {
68    variable reader
69    foreach {k v} $dict {
70	$reader do page_rconfigure $k $v
71    }
72    return
73}
74
75proc ::page::pluginmgr::rtimeable {} {
76    variable reader
77    return [$reader do page_rfeature timeable]
78}
79
80proc ::page::pluginmgr::rtime {} {
81    variable reader
82    $reader do page_rtime
83    return
84}
85
86proc ::page::pluginmgr::rgettime {} {
87    variable reader
88    return [$reader do page_rgettime]
89}
90
91proc ::page::pluginmgr::rhelp {} {
92    variable reader
93    return [$reader do page_rhelp]
94}
95
96proc ::page::pluginmgr::rlabel {} {
97    variable reader
98    return [$reader do page_rlabel]
99}
100
101proc ::page::pluginmgr::read {read eof {complete {}}} {
102    variable reader
103
104    #interp alias $ip page_read {} {*}$read
105    #interp alias $ip page_eof  {} {*}$eof
106
107    set ip [$reader interpreter]
108    eval [linsert $read 0 interp alias $ip page_read {}]
109    eval [linsert $eof  0 interp alias $ip page_eof  {}]
110
111    if {![llength $complete]} {
112	interp alias $ip page_read_done {} ::page::pluginmgr::Nop
113    } else {
114	eval [linsert $complete  0 interp alias $ip page_read_done  {}]
115    }
116
117    return [$reader do page_rrun]
118}
119
120proc ::page::pluginmgr::writer {name} {
121    variable writer
122
123    $writer load $name
124    return [$writer do page_woptions]
125}
126
127proc ::page::pluginmgr::wconfigure {dict} {
128    variable writer
129    foreach {k v} $dict {
130	$writer do page_wconfigure $k $v
131    }
132    return
133}
134
135proc ::page::pluginmgr::wtimeable {} {
136    variable writer
137    return [$writer do page_wfeature timeable]
138}
139
140proc ::page::pluginmgr::wtime {} {
141    variable writer
142    $writer do page_wtime
143    return
144}
145
146proc ::page::pluginmgr::wgettime {} {
147    variable writer
148    return [$writer do page_wgettime]
149}
150
151proc ::page::pluginmgr::whelp {} {
152    variable writer
153    return [$writer do page_whelp]
154}
155
156proc ::page::pluginmgr::wlabel {} {
157    variable writer
158    return [$writer do page_wlabel]
159}
160
161proc ::page::pluginmgr::write {chan data} {
162    variable writer
163
164    $writer do page_wrun $chan $data
165    return
166}
167
168proc ::page::pluginmgr::transform {name} {
169    variable transform
170    variable transforms
171
172    $transform load $name
173
174    set id [llength $transforms]
175    set opt [$transform do page_toptions]
176    lappend transforms [$transform clone]
177
178    return [list $id $opt]
179}
180
181proc ::page::pluginmgr::tconfigure {id dict} {
182    variable transforms
183
184    set t [lindex $transforms $id]
185
186    foreach {k v} $dict {
187	$t do page_tconfigure $k $v
188    }
189    return
190}
191
192proc ::page::pluginmgr::ttimeable {id} {
193    variable transforms
194    set t [lindex $transforms $id]
195    return [$t do page_tfeature timeable]
196}
197
198proc ::page::pluginmgr::ttime {id} {
199    variable transforms
200    set t [lindex $transforms $id]
201    $t do page_ttime
202    return
203}
204
205proc ::page::pluginmgr::tgettime {id} {
206    variable transforms
207    set t [lindex $transforms $id]
208    return [$t do page_tgettime]
209}
210
211proc ::page::pluginmgr::thelp {id} {
212    variable transforms
213    set t [lindex $transforms $id]
214    return [$t do page_thelp]
215}
216
217proc ::page::pluginmgr::tlabel {id} {
218    variable transforms
219    set t [lindex $transforms $id]
220    return [$t do page_tlabel]
221}
222
223proc ::page::pluginmgr::transform_do {id data} {
224    variable transforms
225    variable reader
226
227    set t [lindex $transforms $id]
228
229    return [$t do page_trun $data]
230}
231
232proc ::page::pluginmgr::configuration {name} {
233    variable config
234
235    if {[file exists $name]} {
236	# Try as plugin first. On failure read it as list of options,
237	# separated by spaces and tabs, and possibly quoted with
238	# quotes and double-quotes.
239
240	if {[catch {$config load $name}]} {
241	    set ch      [open $name r]
242	    set options [::read $ch]
243	    close $ch
244
245	    set def {}
246	    while {[string length $options]} {
247		if {[regsub "^\[ \t\n\]+" $options {} options]} {
248		    # Skip whitespace
249		    continue
250		}
251		if {[regexp -indices {^'(([^']|(''))*)'} \
252			$options -> word]} {
253		    foreach {__ end} $word break
254		    lappend def [string map {'' '} [string range $options 1 $end]]
255		    set options [string range $options [incr end 2] end]
256		} elseif {[regexp -indices {^"(([^"]|(""))*)"} \
257			$options -> word]} {
258		    foreach {__ end} $word break
259		    lappend def [string map {{""} {"}} [string range $options 1 $end]]
260		    set options [string range $options [incr end 2] end]
261		} elseif {[regexp -indices "^(\[^ \t\n\]+)" \
262			$options -> word]} {
263		    foreach {__ end} $word break
264		    lappend def [string range $options 0 $end]
265		    set options [string range $options [incr end] end]
266		}
267	    }
268	    return $def
269	}
270    } else {
271	$config load $name
272    }
273    set def [$config do page_cdefinition]
274    $config unload
275    return $def
276}
277
278proc ::page::pluginmgr::report {level text {from {}} {to {}}} {
279    variable replevel
280    variable reportcmd
281    uplevel #0 [linsert $reportcmd end $replevel($level) $text $from $to]
282    return
283}
284
285# ### ### ### ######### ######### #########
286## Internals
287
288## Data structures
289##
290## - reader    | Instances of pluginmgr configured for input,
291## - transform | transformational, and output plugins. The
292## - writer    | manager for transforms is actually a template
293##             | from which the actual instances are cloned.
294
295## - reportcmd | Callback for reporting of input error and warnings.
296## - replevel  | Mapping from chosen level to the right-padded text
297##             | to use.
298
299namespace eval ::page::pluginmgr {
300    variable  replevel
301    array set replevel {
302	info    {info   }
303	warning {warning}
304	error   {error  }
305    }
306}
307
308proc ::page::pluginmgr::Initialize {} {
309    InitializeReporting
310    InitializeConfig
311    InitializeReader
312    InitializeTransform
313    InitializeWriter
314    return
315}
316
317proc ::page::pluginmgr::InitializeReader {} {
318    variable commands
319    variable reader_api
320    variable reader [pluginmgr RD \
321	    -setup   ::page::pluginmgr::InitializeReaderIp \
322	    -pattern page::reader::* \
323	    -api     $reader_api \
324	    -cmdip   {} \
325	    -cmds    $commands]
326
327    # The page_log_* commands are set later, when it is known if
328    # logging is active or not, as their implementation depends on
329    # this.
330
331    pluginmgr::paths $reader page::reader
332    return
333}
334
335proc ::page::pluginmgr::InitializeReaderIp {p ip} {
336    interp eval $ip {
337	# @sak notprovided page::plugin
338	# @sak notprovided page::plugin::reader
339	package provide page::plugin         1.0
340	package provide page::plugin::reader 1.0
341    }
342    interp alias $ip puts  {} puts
343    interp alias $ip open  {} ::page::pluginmgr::AliasOpen $ip
344    interp alias $ip write {} ::page::pluginmgr::WriteFile $ip
345    return
346}
347
348proc ::page::pluginmgr::InitializeWriter {} {
349    variable commands
350    variable writer_api
351    variable writer [pluginmgr WR \
352	    -setup   ::page::pluginmgr::InitializeWriterIp \
353	    -pattern page::writer::* \
354	    -api     $writer_api \
355	    -cmdip   {} \
356	    -cmds    $commands]
357
358    # The page_log_* commands are set later, when it is known if
359    # logging is active or not, as their implementation depends on
360    # this.
361
362    pluginmgr::paths $writer page::writer
363    return
364}
365
366proc ::page::pluginmgr::InitializeWriterIp {p ip} {
367    interp eval $ip {
368	# @sak notprovided page::plugin
369	# @sak notprovided page::plugin::writer
370	package provide page::plugin         1.0
371	package provide page::plugin::writer 1.0
372    }
373    interp alias $ip puts  {} puts
374    interp alias $ip open  {} ::page::pluginmgr::AliasOpen $ip
375    interp alias $ip write {} ::page::pluginmgr::WriteFile $ip
376    return
377}
378
379proc ::page::pluginmgr::InitializeTransform {} {
380    variable transforms {}
381    variable commands
382    variable transform_api
383    variable transform [pluginmgr TR \
384	    -setup   ::page::pluginmgr::InitializeTransformIp \
385	    -pattern page::transform::* \
386	    -api     $transform_api \
387	    -cmdip   {} \
388	    -cmds    $commands]
389
390    # The page_log_* commands are set later, when it is known if
391    # logging is active or not, as their implementation depends on
392    # this.
393
394    pluginmgr::paths $transform page::transform
395    return
396}
397
398proc ::page::pluginmgr::InitializeTransformIp {p ip} {
399    interp eval $ip {
400	# @sak notprovided page::plugin
401	# @sak notprovided page::plugin::transform
402	package provide page::plugin            1.0
403	package provide page::plugin::transform 1.0
404    }
405    interp alias $ip puts  {} puts
406    interp alias $ip open  {} ::page::pluginmgr::AliasOpen $ip
407    interp alias $ip write {} ::page::pluginmgr::WriteFile $ip
408    return
409}
410
411proc ::page::pluginmgr::InitializeConfig {} {
412    variable config [pluginmgr CO \
413	    -pattern page::config::* \
414	    -api {page_cdefinition}]
415
416    pluginmgr::paths $config page::config
417    return
418}
419
420proc ::page::pluginmgr::InitializeReporting {} {
421    variable reportcmd ::page::pluginmgr::ReportStderr
422    return
423}
424
425proc ::page::pluginmgr::ReportStderr {level text from to} {
426    # from = epsilon | list (line col)
427    # to   = epsilon | list (line col)
428    # line = 5 digits, col = 3 digits
429
430    if {
431	($text eq "") &&
432	![llength $from] &&
433	![llength $to]
434    } {
435	puts stderr ""
436	return
437    }
438
439    puts -nonewline stderr $level
440    WriteLocation $from
441    if {![llength $to]} {
442	puts -nonewline stderr { }
443    } else {
444	puts -nonewline stderr {-}
445    }
446    WriteLocation $to
447    puts -nonewline stderr " "
448    puts -nonewline stderr $text
449    puts stderr ""
450    return
451}
452
453proc ::page::pluginmgr::WriteLocation {loc} {
454    if {![llength $loc]} {
455	set text {         }
456    } else {
457	set line [lindex $loc 0]
458	set col  [lindex $loc 1]
459	set text {}
460	if {![string length $line]} {
461	    append text _____
462	} else {
463	    append text [string map {{ } _} [format %5d $line]]
464	}
465	append text @
466	if {![string length $col]} {
467	    append text ___
468	} else {
469	    append text [string map {{ } _} [format %3d $col]]
470	}
471    }
472    puts -nonewline stderr $text
473    return
474}
475
476proc ::page::pluginmgr::AliasOpen {slave file {acc {}} {perm {}}} {
477
478    if {$acc eq ""} {set acc r}
479
480    ::safe::Log $slave =============================================
481    ::safe::Log $slave "open $file $acc $perm"
482
483    if {[regexp {[wa+]|(WRONLY)|(RDWR)|(APPEND)|(CREAT)|(TRUNC)} $acc]} {
484	# Do not allow write acess.
485	::safe::Log $slave "permission denied"
486	::safe::Log $slave 0/============================================
487	return -code error "permission denied"
488    }
489
490    if {[catch {set file [::safe::TranslatePath $slave $file]} msg]} {
491	::safe::Log $slave $msg
492	::safe::Log $slave "permission denied"
493	::safe::Log $slave 1/============================================
494	return -code error "permission denied"
495    }
496
497    # check that the path is in the access path of that slave
498
499    if {[catch {::safe::FileInAccessPath $slave $file} msg]} {
500	::safe::Log $slave $msg
501	::safe::Log $slave "permission denied"
502	::safe::Log $slave 2/============================================
503	return -code error "permission denied"
504    }
505
506    # do the checks on the filename :
507
508    if {[catch {::safe::CheckFileName $slave $file} msg]} {
509	::safe::Log $slave "$file: $msg"
510	::safe::Log $slave "$msg"
511	::safe::Log $slave 3/============================================
512	return -code error $msg
513    }
514
515    if {[catch {::interp invokehidden $slave open $file $acc} msg]} {
516	::safe::Log $slave "Caught: $msg"
517	::safe::Log $slave "script error"
518	::safe::Log $slave 4/============================================
519	return -code error "script error"
520    }
521
522    ::safe::Log $slave =/============================================
523    return $msg
524
525}
526
527proc ::page::pluginmgr::Nop {args} {}
528
529proc ::page::pluginmgr::WriteFile {slave file text} {
530    if {[file pathtype $file] ne "relative"} {
531	set file [file join [pwd] [file tail $fail]]
532    }
533    file mkdir [file dirname $file]
534    fileutil::writeFile      $file $text
535    return
536}
537
538# ### ### ### ######### ######### #########
539## Initialization
540
541namespace eval ::page::pluginmgr {
542
543    # List of functions in the various plugin APIs
544
545    variable reader_api {
546	page_rhelp
547	page_rlabel
548	page_roptions
549	page_rconfigure
550	page_rrun
551	page_rfeature
552    }
553    variable writer_api {
554	page_whelp
555	page_wlabel
556	page_woptions
557	page_wconfigure
558	page_wrun
559	page_wfeature
560    }
561    variable transform_api {
562	page_thelp
563	page_tlabel
564	page_toptions
565	page_tconfigure
566	page_trun
567	page_tfeature
568    }
569    variable commands {
570	page_info    {::page::pluginmgr::report info}
571	page_warning {::page::pluginmgr::report warning}
572	page_error   {::page::pluginmgr::report error}
573    }
574}
575
576::page::pluginmgr::Initialize
577
578# ### ### ### ######### ######### #########
579## Ready
580
581package provide page::pluginmgr 0.2
582