page/pluginmgr.tcl

Go to the documentation of this file.

/*  -*- tcl -*-*/
/*  ### ### ### ######### ######### #########*/

/*  This package provides custom plugin management specific to PAGE. It*/
/*  is built on top of the generic plugin management framework (See*/
/*  ---> pluginmgr).*/

/*  ### ### ### ######### ######### #########*/
/*  Requisites*/

package require fileutil
package require pluginmgr           ; /*  Generic plugin management framework*/

namespace ::page::pluginmgr {}

/*  ### ### ### ######### ######### #########*/
/*  API (Public, exported)*/

ret  ::page::pluginmgr::reportvia (type cmd) {
    variable reportcmd $cmd
    return
}

ret  ::page::pluginmgr::log (type cmd) {
    variable reader
    variable writer
    variable transforms

    set     iplist {}
    lappend iplist [$reader interpreter]
    lappend iplist [$writer interpreter]
    foreach t $transforms {
    lappend iplist [$t interpreter]
    }

    if {$cmd eq ""} {
    # No logging. Disable with empty command,
    # to allow the system to completely remove
    # them from the bytecode (= No execution
    # overhead).

    foreach ip $iplist {
        $ip eval [list proc page_log_error   args {}]
        $ip eval [list proc page_log_warning args {}]
        $ip eval [list proc page_log_info    args {}]
    }
    } else {
    # Activate logging. Make the commands in
    # the interpreters aliases to us.

    foreach ip $iplist {
        interp alias $ip page_log_error   {} ${cmd}::error
        interp alias $ip page_log_warning {} ${cmd}::warning
        interp alias $ip page_log_info    {} ${cmd}::info
    }
    }
    return
}

ret  ::page::pluginmgr::reader (type name) {
    variable reader

    $reader load $name
    return [$reader do page_roptions]
}

ret  ::page::pluginmgr::rconfigure (type dict) {
    variable reader
    foreach {k v} $dict {
    $reader do page_rconfigure $k $v
    }
    return
}

ret  ::page::pluginmgr::rtimeable () {
    variable reader
    return [$reader do page_rfeature timeable]
}

ret  ::page::pluginmgr::rtime () {
    variable reader
    $reader do page_rtime
    return
}

ret  ::page::pluginmgr::rgettime () {
    variable reader
    return [$reader do page_rgettime]
}

ret  ::page::pluginmgr::rhelp () {
    variable reader
    return [$reader do page_rhelp]
}

ret  ::page::pluginmgr::rlabel () {
    variable reader
    return [$reader do page_rlabel]
}

ret  ::page::pluginmgr::read (type read , type eof , optional complete ={)} {
    variable reader

    #interp alias $ip page_read {} {*}$read
    /* interp alias $ip page_eof  {} {*}$eof*/

     ip =  [$reader interpreter]
    eval [linsert $read 0 interp alias $ip page_read {}]
    eval [linsert $eof  0 interp alias $ip page_eof  {}]

    if {![llength $complete]} {
    interp alias $ip page_read_done {} ::page::pluginmgr::Nop
    } else {
    eval [linsert $complete  0 interp alias $ip page_read_done  {}]
    }

    return [$reader do page_rrun]
}

ret  ::page::pluginmgr::writer (type name) {
    variable writer

    $writer load $name
    return [$writer do page_woptions]
}

ret  ::page::pluginmgr::wconfigure (type dict) {
    variable writer
    foreach {k v} $dict {
    $writer do page_wconfigure $k $v
    }
    return
}

ret  ::page::pluginmgr::wtimeable () {
    variable writer
    return [$writer do page_wfeature timeable]
}

ret  ::page::pluginmgr::wtime () {
    variable writer
    $writer do page_wtime
    return
}

ret  ::page::pluginmgr::wgettime () {
    variable writer
    return [$writer do page_wgettime]
}

ret  ::page::pluginmgr::whelp () {
    variable writer
    return [$writer do page_whelp]
}

ret  ::page::pluginmgr::wlabel () {
    variable writer
    return [$writer do page_wlabel]
}

ret  ::page::pluginmgr::write (type chan , type data) {
    variable writer

    $writer do page_wrun $chan $data
    return
}

ret  ::page::pluginmgr::transform (type name) {
    variable transform
    variable transforms

    $transform load $name

    set id [llength $transforms]
    set opt [$transform do page_toptions]
    lappend transforms [$transform clone]

    return [list $id $opt]
}

ret  ::page::pluginmgr::tconfigure (type id , type dict) {
    variable transforms

    set t [lindex $transforms $id]

    foreach {k v} $dict {
    $t do page_tconfigure $k $v
    }
    return
}

ret  ::page::pluginmgr::ttimeable (type id) {
    variable transforms
    set t [lindex $transforms $id]
    return [$t do page_tfeature timeable]
}

ret  ::page::pluginmgr::ttime (type id) {
    variable transforms
    set t [lindex $transforms $id]
    $t do page_ttime
    return
}

ret  ::page::pluginmgr::tgettime (type id) {
    variable transforms
    set t [lindex $transforms $id]
    return [$t do page_tgettime]
}

