# 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

# 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

@tclsh jpegquery3.tcl %* > %temp%\query.txt 2>nul
@c:\Programme\IrfanView\i_view32.exe /slideshow=%temp%\query.txt /fs /closeslideshow