tools for indexing and searching a jpeg photo collection

Work in progress.

AK Out of curiosity: sqlite/fts based ?

MHo: Metakit-based!

AK Ok. Hm. Trying to understand if the images are stored in the Metakit database or not ... Seems not. Seems that the index maps from words to the directories and files using that word in their comments. index builds the database, query reads and perform intersection and such. One database in a fixed location ? Ah, yes, sibling to the index/query scripts. Nothing like per-directory databases or other fancies ... Ok, I believe I do understand the basics here.


Everything:

  • needs translation...
  • needs documentation...
  • ...but works under certain conditions

Build the index

# jpegindex3.tcl (c) M.Hoffmann 2009
# 23.06.2009: Annahme: Es gibt (langfristig) immer mehr Bilder als Kommentar-Tags.
#  Also lohnt es sich, bei der Bildspeicherung Platz zu sparen, sprich: die Bilder
#  als SubViews eines Directories zu speichern. Dann muss man natürlich bei den
#  Suchworten nun ZWEI Pointer speichern: Dir# und File#.
# 28.06.2009: Nur JP(E)Gs berücksichtigen. Bugfix.
# 03.07.2009: Bugfix.
#
# FEHLER/KLÄREN:
# - Bei manchen Bildern wird Schrott von jpeg::getComments geliefert...
#
# Notizen:
# - die vielen Ausgaben nur mit --verbose
# - Alles mit WithLock() schützen?
# - Bei Progabbruch müsste ROLLBACK erfolgen, bzw. es dürfte kein AutoFlush
#   erfolgen! ----- Konzept nochmal nachlesen! Momentan COMMIT erst am Ende!
# - Evtl. #Dirs, #Files/Dir festhalten.
#

package require Globx
package require Mk4tcl
package require jpeg

set root  [file normalize [lindex $argv 0]]
set force          [expr {[lindex $argv 1] == "--force"}]
if {[string eq $root ""]} {puts "Parameter: startDir \[--force\]"; exit}
set indx [file normalize [file join [file dirname [info script]] index3.db]]
puts "root: $root"
puts "indx: $indx"; # fürs erste DB im Scriptpfad

set verbose 0
rename puts ::_orgPuts
proc puts {txt} {
     # primitive Redefinition reicht hier
     if {$::verbose != 0} {
        ::_orgPuts $txt
     }
}

mk::file open db $indx -nocommit; # damit bei Abbrüchen DB nicht inkonsistent
set ctlVw  [mk::view layout db.ctl {pending lastRun}]; # später mehr (lastChg? Counter? History? CRC?)
set dirsVw [mk::view layout db.dirs {dirName dirInfo {files {fileName fileInfo}}}]
# zeigt auf Dir+Datei (ein Wort kann mehrmals vorkommen!):
# *
# * um es auf die Spitze zu treiben, könnte man ein Suchwort zunächst auf ein Dir zeigen
# *  lassen, und dann in einem weiteren SubView auf alle Files in diesem Dir!
# *
set wordsVw [mk::view layout db.words {word {ptrs {dirNr {filePtrs {fileNr}}}}}]

mk::set $ctlVw!0 pending 1; # Erkennung von Programmabbrüchen
mk::file commit db

# später ggF. auswerten und beim Start Status anzeigen (möglicherweise DB korrupt?)
proc idxFromRec {rec} {
     return [lindex [split $rec .!] end]
}

