ATWF A Tcl Web Framwork

Check-in [8dd8c9b485]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:fixes for application and added test_apptool directory

git-svn-id: https://atwf.svn.sourceforge.net/svnroot/atwf@615 3ddb7fe1-eb8e-4980-8f37-d9e37380b5db

Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:8dd8c9b48550657c8b5a2a3a5ca5db8c55118a8a
User & Date: arnulf@wiedemann-pri.de 2010-12-05 18:43:08
Context
2010-12-12
12:43
initial version

git-svn-id: https://atwf.svn.sourceforge.net/svnroot/atwf@616 3ddb7fe1-eb8e-4980-8f37-d9e37380b5db check-in: b6c4ac9ed0 user: arnulf@wiedemann-pri.de tags: trunk

2010-12-05
18:43
fixes for application and added test_apptool directory

git-svn-id: https://atwf.svn.sourceforge.net/svnroot/atwf@615 3ddb7fe1-eb8e-4980-8f37-d9e37380b5db check-in: 8dd8c9b485 user: arnulf@wiedemann-pri.de tags: trunk

16:54
small fixes

git-svn-id: https://atwf.svn.sourceforge.net/svnroot/atwf@614 3ddb7fe1-eb8e-4980-8f37-d9e37380b5db check-in: 4204f29af9 user: arnulf@wiedemann-pri.de tags: trunk

Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to application/configs/application.ini.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
; this is an example ini file
; Production site configuration data

[app]
webhost           = wiedeman-pri.de
title		  = Arnulf's Tcl Web Framework
includePaths.library  = @APPLICATION_PATH@/../library/ATWF/
includePaths.models   = @APPLICATION_PATH@/models/ @APPLICATION_PATH@/models/DbTable/
bootstrap.path        = @APPLICATION_PATH@/Bootstrap.tcl
bootstrap.class       = ::Bootstrap
resources.frontController.controllerDirectory = @APPLICATION_PATH@/controllers
resources.frontController.moduleDirectory = @APPLICATION_PATH@/modules2
resources.frontController.moduleDirectory = @APPLICATION_PATH@/modules
resources.layout.layoutpath  = @APPLICATION_PATH@/layouts
resources.db.params.host     = localhost
resources.db.params.username = arnulf
resources.db.params.password = 
resources.db.params.port     = 3306
resources.db.params.dbname   = atwf_test







|



|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
; this is an example ini file
; Production site configuration data

[app]
webhost           = wiedeman-pri.de
title		  = Arnulf's Tcl Web Framework
includePaths.library  = @APPLICATION_PATH@/../library/ATWF/
includePaths.models   = @APPLICATION_PATH@/models/ @APPLICATION_PATH@/models/DbTable/ @APPLICATION_PATH@/models/DbTables/ @APPLICATION_PATH@/modules/apptool/models @APPLICATION_PATH@/modules/apptool/models/DbTable
bootstrap.path        = @APPLICATION_PATH@/Bootstrap.tcl
bootstrap.class       = ::Bootstrap
resources.frontController.controllerDirectory = @APPLICATION_PATH@/controllers
#resources.frontController.moduleDirectory = @APPLICATION_PATH@/modules2
resources.frontController.moduleDirectory = @APPLICATION_PATH@/modules
resources.layout.layoutpath  = @APPLICATION_PATH@/layouts
resources.db.params.host     = localhost
resources.db.params.username = arnulf
resources.db.params.password = 
resources.db.params.port     = 3306
resources.db.params.dbname   = atwf_test

Changes to application/controllers/IndexController.tcl.

1
2
3
4
5
6
7
8
9
10
11
..
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30


