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 be32ebcb41 2007-09-08 aku: package require fileutil ; # Tcllib (cat) be32ebcb41 2007-09-08 aku: package require tools::log ; # User feedback be32ebcb41 2007-09-08 aku: be32ebcb41 2007-09-08 aku: namespace eval ::rcsparser { be32ebcb41 2007-09-08 aku: tools::log::system rcs be32ebcb41 2007-09-08 aku: namespace import ::tools::log::progress 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: be32ebcb41 2007-09-08 aku: # rcsparser::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 df91d389d5 2007-09-04 aku: f166b0a63c 2007-08-31 aku: proc ::rcsparser::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: f166b0a63c 2007-08-31 aku: # ----------------------------------------------------------------------------- be32ebcb41 2007-09-08 aku: # Internal - Recursive Descent functions implementing the syntax. f166b0a63c 2007-08-31 aku: f166b0a63c 2007-08-31 aku: proc ::rcsparser::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: f166b0a63c 2007-08-31 aku: proc ::rcsparser::Deltas {} { f166b0a63c 2007-08-31 aku: upvar 1 data data res res df91d389d5 2007-09-04 aku: while {[Num 0]} { IsIdent ; Date ; Author ; State ; Branches ; NextRev } f166b0a63c 2007-08-31 aku: return f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: f166b0a63c 2007-08-31 aku: proc ::rcsparser::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: f166b0a63c 2007-08-31 aku: proc ::rcsparser::DeltaTexts {} { f166b0a63c 2007-08-31 aku: upvar 1 data data res res df91d389d5 2007-09-04 aku: while {[Num 0]} { IsIdent ; Log ; Text } f166b0a63c 2007-08-31 aku: return f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: f166b0a63c 2007-08-31 aku: proc ::rcsparser::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: f166b0a63c 2007-08-31 aku: proc ::rcsparser::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: f166b0a63c 2007-08-31 aku: proc ::rcsparser::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: f166b0a63c 2007-08-31 aku: proc ::rcsparser::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: f166b0a63c 2007-08-31 aku: proc ::rcsparser::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: f166b0a63c 2007-08-31 aku: proc ::rcsparser::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: f166b0a63c 2007-08-31 aku: proc ::rcsparser::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: f166b0a63c 2007-08-31 aku: proc ::rcsparser::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: f166b0a63c 2007-08-31 aku: proc ::rcsparser::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 f166b0a63c 2007-08-31 aku: return f166b0a63c 2007-08-31 aku: } f166b0a63c 2007-08-31 aku: f166b0a63c 2007-08-31 aku: proc ::rcsparser::Author {} { f166b0a63c 2007-08-31 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: f166b0a63c 2007-08-31 aku: proc ::rcsparser::State {} { f166b0a63c 2007-08-31 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: f166b0a63c 2007-08-31 aku: proc ::rcsparser::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: f166b0a63c 2007-08-31 aku: proc ::rcsparser::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: f166b0a63c 2007-08-31 aku: proc ::rcsparser::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: f166b0a63c 2007-08-31 aku: proc ::rcsparser::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: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # ----------------------------------------------------------------------------- be32ebcb41 2007-09-08 aku: # Internal - Lexicographical commands and data aquisition preparation f166b0a63c 2007-08-31 aku: f166b0a63c 2007-08-31 aku: proc ::rcsparser::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: f166b0a63c 2007-08-31 aku: proc ::rcsparser::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: f166b0a63c 2007-08-31 aku: proc ::rcsparser::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: f166b0a63c 2007-08-31 aku: proc ::rcsparser::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: f166b0a63c 2007-08-31 aku: proc ::rcsparser::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: } df91d389d5 2007-09-04 aku: be32ebcb41 2007-09-08 aku: # ----------------------------------------------------------------------------- be32ebcb41 2007-09-08 aku: # Internal - Data aquisition f166b0a63c 2007-08-31 aku: f166b0a63c 2007-08-31 aku: proc ::rcsparser::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: f166b0a63c 2007-08-31 aku: proc ::rcsparser::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: f166b0a63c 2007-08-31 aku: proc ::rcsparser::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: f166b0a63c 2007-08-31 aku: proc ::rcsparser::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: f166b0a63c 2007-08-31 aku: proc ::rcsparser::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 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: f166b0a63c 2007-08-31 aku: package provide rcsparser 1.0 f166b0a63c 2007-08-31 aku: return
File Annotation