ret  ::page::pluginmgr::thelp (type id) {
    variable transforms
    set t [lindex $transforms $id]
    return [$t do page_thelp]
}

ret  ::page::pluginmgr::tlabel (type id) {
    variable transforms
    set t [lindex $transforms $id]
    return [$t do page_tlabel]
}

ret  ::page::pluginmgr::transform_do (type id , type data) {
    variable transforms
    variable reader

    set t [lindex $transforms $id]

    return [$t do page_trun $data]
}

ret  ::page::pluginmgr::configuration (type name) {
    variable config

    if {[file exists $name]} {
    # Try as plugin first. On failure read it as list of options,
    # separated by spaces and tabs, and possibly quoted with
    # quotes and double-quotes.

    if {[catch {$config load $name}]} {
        set ch      [open $name r]
        set options [::read $ch]
        close $ch

        set def {}
        while {[string length $options]} {
        if {[regsub "^\[ \t\n\]+" $options {} options]} {
            # Skip whitespace
            continue
        }
        if {[regexp -indices {^'(([^']|(''))*)'} \
            $options -> word]} {
            foreach {__ end} $word break
            lappend def [string map {'' '} [string range $options 1 $end]]
            set options [string range $options [incr end 2] end]
        } elseif {[regexp -indices {^"(([^"]|(""))*)"} \
            $options -> word]} {
            foreach {__ end} $word break
            lappend def [string map {{""} {"}} [string range $options 1 $end]]
            set options [string range $options [incr end 2] end]
        } elseif {[regexp -indices "^(\[^ \t\n\]+)" \
            $options -> word]} {
            foreach {__ end} $word break
            lappend def [string range $options 0 $end]
            set options [string range $options [incr end] end]
        }
        }
        return $def
    }
    } else {
    $config load $name
    }
    set def [$config do page_cdefinition]
    $config unload
    return $def
}

ret  ::page::pluginmgr::report (type level , type text , optional from ={) {to {}}} {
    variable replevel
    variable reportcmd
    uplevel /* 0 [linsert $reportcmd end $replevel($level) $text $from $to]*/
    return
}

/*  ### ### ### ######### ######### #########*/
/*  Internals*/

/*  Data structures*/
/** 
 *# - reader    | Instances of pluginmgr configured for input,
 *# - transform | transformational, and output plugins. The
 *# - writer    | manager for transforms is actually a template
 *#             | from which the actual instances are cloned.
 */

/*  - reportcmd | Callback for reporting of input error and warnings.*/
/*  - replevel  | Mapping from chosen level to the right-padded text*/
/*              | to use.*/

namespace ::page::pluginmgr {
    variable  replevel
    array  replevel =  {
    info    {info   }
    warning {warning}
    error   {error  }
    }
}

ret  ::page::pluginmgr::Initialize () {
    InitializeReporting
    InitializeConfig
    InitializeReader
    InitializeTransform
    InitializeWriter
    return
}

ret  ::page::pluginmgr::InitializeReader () {
    variable commands
    variable reader_api
    variable reader [pluginmgr RD \
        -setup   ::page::pluginmgr::InitializeReaderIp \
        -pattern page::reader::* \
        -api     $reader_api \
        -cmdip   {} \
        -cmds    $commands]

    # The page_log_* commands are set later, when it is known if
    # logging is active or not, as their implementation depends on
    # this.

    pluginmgr::paths $reader page::reader
    return
}

ret  ::page::pluginmgr::InitializeReaderIp (type p , type ip) {
    interp eval $ip {
    package provide page::plugin         1.0
    package provide page::plugin::reader 1.0
    }
    interp alias $ip puts  {} puts
    interp alias $ip open  {} ::page::pluginmgr::AliasOpen $ip
    interp alias $ip write {} ::page::pluginmgr::WriteFile $ip
    return
}

ret  ::page::pluginmgr::InitializeWriter () {
    variable commands
    variable writer_api
    variable writer [pluginmgr WR \
        -setup   ::page::pluginmgr::InitializeWriterIp \
        -pattern page::writer::* \
        -api     $writer_api \
        -cmdip   {} \
        -cmds    $commands]

    # The page_log_* commands are set later, when it is known if
    # logging is active or not, as their implementation depends on
    # this.

    pluginmgr::paths $writer page::writer
    return
}

ret  ::page::pluginmgr::InitializeWriterIp (type p , type ip) {
    interp eval $ip {
    package provide page::plugin         1.0
    package provide page::plugin::writer 1.0
    }
    interp alias $ip puts  {} puts
    interp alias $ip open  {} ::page::pluginmgr::AliasOpen $ip
    interp alias $ip write {} ::page::pluginmgr::WriteFile $ip
    return
}

ret  ::page::pluginmgr::InitializeTransform () {
    variable transforms {}
    variable commands
    variable transform_api
    variable transform [pluginmgr TR \
        -setup   ::page::pluginmgr::InitializeTransformIp \
        -pattern page::transform::* \
        -api     $transform_api \
        -cmdip   {} \
        -cmds    $commands]

    # The page_log_* commands are set later, when it is known if
    # logging is active or not, as their implementation depends on
    # this.

    pluginmgr::paths $transform page::transform
    return
}

ret  ::page::pluginmgr::InitializeTransformIp (type p , type ip) {
    interp eval $ip {
    package provide page::plugin            1.0
    package provide page::plugin::transform 1.0
    }
    interp alias $ip puts  {} puts
    interp alias $ip open  {} ::page::pluginmgr::AliasOpen $ip
    interp alias $ip write {} ::page::pluginmgr::WriteFile $ip
    return
}

ret  ::page::pluginmgr::InitializeConfig () {
    variable config [pluginmgr CO \
        -pattern page::config::* \
        -api {page_cdefinition}]

    pluginmgr::paths $config page::config
    return
}

ret  ::page::pluginmgr::InitializeReporting () {
    variable reportcmd ::page::pluginmgr::ReportStderr
    return
}

ret  ::page::pluginmgr::ReportStderr (type level , type text , type from , type to) {
    # from = epsilon | list (line col)
    # to   = epsilon | list (line col)
    # line = 5 digits, col = 3 digits

    if {
    ($text eq "") &&
    ![llength $from] &&
    ![llength $to]
    } {
    puts stderr ""
    return
    }

    puts -nonewline stderr $level
    WriteLocation $from
    if {![llength $to]} {
    puts -nonewline stderr { }
    } {
    puts -nonewline stderr {-}
    }
    WriteLocation $to
    puts -nonewline stderr " "
    puts -nonewline stderr $text
    puts stderr ""
    return
}

ret  ::page::pluginmgr::WriteLocation (type loc) {
    if {![llength $loc]} {
    set text {         }
    } else {
    set line [lindex $loc 0]
    set col  [lindex $loc 1]
    set text {}
    if {![string length $line]} {
        append text _____
    } else {
        append text [string map {{ } _} [format %5d $line]]
    }
    append text @
    if {![string length $col]} {
        append text ___
    } else {
        append text [string map {{ } _} [format %3d $col]]
    }
    }
    puts -nonewline stderr $text
    return
}

ret  ::page::pluginmgr::AliasOpen (type slave , type file , optional acc ={) {perm {}}} {

    if {$acc eq ""} { acc =  r}

    ::safe::Log $slave =============================================
    ::safe::Log $slave "open $file $acc $perm"

    if {[regexp {[wa+]|(WRONLY)|(RDWR)|(APPEND)|(CREAT)|(TRUNC)} $acc]} {
    /*  Do not allow write acess.*/
    ::safe::Log $slave "permission denied"
    ::safe::Log $slave 0/============================================
    return -code error "permission denied"
    }

    if {[catch { file =  [::safe::TranslatePath $slave $file]} msg]} {
    ::safe::Log $slave $msg
    ::safe::Log $slave "permission denied"
    ::safe::Log $slave 1/============================================
    return -code error "permission denied"
    }
    
    /*  check that the path is in the access path of that slave*/

    if {[catch {::safe::FileInAccessPath $slave $file} msg]} {
    ::safe::Log $slave $msg
    ::safe::Log $slave "permission denied"
    ::safe::Log $slave 2/============================================
    return -code error "permission denied"
    }

    /*  do the checks on the filename :*/

    if {[catch {::safe::CheckFileName $slave $file} msg]} {
    ::safe::Log $slave "$file: $msg"
    ::safe::Log $slave "$msg"
    ::safe::Log $slave 3/============================================
    return -code error $msg
    }

    if {[catch {::interp invokehidden $slave open $file $acc} msg]} {
    ::safe::Log $slave "Caught: $msg"
    ::safe::Log $slave "script error"
    ::safe::Log $slave 4/============================================
    return -code error "script error"
    }

    ::safe::Log $slave =/============================================
    return $msg

}

ret  ::page::pluginmgr::Nop (type args) {}

ret  ::page::pluginmgr::WriteFile (type slave , type file , type text) {
    if {[file pathtype $file] ne "relative"} {
    set file [file join [pwd] [file tail $fail]]
    }
    file mkdir [file dirname $file]
    fileutil::writeFile      $file $text
    return
}

/*  ### ### ### ######### ######### #########*/
/*  Initialization*/

namespace ::page::pluginmgr {

    /*  List of functions in the various plugin APIs*/

    variable reader_api {
    page_rhelp
    page_rlabel
    page_roptions
    page_rconfigure
    page_rrun
    page_rfeature
    }
    variable writer_api {
    page_whelp
    page_wlabel
    page_woptions
    page_wconfigure
    page_wrun
    page_wfeature
    }
    variable transform_api {
    page_thelp
    page_tlabel
    page_toptions
    page_tconfigure
    page_trun
    page_tfeature
    }
    variable commands {
    page_info    {::page::pluginmgr::report info}
    page_warning {::page::pluginmgr::report warning}
    page_error   {::page::pluginmgr::report error}
    }
}

::page::pluginmgr::Initialize

/*  ### ### ### ######### ######### #########*/
/*  Ready*/

package provide page::pluginmgr 0.2