[103638] users/cal/base-sqlite-portindex/src/portindex1.0/sqlite.tcl

[cal at macports.org]

Revision: 103638
          https://trac.macports.org/changeset/103638
Author:   cal at macports.org
Date:     2013-03-03 13:00:12 -0800 (Sun, 03 Mar 2013)
Log Message:
-----------
portindex, sqlite: implement reading interface as far as defined

Modified Paths:
--------------
    users/cal/base-sqlite-portindex/src/portindex1.0/sqlite.tcl

Modified: users/cal/base-sqlite-portindex/src/portindex1.0/sqlite.tcl
===================================================================
--- users/cal/base-sqlite-portindex/src/portindex1.0/sqlite.tcl	2013-03-03 20:58:33 UTC (rev 103637)
+++ users/cal/base-sqlite-portindex/src/portindex1.0/sqlite.tcl	2013-03-03 21:00:12 UTC (rev 103638)
@@ -33,6 +33,9 @@
 # standard package load
 package provide portindex::sqlite 1.0
 
+package require portindex 1.0
+package require stooop
+
 namespace eval portindex::sqlite {
     ########################
     # PortIndex generation #
@@ -583,60 +586,40 @@
     # PortIndex reading #
     #####################
 
-    # map from database names to paths
-    variable db_names
-    array set db_names {}
+    stooop::class reader {
+        # Open a new PortIndex. This will only be called if seems_like_valid_portindex returned 1,
+        # so assuming the checks done there came back positive should be safe.
+        proc reader {this path} ::portindex::reader {} {
+            package require sqlite3
 
-    # map from paths to database names
-    variable dbs
-    array set dbs {}
+            set ($this,path) $path
+            set ($this,database) [file join ${path} PortIndex.db]
 
-    # 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 {[catch {sqlite3 ($this,db) $($this,database)} result]} {
+                error "error opening SQLite PortIndex database $($this,database): ${result}"
             }
         }
-        if {${dbname} == ""} {
-            error "Couldn't find a free slot to create a new database connection.\
-                Make sure you don't have a resource leak."
+
+        # Close a PortIndex and release all resources associated with it.
+        proc ~reader {this} {
+            ($this,db) close
         }
 
-        if {[catch {sqlite3 ${dbname} ${database}} result]} {
-            error "error opening database ${database}: ${result}"
+        # Return a timestamp indicating when the PortIndex was last generated (and thus, when this
+        # tree was last updated)
+        proc get_mtime {this} {
+            # use the mtime of the database file, not largest mtime in the index; some users might
+            # legitly have indices that will not be modified at all for a long time (e.g., user
+            # portfile trees)
+            return [file mtime $($this,database)]
         }
 
-        set dbs($path) $dbname
-        set db_names($dbname) $path
-    }
+        # 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]
 
-    # 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)
+            return [file exists ${database}]
+        }
     }
 }
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.macosforge.org/pipermail/macports-changes/attachments/20130303/cf9c6270/attachment-0001.html>