1# -*- tcl -*-
2# # ## ### ##### ######## #############
3# (C) 2009 Andreas Kupries
4
5# @@ Meta Begin
6# Package tcl::chan::string 1
7# Meta as::author {Andreas Kupries}
8# Meta as::copyright 2009
9# Meta as::license BSD
10# Meta description Implementation of a channel representing
11# Meta description an in-memory read-only random-access
12# Meta description file. Based on using Tcl 8.5's channel
13# Meta description reflection support. Exports a single
14# Meta description command for the creation of new channels.
15# Meta description One argument, the contents of the file.
16# Meta description Result is the  handle of the new channel.
17# Meta description Similar to -> tcl::chan::memchan, except
18# Meta description that the content is read-only. Seekable
19# Meta description only within the bounds of the content.
20# Meta platform tcl
21# Meta require TclOO
22# Meta require tcl::chan::events
23# Meta require {Tcl 8.5}
24# @@ Meta End
25
26# # ## ### ##### ######## #############
27
28package require Tcl 8.5
29package require TclOO
30package require tcl::chan::events
31
32# # ## ### ##### ######## #############
33
34namespace eval ::tcl::chan {}
35
36proc ::tcl::chan::string {content} {
37    return [::chan create {read} [string::implementation new $content]]
38}
39
40oo::class create ::tcl::chan::string::implementation {
41    superclass ::tcl::chan::events ; # -> initialize, finalize, watch
42
43    constructor {thecontent} {
44	set content $thecontent
45	set at 0
46    }
47
48    method initialize {args} {
49	my Events
50	next {*}$args
51    }
52
53    variable content at
54
55    method read {c n} {
56
57	# First determine the location of the last byte to read,
58	# relative to the current location, and limited by the maximum
59	# location we are allowed to access per the size of the
60	# content.
61
62	set last [expr {min($at + $n,[string length $content])-1}]
63
64	# Then extract the relevant range from the content, move the
65	# seek location behind it, and return the extracted range. Not
66	# to forget, switch readable events based on the seek
67	# location.
68
69	set res [string range $content $at $last]
70	set at $last
71	incr at
72
73	my Events
74	return $res
75    }
76
77    method seek {c offset base} {
78	# offset == 0 && base == current
79	# <=> Seek nothing relative to current
80	# <=> Report current location.
81
82	if {!$offset && ($base eq "current")} {
83	    return $at
84	}
85
86	# Compute the new location per the arguments.
87
88	set max [string length $content]
89	switch -exact -- $base {
90	    start   { set newloc $offset}
91	    current { set newloc [expr {$at  + $offset    }] }
92	    end     { set newloc [expr {$max + $offset - 1}] }
93	}
94
95	# Check if the new location is beyond the range given by the
96	# content.
97
98	if {$newloc < 0} {
99	    return -code error "Cannot seek before the start of the channel"
100	} elseif {$newloc >= $max} {
101	    return -code error "Cannot seek after the end of the channel"
102	}
103
104	# Commit to new location, switch readable events, and report.
105	set at $newloc
106
107	my Events
108	return $at
109    }
110
111    method Events {} {
112	if {$at >= [string length $content]} {
113	    my disallow read
114	} else {
115	    my allow read
116	}
117    }
118}
119
120# # ## ### ##### ######## #############
121package provide tcl::chan::string 1
122return
123