# ACHTUNG: Späteres Neueinlesen der Dir-INHALTE muss auch dann erfolgen, wenn
#  nur dortiger INHALT verändert wurde, aber nicht DirEntry selbst!
# Nicht mehr existente Dirs/Files können 'on demand' entfernt werden, wenn dies beim
# Zugriff später (Query) erkannt wird.
foreach dir [globx2 $root] {
   # beim Erstaufbau wären natürlich keine Abfragen notwendig...
   set newDir 0
   set dInfo [list [file mtime $dir]]; # evtl. mehr (z.B. #Files; Attr sinnlos)
   set dirRows [mk::select $dirsVw -count 1 -exact dirName $dir]
   if {[llength $dirRows] == 0} {
      # noch kein Eintrag vorhanden -> zufügen
      puts "AddDir: $dir"
      set dr [mk::row append $dirsVw dirName $dir dirInfo $dInfo]
      set newDir 1
   } else {
      set dr $dirsVw![lindex $dirRows 0]; # ACHTUNG: Es kann nur EINEN Eintrag (Match) geben!
      if {[mk::get $dr dirInfo] != $dInfo} {
         # Eintrag schon da, aber Dir wurde auf Platte verändert (nur MTIME-Check) -> Update
         # ACHTUNG: wir erkennen hier noch nicht Änderungen, die sich nur INNERHALB des Dirs
         # auswirken!
         mk::set $dr dirInfo $dInfo
         puts "ChgDir: $dir"
         set newDir 2
      }
   }
   # Wird nur das ATTRIBUT einer Datei in einem Dir oder die Anzahl dortiger Dateien geändert,
   # haben wir es bis jetzt evtl. noch gar nicht mitbekommen. Wir müssen also IMMER auch alle
   # Dateieinträge in allen Dirs lesen und jeweils schauen, ob wir schon einen Eintrag dafür
   # haben, oder ob ein Eintrag zwar schon vorhanden aber die Datei möglicherweise auf Platte
   # verändert wurde. Daher erfolgt hier eine Abfrage => (ergibt IMMER true).
   if {$newDir >= 0} {
      # hier nicht globx, da nicht erneut rekursiv - wir haben schon alles Dirs!
      #  müssen HIDDEN-Files auch berücksichtigt werden? Dann Extrastep!
      foreach fil [glob -nocomplain -dir $dir -types f -- *.jpg *.jpeg] {
         set fn [file tail $fil]
         set newFile 0
         set fInfo [list [file mtime $fil] [file size $fil] [file attributes $fil -archive]]
         set filRows [mk::select $dr.files -count 1 -exact fileName $fn]; # case?
         if {[llength $filRows] == 0} {
            # noch kein Eintrag (d.h. diese Datei in diesem Ordner) vorhanden -> zufügen
            puts "AddFile: $fn -> $dir"
            set fr [mk::row append $dr.files fileName $fn fileInfo $fInfo]
            set newFile 1; # File-Inhalt (Kommentare etc.) muss weiter unten eingelesen werden (da neue Datei)
         } else {
            set fr $dr.files![lindex $filRows 0]; # ACHTUNG: Es kann nur EINEN Eintrag (Match) geben!
            if {[mk::get $fr fileInfo] != $fInfo} {
               # Eintrag schon da, aber File auf Platte verändert (nur MTIME/SIZE/ATTR-Check) -> Update
               mk::set $fr fileInfo $fInfo
               puts "ChgFile: $fn in $dir"
               set newFile 2; # Dir-Inhalt (Files) muss weiter unten eingelesen werden
            }
         }
         # Wenn die Datei nur "von aussen" betrachtet wird, kann eine Änderung z.B. des
         # Kommentars (mittels JPEGCOMMENT), die zufällig die Grösse nicht ändert (und auch nicht
         # das A-Attribut -- ist dies so? ja!) nicht erkannt werden. Daher müssten wir IMMER
         # auch alle Dateikommentare einlesen und verarbeiten... Da dies zu langsam wäre,
         # wird dies jedoch nur wenn als nötig erkannt, oder auf expliziten Wunsch (--force) gemacht.
         if {$newFile > 0 || $force == 1} {
            # alle Suchworte werden in Grossbuchstaben gespeichert (WAS IST MIT 'ß' etc. - normalisieren?!)
            set words [list]
            catch {set words [join [string toupper [jpeg::getComments $fil]]]}; # warum join?? hm....
            set words [lsort -unique $words]; # versehentlich doppelt genannte Suchworte entfernen (gehört auch in JPEGINDEX!)
            foreach word [split $words] {
               set word [string trim $word]; # keine führenden und nachfolgenden Leerstellen
               if {[string length $word]} {
                  set wrdRows [mk::select $wordsVw -count 1 -exact word $word]
                  if {[llength $wrdRows] == 0} {
                     # noch kein Eintrag für dieses Suchwort vorhanden -> neu zufügen
                     puts "AddWord: $word"
                     set wr [mk::row append $wordsVw word $word]
                  } else {
                     # Eintrag schon vorhanden
                     puts "ChgWord: $word"
                     set wr $wordsVw![lindex $wrdRows 0]; # ACHTUNG: Es kann nur EINEN Eintrag (Match) geben!
                  }
                  # Pointer auf Dir, in dem Datei ist (die das Wort enthält), ggF. anfügen
                  set ptrRows [mk::select $wr.ptrs -count 1 -exact dirNr [idxFromRec $dr]]
                  if {[llength $ptrRows] == 0} {
                     # noch kein Eintrag für dieses Dir vorhanden -> neu zufügen
                     puts "AddDirPtr: $dir"
                     set pr [mk::row append $wr.ptrs dirNr [idxFromRec $dr]]
                  } else {
                     # Dir-Eintrag schon vorhanden
                     puts "ChgDirPtr: $dir"
                     set pr $wr.ptrs![lindex $ptrRows 0]; # ACHTUNG: Es kann nur EINEN Eintrag (Match) geben!
                  }
                  set fpRows [mk::select $pr.filePtrs -count 1 -exact fileNr [idxFromRec $fr]]
                  if {[llength $fpRows] == 0} {
                     # noch kein Eintrag für diese Datei in diesem Dir vorhanden -> neu zufügen
                     puts "AddFilePtr: $fn"
                     mk::row append $pr.filePtrs fileNr [idxFromRec $fr]
                  }
               }; # leere Suchworte übergehen
            }
         }
      }
   }
}
mk::set $ctlVw!0 pending 0 lastRun [clock milliseconds]
mk::file commit db; # Änderungen erst bei Erfolg herausschreiben (ist das wirklich schlau...?)
# stauen sie sich im Hauptspeicher???
mk::file close db

