Revision: 103407 https://trac.macports.org/changeset/103407 Author: cal@macports.org Date: 2013-02-24 17:14:41 -0800 (Sun, 24 Feb 2013) Log Message: ----------- SQLite portindex: start abstraction of portindex reading Modified Paths: -------------- users/cal/base-sqlite-portindex/src/portindex1.0/portindex.tcl users/cal/base-sqlite-portindex/src/portindex1.0/sqlite.tcl Modified: users/cal/base-sqlite-portindex/src/portindex1.0/portindex.tcl =================================================================== --- users/cal/base-sqlite-portindex/src/portindex1.0/portindex.tcl 2013-02-24 23:11:50 UTC (rev 103406) +++ users/cal/base-sqlite-portindex/src/portindex1.0/portindex.tcl 2013-02-25 01:14:41 UTC (rev 103407) @@ -40,6 +40,14 @@ # The type of the PortIndex implementation variable portindex_type "" + # A map from path to open PortIndex + variable portindex_map + array set portindex_map {} + + # A map from path to PortIndex retain count + variable portindex_retain_count + array set portindex_retain_count {} + # Number of total ports processed in this index operation variable count_total 0 # Number of ports that were processed but failed @@ -59,7 +67,7 @@ # do nothing, those are valid types } default { - error "portindex::set_portindex_type called with invalid type \ + error "portindex::set_portindex_type called with invalid type\ ${type}. Valid types are: sqlite, tcl." } } @@ -71,6 +79,98 @@ set portindex_type ${type} } + # Returns a handle that can be used to query the PortIndex in the given + # path. Automatically selects the best available index type. Raises an + # error, if no index can be found. + # Use the handle returned by this procedure to query the portindex, by + # calling the methods available in portindex::${type}. Do not use this + # handle to modify the portindex. + proc open {path} { + variable portindex_map + variable portindex_retain_count + + # Some sanity checks to fail early + if {![file exists ${path}]} { + error "No PortIndex found at ${path}: No such file or directory" + } + if {![file isdirectory ${path}]} { + error "No PortIndex found at ${path}: Not a directory" + } + + # Check for existing PortIndex commands for this path + if {[info exists portindex_map($path)]} { + incr $portindex_retain_count($path) + return $portindex_map($path) + } + + # This list defines the priority of PortIndex implementations + foreach type [list sqlite tcl] { + if {[eval ${type}::seems_like_valid_portindex ${path}]} { + # Found the type of PortIndex we want + set portindex_map($path) [create_portindex_handle ${type} ${path}] + set portindex_retain_count($path) 1 + return $portindex_map($path) + } + } + + # No index found + error "No index(es) found! Have you synced your port definitions?\ + Try running 'port selfupdate'." + } + + # Creates and returns a new handle that can be used like $handle command to + # call portindex::${type}::${command} ${path} and pass along all further + # arguments. + # After usage, this handle should be released using `$handle release`. + proc create_portindex_handle {type path} { + # Similar to what we used in registry2.0, this finds a unique command + # name to be used as a handle for this specific instance of the + # PortIndex. This is the poor man's way of OO. + set cmdname "" + for {set i 0} {$i < 1000} {incr i} { + if {[llength [info commands "portindexhandle${i}"]] == 0} { + set cmdname "portindexhandle${i}" + break; + } + } + + if {${cmdname} == ""} { + error "Couldn't find a free slot to create a new PortIndex handle.\ + Make sure you don't have a resource leak." + } + + # Create an alias and always pass the ${path} parameter + interp alias {} ${cmdname} {} portindex::handle_portindex_cmd ${type} ${path} + # Allow running initilization code + eval ${cmdname} open + + return ${cmdname} + } + + # Callback called for every command to be dispatched to a certain PortIndex + # handler. Makes sure the command is being run in the correct namespace. + # Also implements `$handle release`, which uses reference counting and only + # calls the corresponding PortIndex implementation command, if this was the + # last reference. + proc handle_portindex_cmd {type path cmd args} { + variable portindex_map + variable portindex_retain_count + + if {${cmd} == "release"} { + incr portindex_retain_count($path) -1 + if {[expr $portindex_retain_count($path) > 0]} { + # do nothing, the reference is still valid + return + } + # remove command, clear command maps, call destructor + set command $portindex_map($path) + unset portindex_map($path) + unset portindex_retain_count($path) + interp alias {} ${command} {} + } + return [namespace inscope ::portindex::${type} ${cmd} ${path} ${args}] + } + # Increase the number of ports in total. Call this once for every port # processed from the portindex implementation proc inc_total {{amount 1}} { Modified: users/cal/base-sqlite-portindex/src/portindex1.0/sqlite.tcl =================================================================== --- users/cal/base-sqlite-portindex/src/portindex1.0/sqlite.tcl 2013-02-24 23:11:50 UTC (rev 103406) +++ users/cal/base-sqlite-portindex/src/portindex1.0/sqlite.tcl 2013-02-25 01:14:41 UTC (rev 103407) @@ -34,6 +34,10 @@ package provide portindex::sqlite 1.0 namespace eval portindex::sqlite { + ######################## + # PortIndex generation # + ######################## + # The output directory for the PortIndex variable outdir @@ -565,7 +569,7 @@ return [namespace code {pindex}] } - # Cleanup procedure called after portindex::replace. + # Cleanup procedure called at the end of portindex::update proc finish {} { variable db @@ -574,4 +578,65 @@ } db close } + + ##################### + # PortIndex reading # + ##################### + + # map from database names to paths + variable db_names + array set db_names {} + + # map from paths to database names + variable dbs + array set dbs {} + + # Checks whether a given path looks like a SQLite-indexed ports tree. + # Returns 1 if the given path seems to match, 0 otherwise. Never throws errors. + proc seems_like_valid_portindex {path} { + set database [file join ${path} PortIndex.db] + + return [file exists ${database}] + } + + # Open a new PortIndex. This will only be called if seems_like_valid_portindex returned 1, so + # assuming the checks done there came back true is possible. + proc open {path args} { + variable db_names + variable dbs + + package require sqlite3 + + set database [file join ${path} PortIndex.db] + + set dbname "" + for {set i 0} {$i < 1000} {incr i} { + if {[llength [info commands "portindexsqlitedb${i}"]] == 0} { + set dbname "portindexsqlitedb${i}" + break; + } + } + if {${dbname} == ""} { + error "Couldn't find a free slot to create a new database connection.\ + Make sure you don't have a resource leak." + } + + if {[catch {sqlite3 ${dbname} ${database}} result]} { + error "error opening database ${database}: ${result}" + } + + set dbs($path) $dbname + set db_names($dbname) $path + } + + # Close a PortIndex and release all resources associated with it. + proc release {path args} { + variable dbs + variable db_names + + set dbname $dbs($path) + $dbs($path) close + unset dbs($path) + unset db_names($dbname) + } }