f166b0a63c 2007-08-31 aku: # ----------------------------------------------------------------------------- be32ebcb41 2007-09-08 aku: # Tool packages. Parsing RCS files. be32ebcb41 2007-09-08 aku: # be32ebcb41 2007-09-08 aku: # Some of the information in RCS files is skipped over, most be32ebcb41 2007-09-08 aku: # importantly the actual delta texts. The users of this parser need be32ebcb41 2007-09-08 aku: # only the meta-data about when revisions were added, the tree be32ebcb41 2007-09-08 aku: # (branching) structure, commit messages. be32ebcb41 2007-09-08 aku: # be32ebcb41 2007-09-08 aku: # The parser is based on Recursive Descent. f166b0a63c 2007-08-31 aku: f166b0a63c 2007-08-31 aku: # ----------------------------------------------------------------------------- f166b0a63c 2007-08-31 aku: # Requirements f166b0a63c 2007-08-31 aku: f166b0a63c 2007-08-31 aku: package require Tcl 8.4 86a7f249c1 2007-09-09 aku: package require fileutil ; # Tcllib (cat) 86a7f249c1 2007-09-09 aku: package require vc::tools::log ; # User feedback 86a7f249c1 2007-09-09 aku: d4aa7da67d 2007-09-13 aku: namespace eval ::vc::rcs::parser { 86a7f249c1 2007-09-09 aku: vc::tools::log::system rcs 3852590ce6 2007-09-26 aku: namespace import ::vc::tools::log::* be32ebcb41 2007-09-08 aku: } f166b0a63c 2007-08-31 aku: f166b0a63c 2007-08-31 aku: # ----------------------------------------------------------------------------- f166b0a63c 2007-08-31 aku: # API f166b0a63c 2007-08-31 aku: d4aa7da67d 2007-09-13 aku: # vc::rcs::parser::process file be32ebcb41 2007-09-08 aku: # be32ebcb41 2007-09-08 aku: # Parses the rcs file and returns a dictionary containing the meta be32ebcb41 2007-09-08 aku: # data. The following keys are used be32ebcb41 2007-09-08 aku: # be32ebcb41 2007-09-08 aku: # Key Meaning be32ebcb41 2007-09-08 aku: # --- ------- be32ebcb41 2007-09-08 aku: # 'head' head revision be32ebcb41 2007-09-08 aku: # 'branch' ? be32ebcb41 2007-09-08 aku: # 'symbol' dict (symbol -> revision) be32ebcb41 2007-09-08 aku: # 'lock' dict (symbol -> revision) be32ebcb41 2007-09-08 aku: # 'comment' file comment be32ebcb41 2007-09-08 aku: # 'expand' ? be32ebcb41 2007-09-08 aku: # 'date' dict (revision -> date) be32ebcb41 2007-09-08 aku: # 'author' dict (revision -> author) be32ebcb41 2007-09-08 aku: # 'state' dict (revision -> state) be32ebcb41 2007-09-08 aku: # 'parent' dict (revision -> parent revision) be32ebcb41 2007-09-08 aku: # 'commit' dict (revision -> commit message) be32ebcb41 2007-09-08 aku: # be32ebcb41 2007-09-08 aku: # The state 'dead' has special meaning, the user should know that. be32ebcb41 2007-09-08 aku: be32ebcb41 2007-09-08 aku: # ----------------------------------------------------------------------------- be32ebcb41 2007-09-08 aku: # API Implementation be32ebcb41 2007-09-08 aku: 3852590ce6 2007-09-26 aku: proc ::vc::rcs::parser::configure {key value} { 3852590ce6 2007-09-26 aku: variable cache 3852590ce6 2007-09-26 aku: switch -exact -- $key { 3852590ce6 2007-09-26 aku: -cache { 3852590ce6 2007-09-26 aku: set cache $value 3852590ce6 2007-09-26 aku: } 3852590ce6 2007-09-26 aku: default { 3852590ce6 2007-09-26 aku: return -code error "Unknown switch $key, expected one of -cache" 3852590ce6 2007-09-26 aku: } 3852590ce6 2007-09-26 aku: } 3852590ce6 2007-09-26 aku: return 3852590ce6 2007-09-26 aku: } 3852590ce6 2007-09-26 aku: d4aa7da67d 2007-09-13 aku: proc ::vc::rcs::parser::process {path} { 3852590ce6 2007-09-26 aku: set cache [Cache $path] 3852590ce6 2007-09-26 aku: if { 3852590ce6 2007-09-26 aku: [file exists $cache] && 3852590ce6 2007-09-26 aku: ([file mtime $cache] > [file mtime $path]) 3852590ce6 2007-09-26 aku: } { 3852590ce6 2007-09-26 aku: # Use preparsed data if not invalidated by changes to the 3852590ce6 2007-09-26 aku: # archive they are derived from. 3852590ce6 2007-09-26 aku: write 4 rcs {Load preparsed data block} 3852590ce6 2007-09-26 aku: return [fileutil::cat -encoding binary $cache] 3852590ce6 2007-09-26 aku: } 3852590ce6 2007-09-26 aku: 3852590ce6 2007-09-26 aku: set res [Process $path] 3852590ce6 2007-09-26 aku: 3852590ce6 2007-09-26 aku: # Save parse result for quick pickup by future runs. 3852590ce6 2007-09-26 aku: fileutil::writeFile $cache $res 3852590ce6 2007-09-26 aku: 3852590ce6 2007-09-26 aku: return $res 3852590ce6 2007-09-26 aku: } 3852590ce6 2007-09-26 aku: 3852590ce6 2007-09-26 aku: # ----------------------------------------------------------------------------- 3852590ce6 2007-09-26 aku: 3852590ce6 2007-09-26 aku: proc ::vc::rcs::parser::Process {path} { f166b0a63c 2007-08-31 aku: set data [fileutil::cat -encoding binary $path] f166b0a63c 2007-08-31 aku: array set res {} df91d389d5 2007-09-04 aku: set res(size) [file size $path] df91d389d5 2007-09-04 aku: set res(done) 0 df91d389d5 2007-09-04 aku: set res(nsize) [string length $res(size)] df91d389d5 2007-09-04 aku: f166b0a63c 2007-08-31 aku: Admin f166b0a63c 2007-08-31 aku: Deltas f166b0a63c 2007-08-31 aku: Description f166b0a63c 2007-08-31 aku: DeltaTexts df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Remove parser state df91d389d5 2007-09-04 aku: catch {unset res(id)} df91d389d5 2007-09-04 aku: catch {unset res(lastval)} df91d389d5 2007-09-04 aku: unset res(size) df91d389d5 2007-09-04 aku: unset res(nsize) df91d389d5 2007-09-04 aku: unset res(done) df91d389d5 2007-09-04 aku: f166b0a63c 2007-08-31 aku: return [array get res] f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: 3852590ce6 2007-09-26 aku: proc ::vc::rcs::parser::Cache {path} { 3852590ce6 2007-09-26 aku: return ${path},,preparsed df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: f166b0a63c 2007-08-31 aku: # ----------------------------------------------------------------------------- be32ebcb41 2007-09-08 aku: # Internal - Recursive Descent functions implementing the syntax. be32ebcb41 2007-09-08 aku: d4aa7da67d 2007-09-13 aku: proc ::vc::rcs::parser::Admin {} { f166b0a63c 2007-08-31 aku: upvar 1 data data res res f166b0a63c 2007-08-31 aku: Head ; Branch ; Access ; Symbols ; Locks ; Strict ; Comment ; Expand f166b0a63c 2007-08-31 aku: return f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: d4aa7da67d 2007-09-13 aku: proc ::vc::rcs::parser::Deltas {} { df91d389d5 2007-09-04 aku: upvar 1 data data res res df91d389d5 2007-09-04 aku: while {[Num 0]} { IsIdent ; Date ; Author ; State ; Branches ; NextRev } df91d389d5 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: d4aa7da67d 2007-09-13 aku: proc ::vc::rcs::parser::Description {} { f166b0a63c 2007-08-31 aku: upvar 1 data data res res f166b0a63c 2007-08-31 aku: Literal desc f166b0a63c 2007-08-31 aku: String 1 f166b0a63c 2007-08-31 aku: Def desc f166b0a63c 2007-08-31 aku: return f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: d4aa7da67d 2007-09-13 aku: proc ::vc::rcs::parser::DeltaTexts {} { df91d389d5 2007-09-04 aku: upvar 1 data data res res df91d389d5 2007-09-04 aku: while {[Num 0]} { IsIdent ; Log ; Text } df91d389d5 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: d4aa7da67d 2007-09-13 aku: proc ::vc::rcs::parser::Head {} { f166b0a63c 2007-08-31 aku: upvar 1 data data res res f166b0a63c 2007-08-31 aku: Literal head ; Num 1 ; Literal \; f166b0a63c 2007-08-31 aku: Def head f166b0a63c 2007-08-31 aku: return f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: d4aa7da67d 2007-09-13 aku: proc ::vc::rcs::parser::Branch {} { f166b0a63c 2007-08-31 aku: upvar 1 data data res res f166b0a63c 2007-08-31 aku: if {![Literal branch 0]} return ; Num 1 ; Literal \; f166b0a63c 2007-08-31 aku: Def branch f166b0a63c 2007-08-31 aku: return f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: d4aa7da67d 2007-09-13 aku: proc ::vc::rcs::parser::Access {} { f166b0a63c 2007-08-31 aku: upvar 1 data data res res f166b0a63c 2007-08-31 aku: Literal access ; Literal \; f166b0a63c 2007-08-31 aku: return f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: d4aa7da67d 2007-09-13 aku: proc ::vc::rcs::parser::Symbols {} { f166b0a63c 2007-08-31 aku: upvar 1 data data res res f166b0a63c 2007-08-31 aku: Literal symbols f166b0a63c 2007-08-31 aku: while {[Ident]} { Num 1 ; Map symbol } f166b0a63c 2007-08-31 aku: Literal \; f166b0a63c 2007-08-31 aku: return f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: d4aa7da67d 2007-09-13 aku: proc ::vc::rcs::parser::Locks {} { f166b0a63c 2007-08-31 aku: upvar 1 data data res res f166b0a63c 2007-08-31 aku: Literal locks f166b0a63c 2007-08-31 aku: while {[Ident]} { Num 1 ; Map lock } f166b0a63c 2007-08-31 aku: Literal \; f166b0a63c 2007-08-31 aku: return f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: d4aa7da67d 2007-09-13 aku: proc ::vc::rcs::parser::Strict {} { f166b0a63c 2007-08-31 aku: upvar 1 data data res res f166b0a63c 2007-08-31 aku: if {![Literal strict 0]} return ; Literal \; f166b0a63c 2007-08-31 aku: return f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: d4aa7da67d 2007-09-13 aku: proc ::vc::rcs::parser::Comment {} { f166b0a63c 2007-08-31 aku: upvar 1 data data res res f166b0a63c 2007-08-31 aku: if {![Literal comment 0]} return ; f166b0a63c 2007-08-31 aku: if {![String 0]} return ; f166b0a63c 2007-08-31 aku: Literal \; f166b0a63c 2007-08-31 aku: Def comment f166b0a63c 2007-08-31 aku: return f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: d4aa7da67d 2007-09-13 aku: proc ::vc::rcs::parser::Expand {} { f166b0a63c 2007-08-31 aku: upvar 1 data data res res f166b0a63c 2007-08-31 aku: if {![Literal expand 0]} return ; f166b0a63c 2007-08-31 aku: if {![String 0]} return ; f166b0a63c 2007-08-31 aku: Literal \; f166b0a63c 2007-08-31 aku: Def expand f166b0a63c 2007-08-31 aku: return f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: d4aa7da67d 2007-09-13 aku: proc ::vc::rcs::parser::Date {} { f166b0a63c 2007-08-31 aku: upvar 1 data data res res f166b0a63c 2007-08-31 aku: Literal date ; Num 1 ; Literal \; df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: foreach {yr mo dy h m s} [split $res(lastval) .] break df91d389d5 2007-09-04 aku: if {$yr < 100} {incr yr 1900} df91d389d5 2007-09-04 aku: set res(lastval) [join [list $yr $mo $dy $h $m $s] .] df91d389d5 2007-09-04 aku: Map date df91d389d5 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: d4aa7da67d 2007-09-13 aku: proc ::vc::rcs::parser::Author {} { df91d389d5 2007-09-04 aku: upvar 1 data data res res df91d389d5 2007-09-04 aku: Literal author ; Skip ; Literal \; ; Map author f166b0a63c 2007-08-31 aku: return f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: d4aa7da67d 2007-09-13 aku: proc ::vc::rcs::parser::State {} { df91d389d5 2007-09-04 aku: upvar 1 data data res res df91d389d5 2007-09-04 aku: Literal state ; Skip ; Literal \; ; Map state f166b0a63c 2007-08-31 aku: return f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: d4aa7da67d 2007-09-13 aku: proc ::vc::rcs::parser::Branches {} { f166b0a63c 2007-08-31 aku: upvar 1 data data res res f166b0a63c 2007-08-31 aku: Literal branches ; Skip ; Literal \; f166b0a63c 2007-08-31 aku: return f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: d4aa7da67d 2007-09-13 aku: proc ::vc::rcs::parser::NextRev {} { f166b0a63c 2007-08-31 aku: upvar 1 data data res res df91d389d5 2007-09-04 aku: Literal next ; Skip ; Literal \; ; Map parent f166b0a63c 2007-08-31 aku: return f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: d4aa7da67d 2007-09-13 aku: proc ::vc::rcs::parser::Log {} { f166b0a63c 2007-08-31 aku: upvar 1 data data res res df91d389d5 2007-09-04 aku: Literal log ; String 1 ; Map commit f166b0a63c 2007-08-31 aku: return f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: d4aa7da67d 2007-09-13 aku: proc ::vc::rcs::parser::Text {} { f166b0a63c 2007-08-31 aku: upvar 1 data data res res f166b0a63c 2007-08-31 aku: Literal text ; String 1 f166b0a63c 2007-08-31 aku: return f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: df91d389d5 2007-09-04 aku: # ----------------------------------------------------------------------------- be32ebcb41 2007-09-08 aku: # Internal - Lexicographical commands and data aquisition preparation be32ebcb41 2007-09-08 aku: d4aa7da67d 2007-09-13 aku: proc ::vc::rcs::parser::Ident {} { f166b0a63c 2007-08-31 aku: upvar 1 data data res res f166b0a63c 2007-08-31 aku: f166b0a63c 2007-08-31 aku: #puts I@?<[string range $data 0 10]...> f166b0a63c 2007-08-31 aku: f166b0a63c 2007-08-31 aku: if {[regexp -indices -- {^\s*;\s*} $data]} { f166b0a63c 2007-08-31 aku: return 0 f166b0a63c 2007-08-31 aku: } elseif {![regexp -indices -- {^\s*([^:]*)\s*:\s*} $data match val]} { f166b0a63c 2007-08-31 aku: return 0 f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: f166b0a63c 2007-08-31 aku: Get $val ; IsIdent f166b0a63c 2007-08-31 aku: Next f166b0a63c 2007-08-31 aku: return 1 f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: d4aa7da67d 2007-09-13 aku: proc ::vc::rcs::parser::Literal {name {required 1}} { f166b0a63c 2007-08-31 aku: upvar 1 data data res res f166b0a63c 2007-08-31 aku: if {![regexp -indices -- "^\\s*$name\\s*" $data match]} { f166b0a63c 2007-08-31 aku: if {$required} { f166b0a63c 2007-08-31 aku: return -code error "Expected '$name' @ '[string range $data 0 30]...'" f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: return 0 f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: f166b0a63c 2007-08-31 aku: Next f166b0a63c 2007-08-31 aku: return 1 f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: d4aa7da67d 2007-09-13 aku: proc ::vc::rcs::parser::String {{required 1}} { f166b0a63c 2007-08-31 aku: upvar 1 data data res res f166b0a63c 2007-08-31 aku: f166b0a63c 2007-08-31 aku: if {![regexp -indices -- {^\s*@(([^@]*(@@)*)*)@\s*} $data match val]} { f166b0a63c 2007-08-31 aku: if {$required} { f166b0a63c 2007-08-31 aku: return -code error "Expected string @ '[string range $data 0 30]...'" f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: return 0 f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: f166b0a63c 2007-08-31 aku: Get $val f166b0a63c 2007-08-31 aku: Next f166b0a63c 2007-08-31 aku: return 1 f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: d4aa7da67d 2007-09-13 aku: proc ::vc::rcs::parser::Num {required} { f166b0a63c 2007-08-31 aku: upvar 1 data data res res f166b0a63c 2007-08-31 aku: if {![regexp -indices -- {^\s*((\d|\.)+)\s*} $data match val]} { f166b0a63c 2007-08-31 aku: if {$required} { f166b0a63c 2007-08-31 aku: return -code error "Expected id @ '[string range $data 0 30]...'" f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: return 0 f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: f166b0a63c 2007-08-31 aku: Get $val f166b0a63c 2007-08-31 aku: Next f166b0a63c 2007-08-31 aku: return 1 f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: d4aa7da67d 2007-09-13 aku: proc ::vc::rcs::parser::Skip {} { f166b0a63c 2007-08-31 aku: upvar 1 data data res res df91d389d5 2007-09-04 aku: regexp -indices -- {^\s*([^;]*)\s*} $data match val df91d389d5 2007-09-04 aku: Get $val f166b0a63c 2007-08-31 aku: Next f166b0a63c 2007-08-31 aku: return f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: be32ebcb41 2007-09-08 aku: # ----------------------------------------------------------------------------- be32ebcb41 2007-09-08 aku: # Internal - Data aquisition be32ebcb41 2007-09-08 aku: d4aa7da67d 2007-09-13 aku: proc ::vc::rcs::parser::Def {key} { f166b0a63c 2007-08-31 aku: upvar 1 data data res res f166b0a63c 2007-08-31 aku: set res($key) $res(lastval) f166b0a63c 2007-08-31 aku: unset res(lastval) f166b0a63c 2007-08-31 aku: return f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: d4aa7da67d 2007-09-13 aku: proc ::vc::rcs::parser::Map {key} { f166b0a63c 2007-08-31 aku: upvar 1 data data res res f166b0a63c 2007-08-31 aku: lappend res($key) $res(id) $res(lastval) f166b0a63c 2007-08-31 aku: #puts Map($res(id))=($res(lastval)) f166b0a63c 2007-08-31 aku: unset res(lastval) df91d389d5 2007-09-04 aku: #unset res(id);#Keep id for additional mappings. f166b0a63c 2007-08-31 aku: return f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: d4aa7da67d 2007-09-13 aku: proc ::vc::rcs::parser::IsIdent {} { f166b0a63c 2007-08-31 aku: upvar 1 data data res res f166b0a63c 2007-08-31 aku: set res(id) $res(lastval) f166b0a63c 2007-08-31 aku: unset res(lastval) f166b0a63c 2007-08-31 aku: return f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: d4aa7da67d 2007-09-13 aku: proc ::vc::rcs::parser::Get {val} { f166b0a63c 2007-08-31 aku: upvar 1 data data res res f166b0a63c 2007-08-31 aku: foreach {s e} $val break f166b0a63c 2007-08-31 aku: set res(lastval) [string range $data $s $e] f166b0a63c 2007-08-31 aku: #puts G|$res(lastval) f166b0a63c 2007-08-31 aku: return f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: d4aa7da67d 2007-09-13 aku: proc ::vc::rcs::parser::Next {} { df91d389d5 2007-09-04 aku: upvar 1 match match data data res res f166b0a63c 2007-08-31 aku: foreach {s e} $match break ; incr e f166b0a63c 2007-08-31 aku: set data [string range $data $e end] df91d389d5 2007-09-04 aku: set res(done) [expr {$res(size) - [string length $data]}] df91d389d5 2007-09-04 aku: be32ebcb41 2007-09-08 aku: progress 2 rcs $res(done) $res(size) f166b0a63c 2007-08-31 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # ----------------------------------------------------------------------------- df91d389d5 2007-09-04 aku: d4aa7da67d 2007-09-13 aku: namespace eval ::vc::rcs::parser { 3852590ce6 2007-09-26 aku: variable cache 0 ; # No result caching by default. df91d389d5 2007-09-04 aku: 3852590ce6 2007-09-26 aku: namespace export process configure f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: f166b0a63c 2007-08-31 aku: # ----------------------------------------------------------------------------- f166b0a63c 2007-08-31 aku: # Ready f166b0a63c 2007-08-31 aku: d4aa7da67d 2007-09-13 aku: package provide vc::rcs::parser 1.0 f166b0a63c 2007-08-31 aku: return
File Annotation