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