31
32
33
34
35
36
37
38
39
40
41
namespace eval ::ATWF {

::itcl::class IndexController {
    inherit ::ATWF::Controller::Action

    constructor {request response {invokeArgs {}}} {
#puts "application!IndexController!constructor!"
        chain $request $response $invokeArgs
    } {}

    public method init {}
................................................................................
::itcl::body IndexController::constructor {request response {invokeArgs {}}} {
}

::itcl::body IndexController::init {} {
    # switch output to xml
    set contextSwitch [$_helper getHelper ContextSwitch]
    $contextSwitch addActionContext index xml
    $contextSwitch initContext xml
    $contextSwitch initContext

}

::itcl::body IndexController::indexAction {} {
if {[catch {
    set people_obj [::Application::Model::DbTable::People]


    set rows [$people_obj getRows [list "id > ?" 47 "ID < ? " 56]]

    $view VarSet var1 "hallo Arnulf!"
    $view VarSet rows $rows
} msg]} {
    puts "MSG![self class]![self method]!$msg!<br>"
}
}


}



|







 







|






|
>
>
|










1
2
3
4
5
6
7
8
9
10
11
..
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
namespace eval ::ATWF {

::itcl::class IndexController {
    inherit ::ATWF::Controllers::Action

    constructor {request response {invokeArgs {}}} {
#puts "application!IndexController!constructor!"
        chain $request $response $invokeArgs
    } {}

    public method init {}
................................................................................
::itcl::body IndexController::constructor {request response {invokeArgs {}}} {
}

::itcl::body IndexController::init {} {
    # switch output to xml
    set contextSwitch [$_helper getHelper ContextSwitch]
    $contextSwitch addActionContext index xml
#    $contextSwitch initContext xml
    $contextSwitch initContext

}

::itcl::body IndexController::indexAction {} {
if {[catch {
source /home/arnulf/SOURCES/TCL/ATWF/application/models/DbTables/People.tcl
    set people_obj [uplevel #0 ::Applications::Models::DbTables::People #auto]
puts stderr "people_obj!$people_obj!"
    set rows [$people_obj getRows [list "id > ?" 10 "ID < ? " 100]]

    $view VarSet var1 "hallo Arnulf!"
    $view VarSet rows $rows
} msg]} {
    puts "MSG![self class]![self method]!$msg!<br>"
}
}


}

Changes to application/controllers/PeopleController.tcl.

13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
..
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
#*
#*  Author: Arnulf Wiedemann
#*
#*  Contributor(s): 
#*
#************************************************************************/

source $::ATWF::LIBRARY_DIR/ActionController.tcl

::itcl::extendedclass PeopleController {
    inherit ::ATWF::library::ActionController

    private variable _db_table_obj ""

    constructor {args} {}

    public method init {args}
    public method indexAction {args}
................................................................................
    public method peopleAction {args}
}

::itcl::body PeopleController::constructor {args} {
}

::itcl::body PeopleController::init {args} {
    set _db_table_obj [::ATWF::library::ActionController::init people]
    $_db_table_obj init
#    $_db_table_obj setPrimaryKey id
}

::itcl::body PeopleController::indexAction {args} {
    set view_infos(title) "people/index Action"
    set view_infos(people) [$db_table_obj fetchRows "AND id > 5" dicts]







|


|







 







|







13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
..
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
#*
#*  Author: Arnulf Wiedemann
#*
#*  Contributor(s): 
#*
#************************************************************************/

#source $::ATWF::LIBRARY_DIR/ActionController.tcl

::itcl::extendedclass PeopleController {
    inherit ::ATWF::ActionController

    private variable _db_table_obj ""

    constructor {args} {}

    public method init {args}
    public method indexAction {args}
................................................................................
    public method peopleAction {args}
}

::itcl::body PeopleController::constructor {args} {
}

::itcl::body PeopleController::init {args} {
    set _db_table_obj [::ATWF::ActionController::init people]
    $_db_table_obj init
#    $_db_table_obj setPrimaryKey id
}

::itcl::body PeopleController::indexAction {args} {
    set view_infos(title) "people/index Action"
    set view_infos(people) [$db_table_obj fetchRows "AND id > 5" dicts]

Changes to application/layouts/layout.thtml.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
<?xml version="1.0" encoding="UTF-8" ?>\n
% set rows [$this VarGet rows]
% set cnt [$rows count]
% puts stderr "cnt!$cnt!"
% set row_num 0
  <rows>
% while {$row_num < $cnt} {
%   set row [$rows getRow $row_num]
    <row>
      <rownum>$row_num</rownum>\n
%   foreach name [list id surname firstname created modified info] {
      <field>
        <name>$name</name>
        <value>[$row __get $name]</value>
      </field>\n
%   }
%    incr row_num
    </row>\n
% }
  </rows>

|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
<
<
<
<
<
<
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15






% puts stderr "layout.thtml![getHelpers]!"
% puts stderr "layout!container![VarGet container]!"
% set content ""
% set my_var [VarGet container]
% if {[dict exists $my_var content]} {
%   set my_info [dict get $my_var content]
%   set content [dict get $my_info content]
% puts stderr "content!$content!"
%}
<?xml version="1.0" encoding="UTF-8" ?>
<pre>
$content
</pre>
% puts stderr "layout.thtml end!"







Changes to application/models/DbTable/People.tcl.

13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
#*
#*  Author: Arnulf Wiedemann
#*
#*  Contributor(s): 
#*
#************************************************************************/

::itcl::extendedclass ::Application::Model::DbTable::People {
    inherit ::ATWF::Db::Table

    constructor {} {
        set _name people
	chain
    } {
    }

    public method getRows {where} {
         return [fetchAll $where]
    }
}









|
|













13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
#*
#*  Author: Arnulf Wiedemann
#*
#*  Contributor(s): 
#*
#************************************************************************/

::itcl::extendedclass ::Applications::Models::DbTables::People {
    inherit ::ATWF::Dbs::Table

    constructor {} {
        set _name people
	chain
    } {
    }

    public method getRows {where} {
         return [fetchAll $where]
    }
}


Changes to application/modules/module1/controllers/ModuleController.tcl.

14
15
16
17
18
19
20
21

22
23
24
25
26
27
28

::itcl::body Module1::ModuleController::constructor {request response {invokeArgs {}}} {
}

::itcl::body Module1::ModuleController::init {} {
    # switch output to xml
    set contextSwitch [$_helper getHelper ContextSwitch]
    $contextSwitch addActionContext index xml

#    $contextSwitch initContext xml
    $contextSwitch initContext

}

::itcl::body Module1::ModuleController::moduleAction {} {
puts stderr "moduleAction!"







|
>







14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

::itcl::body Module1::ModuleController::constructor {request response {invokeArgs {}}} {
}

::itcl::body Module1::ModuleController::init {} {
    # switch output to xml
    set contextSwitch [$_helper getHelper ContextSwitch]
#    $contextSwitch addActionContext index xml
    $contextSwitch addActionContext module xml
#    $contextSwitch initContext xml
    $contextSwitch initContext

}

::itcl::body Module1::ModuleController::moduleAction {} {
puts stderr "moduleAction!"

Changes to application/tscgi.tcl.

20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
proc handleRequest {channel headers content} {
    set ATWF_path /home/arnulf/SOURCES/TCL/ATWF/library/ATWF
    cd $ATWF_path
        lappend ::auto_path .
    if {![::info exists ::bootstrap_obj]} {
	# need to bootstrap
        lappend ::auto_path $ATWF_path
puts "auto_path!$::auto_path![file exists ./tclIndex]!"
#source atwf.tcl
#source Db/atwfdb.tcl
	#uplevel #0 package require atwf
	#uplevel #0 package require atwfdb
	set ::env(APPLICATION_PATH) [file dirname [file dirname [pwd]]]/application
	set application_path [file dirname [file dirname $ATWF_path]]/application
        set ::app_obj [::ATWF::Application #auto app $application_path/configs/application.ini]
        set ::bootstrap_obj [$::app_obj getBootstrap]
        $::bootstrap_obj bootstrap
    }
    ::ATWF::Output::ob_set_channel $channel







<
<
<
<
<







20
21
22
23
24
25
26





27
28
29
30
31
32
33
proc handleRequest {channel headers content} {
    set ATWF_path /home/arnulf/SOURCES/TCL/ATWF/library/ATWF
    cd $ATWF_path
        lappend ::auto_path .
    if {![::info exists ::bootstrap_obj]} {
	# need to bootstrap
        lappend ::auto_path $ATWF_path





	set ::env(APPLICATION_PATH) [file dirname [file dirname [pwd]]]/application
	set application_path [file dirname [file dirname $ATWF_path]]/application
        set ::app_obj [::ATWF::Application #auto app $application_path/configs/application.ini]
        set ::bootstrap_obj [$::app_obj getBootstrap]
        $::bootstrap_obj bootstrap
    }
    ::ATWF::Output::ob_set_channel $channel

Changes to demos/ATWF_Bootstrap.txt.

1


2
3
4
5
6
7
8
..
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
...
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
scan the .ini file


setOptions $options
   foreach {key value} $options
     # look for the method without case sensitivity!!
     if there exists a method set$key
       call it with param $value
     standard resources are
       Db
................................................................................
        $dispatcher setResponse $response

	# begin dispatch
        try {
	    # route request to controller/action if a router is provided

            # default plugins are ErrorHandler and
	    # ::ATWF::Layouts::Controllers::Plugins::Layout 8this is normally from configs)
	    # Notify plugins of router startup
            $_plugins routeStartup $request
	        # ErrorHandler and Layout do nothing here

            $router route $request
	        if {[$_useDefaultRoutes]} {
		    addDefaultRoutes
................................................................................
			        $_helper notifyPostDispatch
			    }


	        }
                # notify plugins of dispatch completion
		$_plugins postDispatch $request
	            # Layout does:
		    set layout [getLayout]
                    set helper [getLayoutActionHelper]

                    # Return early if forward detected
                    if {![$request isDispatched]
                        || [$layout getMvcSuccessfulActionOnly]
                            && ($helper ne "") && ![$helper isActionControllerSuccessful]} {

>
>







 







|







 







|







1
2
3
4
5
6
7
8
9
10
..
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
...
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
scan the .ini file
# setting or not resources.layout.layoutpath is determining, if a layout is done
# at all!! in any case ViewRenderer is used (before layout)
setOptions $options
   foreach {key value} $options
     # look for the method without case sensitivity!!
     if there exists a method set$key
       call it with param $value
     standard resources are
       Db
................................................................................
        $dispatcher setResponse $response

	# begin dispatch
        try {
	    # route request to controller/action if a router is provided

            # default plugins are ErrorHandler and
	    # ::ATWF::Layouts::Controllers::Plugins::Layout (this is normally from configs)
	    # Notify plugins of router startup
            $_plugins routeStartup $request
	        # ErrorHandler and Layout do nothing here

            $router route $request
	        if {[$_useDefaultRoutes]} {
		    addDefaultRoutes
................................................................................
			        $_helper notifyPostDispatch
			    }


	        }
                # notify plugins of dispatch completion
		$_plugins postDispatch $request
	            # Layout (::ATWF::Layouts::Controllers::Plugins::Layout) does:
		    set layout [getLayout]
                    set helper [getLayoutActionHelper]

                    # Return early if forward detected
                    if {![$request isDispatched]
                        || [$layout getMvcSuccessfulActionOnly]
                            && ($helper ne "") && ![$helper isActionControllerSuccessful]} {

Added test_apptool/tapptool.tcl.

















































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
#!/usr/bin/env tclsh8.6

package require itcl
package require http
package require dom

source ../application/modules/reportingTools/clientLib/common/validationUtils.tcl_src
source ../application/modules/reportingTools/clientLib/common/httpUtils.tcl_src
source ../application/modules/reportingTools/clientLib/common/serverInterface.tcl_src
source ../application/modules/reportingTools/clientLib/common/utils.tcl_src
source ../application/modules/reportingTools/clientLib/common/languageTexts.tcl_src
source ../application/modules/reportingTools/clientLib/common/serverLanguageTexts.tcl_src
source ../application/modules/reportingTools/clientLib/common/applicationUtils.tcl_src
set serverInterface [::ReportingTools::ServerInterface #auto [list -server_lib_dir apptool -application_dir client -user wiede -url_debug 1 -http_root http://localhost:9090/ATWF -debug_requests 1]]
set result [$serverInterface receiveFromServer sync file getfile [list [list] [list] [list file_name start.tcl_src format xml]]]
#puts stderr "result!$result!"

proc xml2lst {node indent} {
    set node_name [$node cget -nodeName]
    set node_type [$node cget -nodeType]
    set children_nodes [$node children]
    if {$node_type eq "document"} {
	return [xml2lst [lindex $children_nodes 0] "${indent}  "]
    }
    set lst [list]
    set sub_lst [list]
    foreach child_node $children_nodes {
        set child_node_name [$child_node cget -nodeName]
	set child_node_type [$child_node cget -nodeType]
        if {$child_node_type eq "textNode"} {
	    if {[llength $children_nodes] == 1} {
	        set value [$child_node cget -nodeValue]
	        set sub_lst [concat $sub_lst [list @text@ $value]]
            }
        } else {
	    set sub_lst [concat $sub_lst [xml2lst $child_node "${indent}  "]]
        }
    }
    set lst [list $node_name $sub_lst]
    return $lst
    
}

set doc_root [::dom::parse $result]
set start_node [::dom::selectNode $doc_root /]
set nodes_lst [xml2lst $start_node ""]
puts stderr "nodes_lst!$nodes_lst!"

if {0} {
set file_contents_node [::dom::selectNode $doc_root /]
set children_nodes [$file_contents_node children file_contents]
foreach child_node $children_nodes {
    set node_name [$child_node cget -nodeName]
    set node_type [$child_node cget -nodeType]
puts stderr "node!$child_node!$node_name!$node_type!"
    if {$node_name eq "file_contents"} {
	set sub_children_nodes [$child_node children]
        foreach sub_child_node $sub_children_nodes {
            set node_name [$sub_child_node cget -nodeName]
            set node_type [$sub_child_node cget -nodeType]
puts stderr "sub_node!$sub_child_node!$node_name!$node_type!"
            if {$node_type eq "textNode"} {
		set value [$sub_child_node cget -nodeValue]
		set value [string trim $value \n]
		set value [string trim $value { }]
puts stderr "value!$value!"
	    }
	}
    }
}
}
exit 0