Query the index for on or more search words

# jpegquery3.tcl (c) M.Hoffmann 2009
# 21.06.2009 iA - momentan nur eingeschränkte Suche:
#                  alle Angegebenen Worte werden implizit mit OR verknüpft.
#                 Parsing für x {and|or} y {and|or} z entwickeln. Evtl.:
#                 a+b c d+e (Klammern?)
# 05.07.2009
#
# NOTIZEN:
# - JPEGCOMMENT müsste @Dateien oder Ordner mit Links auswerten
# - SOUNDEX-Algorithmus integrieren (--like <wort>)
# - Mit --case Schreibart berücksichtigen
# - Evtl. nur ohne --noglob kein * an die Suchworte anfügen
# - NUR LIVESUCHE müsste auch möglich sein -- ohne Rückgriff auf Index!!
# - Querysprache? (and, or, not...) -globnc -regexp AND OR !!!!!!!!
# - wahlweise Angabe eines Ausgabeverzeichnisses, dort Anlage von .LNKs; dies
#   kann aber über PIPING erledigt werden: jpegquery|jpegmklink <linkDir>
# - Speicherung der Ergebnisse lohnt nicht (nur für später mögliche,
#   sehr komplexe und damit zeitraubende Abfragen - aber warum sollte man die
#   speichern?)
# - Suche nicht nur nach Kommentarwörtern, sondern auch nach Datei-(später auch
#   JPEG-)Datum! Einschränkung dann auch auf bestimmtes Dir etc.

package require Mk4tcl

if {$argc == 0} {puts "Parameter: suchwort \[suchwort \[...\]\]"; exit}
set indx [file normalize [file join [file dirname [info script]] index3.db]]
puts stderr "indx: $indx"; # fürs erste DB im Scriptpfad
puts stderr "such: $argv"

mk::file open db $indx -readonly
set ctlVw   [mk::view layout db.ctl {pending lastRun}]
set dirsVw  [mk::view layout db.dirs {dirName dirInfo {files {fileName fileInfo}}}]
set wordsVw [mk::view layout db.words {word {ptrs {dirNr {filePtrs {fileNr}}}}}]

# Für jedes Wort muss ein SELECT durchgeführt werden. Ergebnismengen müssen
#  später verknüpft werden (AND, OR (KLAMMERN)); jetzt implizit immer OR.
set ctr 0
foreach a $argv {
   # ACHTUNG: wegen -globnc sind hier MEHRERE HITS möglich
   #  Alternativ: -keyword -regexp
   foreach w [mk::select $wordsVw -globnc word $a] {
      #                                                       puts "word#: $w"
      mk::loop p $wordsVw!$w.ptrs {
         # puts [mk::get $p dirNr]->
         set dPtr [mk::get $p dirNr]
         set dir [mk::get $dirsVw!$dPtr dirName]
         mk::loop f $p.filePtrs {
            # puts \t[mk::get $f fileNr]
            set file [mk::get $dirsVw!$dPtr.files![mk::get $f fileNr] fileName]
            # hier durch Einlesen der aktuellen Suchwörter einen Quercheck
            # vornehmen: wenn das Suchwort gar nicht mehr in der Datei ist,
            # die Verpointerung in der DB korrigieren!
            puts [file join $dir $file]
            incr ctr
         }
      }
   }
}
puts stderr "Anzahl Bilder: $ctr"
mk::file close db

A little helper prog

@tclsh jpegquery3.tcl %* > %temp%\query.txt 2>nul
@c:\Programme\IrfanView\i_view32.exe /slideshow=%temp%\query.txt /fs /closeslideshow
  • This one collects the names of all JPGs which contain the given search word(s); a slideshow with the pictures ist started afterwords via IrFanView .

Belonging to: Phototools - Interactive Editing Of JPG-Comments