Work in progress. [AK] Out of curiosity: [sqlite]/fts based ? [MHo]: [Metakit]-based! ---- '''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 ) # - 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 # - 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 [http://www.irfanview.de/%|%IrFanView]. ---- Belonging to: [Phototools - Interactive Editing Of JPG-Comments] <> Category File | Category Graphics