source: trunk/modules/abstract.tcl @ 1143

Revision 1132, 23.9 KB checked in by james, 5 months ago (diff)

new %! and %= macros

%! with optional {chance} stops output at that point

$= with {list:of:items} picks one item in-place

adjust some abstracts to use the new things
add abstract reset command
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
Line 
1# bMotion - Abstract Handling
2#
3
4###############################################################################
5# bMotion - an 'AI' TCL script for eggdrops
6# Copyright (C) James Michael Seward 2000-2008
7#
8# This program is free software; you can redistribute it and/or modify
9# it under the terms of the GNU General Public License as published by
10# the Free Software Foundation; either version 2 of the License, or
11# (at your option) any later version.
12#
13# This program is distributed in the hope that it will be useful, but
14# WITHOUT ANY WARRANTY; without even the implied warranty of
15# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16# General Public License for more details.
17#
18# You should have received a copy of the GNU General Public License
19# along with this program; if not, write to the Free Software
20# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
21###############################################################################
22
23# Summary of new abstract system design:
24#
25# Abstracts are getting out of control... the amount of information bMotion tracks can get silly
26# with the whole learning arrangement. The idea behind the new system is that abstracts are stored
27# on disk, and loaded into memory when needed, at which point they're loaded into memory.
28#
29# At some point they're unloaded (i.e. deallocated) out of memory to free up space. This will
30# probably be done by deallocating them 5 mins after their last use.
31#
32# This has important implications for bMotion. No longer will abstracts be stored as global-scope
33# lists, but in some name-indexed array. Code that directly fetches abstracts (rather than using
34# %VAR{}) will fail.
35#
36# Due to the way the caching will work, abstracts should be fetched through an interface rather than
37# directly indexing the array. This interface also means the way abstracts are stored internally can
38# be changed later on without affecting the operation of the rest of bMotion.
39#
40# Variables:
41#   bMotion_abstract_contents: a name-indexed array containing the lists of abstracts
42#   bMotion_abstract_timestamps: a name-indexed array containing the last access time of an abstract
43#                                0 means not cached
44#
45# Functions:
46#   bMotion_abstract_register(abstract): register that an abstract should be tracked. A file for it
47#                                        if created on disk if needed; if the file exists then the
48#                                        contents are loaded
49#   bMotion_abstract_add(abstract, contents): add an abstract to a list. The change is immediately
50#                                             written to disk
51#   bMotion_abstract_get(abstract): return a random element from the list. The list is transparnetly
52#                                   loaded from disk if needed
53#   bMotion_abstract_gc(): the "garbage collector": unsets any abstracts not used recently
54#   bMotion_abstract_all(abstract): return the list of all elements from an abstract
55#   bMotion_abstract_delete(abstract, index): delete from an abstract. The change is immediately
56#                                             written to disk
57#   bMotion_abstract_load(abstract): cache the abstract list in memory from disk
58#   bMotion_abstract_save(abstract): saves the cached version to disk
59#
60# Admin plugin to be loaded (but not from this module):
61#   !bmadmin abstract (add|list|view|del(ete)?|cache|gc) ...
62#
63# NOTE: This module should be loaded before plugins as they will need it to register abstracts
64#
65# The abstracts will be stored in ./abstracts/<language>/<abstract name>.txt in the bMotion directory. The
66# fileformat is simply one per line.
67
68# default = mixin own gender
69# reverse = mixin opposite gender
70# none = don't mixin at all
71set BMOTION_MIXIN_DEFAULT 0
72set BMOTION_MIXIN_REVERSE 1
73set BMOTION_MIXIN_NONE 2
74set BMOTION_MIXIN_BOTH 3
75set BMOTION_MIXIN_FEMALE 4
76set BMOTION_MIXIN_MALE 5
77
78if { [bMotion_setting_get "abstractMaxAge"] != "" } {
79  set bMotion_abstract_max_age [bMotion_setting_get "abstractMaxAge"]
80} else {
81  set bMotion_abstract_max_age 300
82}
83
84if { [bMotion_setting_get "abstractMaxNumber"] != "" } {
85  set bMotion_abstract_max_number [bMotion_setting_get "abstractMaxNumber"]
86} else {
87  set bMotion_abstract_max_number 600
88}
89
90# initialise the arrays
91
92if {![info exists bMotion_abstract_contents]} {
93  array set bMotion_abstract_contents {}
94  array set bMotion_abstract_languages {}
95  array set bMotion_abstract_timestamps {}
96  set bMotion_abstract_ondisk [list]
97        array set bMotion_abstract_last_get {}
98        array set bMotion_abstract_filters {}
99}
100
101set bMotion_abstract_dir "$bMotionLocal/abstracts/$bMotionInfo(language)"
102
103# garbage collect the abstracts arrays
104proc bMotion_abstract_gc { } {
105        bMotion_putloglev 5 * "bMotion_abstract_gc"
106  global bMotion_abstract_contents bMotion_abstract_timestamps
107  global bMotion_abstract_max_age bMotion_abstract_ondisk
108  global bMotionInfo bMotion_abstract_languages
109  set lang $bMotionInfo(language)
110
111  bMotion_putloglev 2 * "Garbage collecting abstracts..."
112
113  set abstracts [array names bMotion_abstract_contents]
114  set limit [expr [clock seconds] - $bMotion_abstract_max_age]
115
116  set expiredList ""
117  set expiredCount 0
118
119  foreach abstract $abstracts {
120    if {($bMotion_abstract_timestamps($abstract) < $limit) && ($bMotion_abstract_timestamps($abstract) > 0) || $bMotion_abstract_languages($abstract) != $lang } {
121      append expiredList "$abstract "
122      incr expiredCount
123      unset bMotion_abstract_contents($abstract)
124      unset bMotion_abstract_languages($abstract)
125      set bMotion_abstract_timestamps($abstract) 0
126      lappend bMotion_abstract_ondisk $abstract
127    }
128  }
129
130  if {$expiredList != ""} {
131    bMotion_putloglev 1 * "expired $expiredCount abstracts: $expiredList"
132  }
133}
134
135proc bMotion_abstract_register { abstract { stuff "" } } {
136        bMotion_putloglev 5 * "bMotion_abstract_register ($abstract)"
137  global bMotion_abstract_contents bMotion_abstract_timestamps
138  global bMotionModules bMotion_testing bMotion_loading
139  global bMotionInfo bMotion_abstract_languages bMotion_abstract_dir
140        global bMotion_abstract_last_get bMotion_abstract_filters
141
142  #set timestamp to now
143  set bMotion_abstract_timestamps($abstract) [clock seconds]
144  set lang $bMotionInfo(language)
145        set bMotion_abstract_last_get($abstract) ""
146        set bMotion_abstract_filters($abstract) ""
147
148  #load any existing abstracts
149  if [file exists "$bMotion_abstract_dir/${abstract}.txt"] {
150    bMotion_abstract_load $abstract 
151  } else {
152    # check that the language directory exists while we're at it
153    if { ![file exists $bMotion_abstract_dir] } {
154      [file mkdir $bMotion_abstract_dir]
155    }
156    #file doesn't exist - create an empty one
157    #create blank array for it
158    set bMotion_abstract_contents($abstract) [list]
159    set bMotion_abstract_languages($abstract) "$lang"
160    bMotion_putloglev 1 * "Creating new abstract file for $abstract"
161    set fileHandle [open "$bMotion_abstract_dir/${abstract}.txt" "w"]
162    puts $fileHandle " "
163  }
164
165  if {[info exists fileHandle]} {
166    close $fileHandle
167  }
168
169        if {$stuff != ""} {
170                # batch-add at the same time
171                bMotion_putloglev 1 * "Batchadding during registration for $abstract"
172                bMotion_abstract_batchadd $abstract $stuff
173        }
174}
175
176proc bMotion_abstract_load { abstract } { 
177        bMotion_putloglev 5 * "bMotion_abstract_load ($abstract)" 
178       
179        global bMotion_abstract_contents bMotion_abstract_timestamps
180  global bMotionModules bMotion_abstract_ondisk
181  global bMotion_loading bMotion_testing
182  global bMotionInfo bMotion_abstract_languages
183        global bMotion_abstract_dir
184  set lang $bMotionInfo(language)
185
186  bMotion_putloglev 1 * "Attempting to load $bMotion_abstract_dir/${abstract}.txt"
187
188  if {![file exists "$bMotion_abstract_dir/${abstract}.txt"]} {
189    return
190  }
191
192  #create blank array for it
193  set bMotion_abstract_contents($abstract) [list]
194  set bMotion_abstract_languages($abstract) "$lang"
195
196  #set timestamp to now
197  set bMotion_abstract_timestamps($abstract) [clock seconds]
198
199  if {$bMotion_testing} {
200    return 0
201  }
202
203  #remove from ondisk list
204  set index [lsearch -exact $bMotion_abstract_ondisk $abstract]
205  set bMotion_abstract_ondisk [lreplace $bMotion_abstract_ondisk $index $index]
206
207  set fileHandle [open "$bMotion_abstract_dir/${abstract}.txt" "r"]
208  set line [gets $fileHandle]
209  set needReSave 0
210  set count 0
211
212  while {![eof $fileHandle]} {
213    set line [string trim $line]
214    if {$line != ""} {
215                        lappend bMotion_abstract_contents($abstract) $line
216      incr count
217    }
218    set line [gets $fileHandle]
219  }
220
221        #optimise
222        set bMotion_abstract_contents($abstract) [lsort -unique $bMotion_abstract_contents($abstract)]
223        set newcount [llength $bMotion_abstract_contents($abstract)]
224        if {$newcount < $count} {
225                bMotion_putloglev d * "Shrunk abstract $abstract by [expr $count - $newcount] items by de-duping"
226                set needReSave 1
227        }
228
229        if {$abstract == "sillyThings"} {
230                bMotion_putloglev 1 * "Performing 'sillyThings' filtering"
231                set newlist [list]
232                foreach element $bMotion_abstract_contents($abstract) {
233                        if {[bMotion_filter_sillyThings $element] == 1} {
234                                lappend newlist $element
235                        }
236                }
237                set bMotion_abstract_contents($abstract) $newlist
238                set needReSave 1
239        }
240
241  if {[info exists fileHandle]} {
242    close $fileHandle
243  }
244
245  if {$needReSave} {
246    bMotion_abstract_save $abstract
247  }
248
249        bMotion_putloglev 1 * "Abstract $abstract loaded, checking for filter"
250        bMotion_abstract_apply_filter $abstract
251}
252
253proc bMotion_abstract_add { abstract text {save 1} } {
254        bMotion_putloglev 5 * "bMotion_abstract_add ($abstract, $text, $save)"
255  global bMotion_abstract_contents bMotion_abstract_timestamps bMotion_abstract_max_age
256  global bMotionModules bMotionInfo
257        global bMotion_abstract_dir
258  set lang $bMotionInfo(language)
259
260  bMotion_putloglev 2 * "Adding '$text' to abstract '$abstract'"
261
262  if {$bMotion_abstract_timestamps($abstract) < [expr [clock seconds] - $bMotion_abstract_max_age]} {
263    #bMotion_abstract_load $abstract
264    #new more efficient way
265    # - append it to the file regardless
266    # - it can be filtered on load
267
268    bMotion_putloglev 2 * "updating abstracts '$abstract' on disk"
269    if {$save} {
270      set fileHandle [open "$bMotion_abstract_dir/${abstract}.txt" "a+"]
271      puts $fileHandle $text
272      close $fileHandle
273    }
274    return
275  }
276
277  if {[lsearch -exact $bMotion_abstract_contents($abstract) $text] == -1} {
278    lappend bMotion_abstract_contents($abstract) $text
279    if {$save} {
280      bMotion_putloglev 2 * "updating abstracts '$abstract' on disk and in memory"
281      set fileHandle [open "$bMotion_abstract_dir/${abstract}.txt" "a+"]
282      puts $fileHandle $text
283      close $fileHandle
284    }
285  }
286}
287
288proc bMotion_abstract_save { abstract } {
289        bMotion_putloglev 5 * "bMotion_abstract_save"
290  global bMotion_abstract_contents
291  global bMotionModules bMotion_testing bMotion_loading
292  global bMotion_abstract_max_number bMotionInfo bMotion_abstract_languages
293        global bMotion_abstract_dir
294  set lang $bMotionInfo(language)
295
296  if {$lang != $bMotion_abstract_languages($abstract) } {
297    bMotion_putloglev 1 * "Did not save '$abstract' to disk (wrong language)"
298    return 0
299  }
300
301  set tidy 0
302  set count 0
303  set drop_count 0
304
305  #don't save if we're starting up else we'll lose saved stuff
306  if {$bMotion_testing} {
307    return 0
308  }
309
310  bMotion_putloglev 1 * "Saving abstracts '$abstract' to disk"
311
312  set fileHandle [open "$bMotion_abstract_dir/${abstract}.txt" "w"]
313  set number [llength $bMotion_abstract_contents($abstract)]
314  if {$number > $bMotion_abstract_max_number} {
315    bMotion_putloglev d * "Abstract $abstract has too many elements ($number > $bMotion_abstract_max_number), tidying up"
316    set tidy 1
317  }
318  foreach a $bMotion_abstract_contents($abstract) {
319    if {$tidy} {
320      if {[rand 100] < 10} {
321        bMotion_putloglev 3 * "Dropped '$a' from abstract $abstract"
322        incr drop_count
323        continue
324      }
325    }
326    puts $fileHandle $a
327    incr count
328  }
329  if {$tidy} {
330                bMotion_putloglev d * "Abstract $abstract now has $count elements ($drop_count fewer)"
331  }
332  close $fileHandle
333        bMotion_putloglev 2 * "Saved abstract $abstract to disk"
334}
335
336proc bMotion_abstract_all { abstract } {
337        bMotion_putloglev 5 * "bMotion_abstract_all ($abstract)"
338  global bMotion_abstract_contents bMotion_abstract_timestamps bMotion_abstract_max_age
339
340        if [info exists bMotion_abstract_timestamps($abstract)] {
341                if {$bMotion_abstract_timestamps($abstract) < [expr [clock seconds] - $bMotion_abstract_max_age]} {
342                        bMotion_abstract_load $abstract
343                }
344
345                return $bMotion_abstract_contents($abstract)
346        } else {
347        #abstract doesn't exist
348                bMotion_putloglev d * "bMotion_abstract_all: couldn't find abstract '$abstract' in new system"
349                catch {
350                        global $abstract
351                        set var [subst $$abstract]
352
353                        return $var
354                }
355                bMotion_putloglev d * "bMotion_abstract_all: $abstract doesn't exist as a global variable either :("
356                return ""
357        }
358
359}
360
361# look to see if an abstract contains an item (warning: could be slow)
362proc bMotion_abstract_contains { abstract item } {
363        bMotion_putloglev 4 * "abstract: bMotion_abstract_contains $abstract $item"
364
365        set contents [bMotion_abstract_all $abstract]
366
367        if {[llength $contents] == 0} {
368                return 0
369        }
370
371        set location [lsearch $contents $item]
372        if {$location > -1} {
373                return 1
374        } else {
375                return 0
376        }
377}
378
379proc bMotion_abstract_exists { abstract } {
380        bMotion_putloglev 5 * "bMotion_abstract_exists ($abstract)"
381  global bMotion_abstract_contents bMotion_abstract_timestamps bMotion_abstract_max_age bMotion_abstract_last_get
382
383  bMotion_putloglev 2 * "checking for existence of abstract $abstract"
384
385  if {![info exists bMotion_abstract_timestamps($abstract)]} {
386    return 0
387  }
388        return 1
389}
390
391proc bMotion_abstract_get { abstract { mixin_type 0 } } {
392        bMotion_putloglev 5 * "bMotion_abstract_get ($abstract $mixin_type)"
393  global bMotion_abstract_contents bMotion_abstract_timestamps bMotion_abstract_max_age bMotion_abstract_last_get bMotionInfo
394
395  bMotion_putloglev 2 * "getting abstract $abstract"
396
397  if {![info exists bMotion_abstract_timestamps($abstract)]} {
398    return ""
399  }
400
401  if {$bMotion_abstract_timestamps($abstract) < [expr [clock seconds] - $bMotion_abstract_max_age]} {
402    bMotion_putloglev 1 * "abstract $abstract has been unloaded, reloading..."
403    bMotion_abstract_load $abstract
404  }
405
406  set bMotion_abstract_timestamps($abstract) [clock seconds]
407
408        if {![info exists bMotion_abstract_last_get($abstract)]} {
409                set bMotion_abstract_last_get($abstract) ""
410        }
411
412        # look for male and female versions, and merge in if needed
413        set final_version [bMotion_abstract_all $abstract]
414        switch $mixin_type {
415                0 {
416                        if [bMotion_abstract_exists "${abstract}_$bMotionInfo(gender)"] {
417                        # mix-in the gender one with the vanilla one
418                                bMotion_putloglev 1 * "mixing in $bMotionInfo(gender) version of $abstract"
419                                set final_version [concat $final_version [bMotion_abstract_all "${abstract}_$bMotionInfo(gender)"]]
420                        } else {
421                                set final_version [bMotion_abstract_all $abstract]
422                        }
423                }
424                1 {
425                        if {[bMotion_setting_get "gender"] == "male"} {
426                                set gender "female"
427                        } else {
428                                set gender "male"
429                        }
430                        if [bMotion_abstract_exists "${abstract}_$gender"] {
431                        # mix-in the gender one with the vanilla one
432                                bMotion_putloglev 1 * "mixing in $gender version of $abstract"
433                                set final_version [concat $final_version [bMotion_abstract_all "${abstract}_$gender"]]
434                        } else {
435                                set final_version [bMotion_abstract_all $abstract]
436                        }
437                }
438                2 {
439                        # noop, we did it already before the switch
440                }
441                3 {
442                        if [bMotion_abstract_exists "${abstract}_male"] {
443                                bMotion_putloglev 1 * "mixing in male version of $abstract"
444                                set final_version [concat $final_version [bMotion_abstract_all "${abstract}_male"]]
445                        }
446                        if [bMotion_abstract_exists "${abstract}_female"] {
447                                bMotion_putloglev 1 * "mixing in female version of $abstract"
448                                set final_version [concat $final_version [bMotion_abstract_all "${abstract}_female"]]
449                        }
450                }
451                5 {
452                        if [bMotion_abstract_exists "${abstract}_male"] {
453                                bMotion_putloglev 1 * "mixing in male version of $abstract"
454                                set final_version [concat $final_version [bMotion_abstract_all "${abstract}_male"]]
455                        }
456                }
457                4 {
458                        if [bMotion_abstract_exists "${abstract}_female"] {
459                                bMotion_putloglev 1 * "mixing in female version of $abstract"
460                                set final_version [concat $final_version [bMotion_abstract_all "${abstract}_female"]]
461                        }
462                }
463
464                default {
465                        putlog "bMotion ERROR: unknown mixin type $mixin_type for abstract $abstract"
466                }
467        }
468
469        if {[llength $final_version] == 0} {
470                bMotion_putloglev d * "abstract '$abstract' is empty!"
471                return ""
472        } else {
473                set retval [lindex $final_version [rand [llength $final_version]]]
474                if {[llength $final_version] > 1} {
475                        set count 0
476                        while {$retval == $bMotion_abstract_last_get($abstract)} {
477                                bMotion_putloglev 1 * "fetched repeat value for abstract $abstract, trying again"
478                                bMotion_putloglev 1 * "this: $retval ... last: $bMotion_abstract_last_get($abstract)"
479                                set retval [lindex $final_version [rand [llength $final_version]]]
480                                incr count
481                                if {$count > 5} {
482                                        bMotion_putloglev d * "trying too hard to find non-dupe for abstract $abstract, giving up and using $retval"
483                                        break
484                                }
485                        }
486                }
487        }
488
489        set bMotion_abstract_last_get($abstract) $retval
490        bMotion_putloglev 5 * "successfully got '$retval' from '$abstract'"
491        return $retval
492}
493
494proc bMotion_abstract_delete { abstract index } {
495        bMotion_putloglev 5 * "bMotion_abstract_delete ($abstract, $index)"
496  global bMotion_abstract_contents
497
498  set bMotion_abstract_contents($abstract) [lreplace $bMotion_abstract_contents($abstract) $index $index]
499  bMotion_abstract_save $abstract
500}
501
502proc bMotion_abstract_auto_gc { min hr a b c } {
503  bMotion_abstract_gc
504}
505
506proc bMotion_abstract_batchadd { abstract stuff } {
507  bMotion_putloglev 1 * "batch-adding to $abstract"
508  foreach i $stuff {
509    bMotion_abstract_add $abstract $i 0
510  }
511  bMotion_abstract_save $abstract
512}
513
514# flush all of the abstracts to disk
515# this was created for changing languages on the fly. If you're using this
516# for some other reason, then you might want to be sure.
517proc bMotion_abstract_flush { } {
518  global bMotionInfo bMotion_abstract_contents
519  global bMotion_abstract_languages
520  set lang $bMotionInfo(language)
521  set abstracts [array names bMotion_abstract_contents]
522  foreach abstract $abstracts {
523    set storedLang $bMotion_abstract_languages($abstract)
524    if { $storedLang == $lang } {
525      bMotion_abstract_save $abstract
526      unset bMotion_abstract_contents($abstract)
527      unset bMotion_abstract_languages($abstract)
528    }
529  }
530  array set bMotion_abstract_contents {}
531  array set bMotion_abstract_languages {}
532  array set bMotion_abstract_timestamps {}
533  set bMotion_abstract_ondisk [list]
534}
535
536# this loads language abstracts for the current language in bMotionInfo
537proc bMotion_abstract_revive_language { } {
538  global bMotionSettings bMotionInfo bMotionModules
539  global bMotion_abstract_contents bMotionLocal bMotion_abstract_filters
540
541  set lang $bMotionInfo(language)
542
543
544  bMotion_putloglev 2 * "bMotion: reviving language ($lang) abstracts"
545  set languages [split $bMotionSettings(languages) ","]
546  # just check if it's ok to use this language
547  set ok 0
548  foreach language $languages {
549    if { $lang == $language } {
550      set ok 1
551    }
552  }
553  if { $ok != 1 } {
554    bMotion_putloglev 2 * "bMotion: language not found, cannot revive"
555    return -1
556  }
557  # if the default abstracts exists, use it first
558  if { [file exists "$bMotionModules/abstracts/$lang/abstracts.tcl"] } {
559                bMotion_putloglev d * "loading system abstracts for lang $lang"
560    catch {
561      source "$bMotionModules/abstracts/$lang/abstracts.tcl"
562    }
563  } else {
564    bMotion_putloglev 2 * "bMotion: language default abstracts not found"
565  }
566        # then we need to load any others
567        #TODO: should this be bMotionLocal not bMotionModules?
568        set files [glob -nocomplain "$bMotionModules/abstracts/$lang/*.txt"]
569        if { [llength $files] > 0} {
570                foreach f $files {
571                        set pos [expr [string last "/" $f] + 1]
572                        set dot [expr [string last ".txt" $f] - 1]
573                        set abstract [string range $f $pos $dot]
574                        bMotion_putloglev 2 * "checking $abstract"
575                        set len 0
576                        catch { set len [llength $bMotion_abstract_contents($abstract)] } val
577                        if { $val != "$len" } {
578                                bMotion_abstract_load $abstract
579                        }
580                }
581        }
582
583        # load the local abstracts
584        bMotion_putloglev d * "looking for local abstracts..."
585        if [file exists "$bMotionLocal/abstracts/$lang/abstracts.tcl"] {
586                bMotion_putloglev d * "found local abstracts.tcl for $lang, loading"
587                catch {
588                        source "$bMotionLocal/abstracts/$lang/abstracts.tcl"
589                }
590        }
591}
592
593# this is to update people from the old abstracts to the new abstracts.
594# it only needs to be run once, and should be removed afterwards
595proc bMotion_abstract_check {  } {
596  global bMotionInfo bMotionModules
597  set lang $bMotionInfo(language)
598  set dir "$bMotionModules/abstracts/$lang"
599  if { ![file exists $dir] } {
600    [file mkdir $dir]
601  }
602  set files [glob -nocomplain "$bMotionModules/abstracts/*.txt"]
603  if { [llength $files] == 0} {
604    return 0
605  }
606  foreach f $files {
607    catch {
608                        [file rename -force -- $f "${dir}/"]
609    }
610  }
611}
612
613# filter out stuff from an abstract
614proc bMotion_abstract_filter { abstract filter } {
615        global bMotion_abstract_contents bMotion_abstract_ondisk
616
617  set index [lsearch -exact $bMotion_abstract_ondisk $abstract]
618        if {$index > -1} {
619                bMotion_abstract_load $abstract
620        }
621       
622        set contents [list]
623        catch {
624                set contents $bMotion_abstract_contents($abstract)
625        }
626
627        if {[llength $contents] == 0} {
628                if {$abstract != "_all"} {
629                        bMotion_putloglev d * "bMotion_abstract_filter: can't get contents for $abstract"
630                }
631                return
632        }
633
634        set new_contents [list]
635        set initial_size [llength $contents]
636
637        foreach element $contents {
638                bMotion_putloglev 2 * "considering $element for filtering"
639                set do_filter 0
640                foreach filter_text $filter {
641                        if {(!$do_filter) && [regexp $filter_text $element]} {
642                                bMotion_putloglev 1 * "abstract $abstract element $element matches filter $filter_text, dropping"
643                                set do_filter 1
644                        }
645                }
646                if {!$do_filter} {
647                        lappend new_contents $element
648                }
649        }
650
651        set new_size [llength $new_contents]
652  set diff [expr $initial_size - $new_size]
653
654        if {$diff > 0} {
655                bMotion_putloglev d * "abstract $abstract reduced by $diff items with filter $filter"
656                set bMotion_abstract_contents($abstract) $new_contents
657                bMotion_abstract_save $abstract
658        }
659}
660
661# apply a filter to an abstract, if it has one defined
662proc bMotion_abstract_apply_filter { abstract } {
663        global bMotion_abstract_filters
664
665        set filter ""
666        catch {
667                set filter $bMotion_abstract_filters($abstract)
668        }
669        if {$filter == ""} {
670                return
671        }
672
673        bMotion_abstract_filter $abstract $filter
674        catch {
675                set filter $bMotion_abstract_filter(_all)
676                bMotion_putloglev 1 * "abstract: found an _all filter, applying to $abstract"
677                bMotion_abstract_filter $abstract $filter
678        }
679       
680}
681
682# register a filter for an abstract
683proc bMotion_abstract_add_filter { abstract filter_text } {
684        global bMotion_abstract_filters
685
686        lappend bMotion_abstract_filters($abstract) $filter_text
687
688        bMotion_putloglev 1 * "registered filter /$filter_text/ for abstract $abstract"
689
690        # apply it now
691        bMotion_abstract_apply_filter $abstract
692}
693
694# nuke all filters
695proc bMotion_abstract_flush_filters { } {
696        global bMotion_abstract_filters
697
698        unset bMotion_abstract_filters
699        array set bMotion_abstract_filters {}
700}
701
702# implementation-independent way to get all filters
703proc bMotion_abstract_list_filters { } {
704        global bMotion_abstract_filters
705        return $bMotion_abstract_filters
706}
707
708# implementation-independent way to get all abstract names
709proc bMotion_abstract_get_names { } {
710        global bMotion_abstract_contents
711        return [array names bMotion_abstract_contents]
712}
713
714# clear an abstract (used when there have been significant changes to distribution)
715# abstract must have been registered in advance!
716proc bMotion_abstract_reset { abstract } {
717        bMotion_putloglev 4 * "bMotion_abstract_reset $abstract"
718        global bMotion_abstract_contents bMotion_abstract_ondisk
719       
720  set index [lsearch -exact $bMotion_abstract_ondisk $abstract]
721        if {$index > -1} {
722                bMotion_abstract_load $abstract
723        }
724       
725        set bMotion_abstract_contents($abstract) [list]
726        bMotion_abstract_save $abstract
727}
728
729bind time - "* * * * *" bMotion_abstract_auto_gc
730
731# the check has to be run to update old systems
732bMotion_abstract_check
733# we have to revive at least one language
734bMotion_abstract_revive_language
735
736
737bMotion_putloglev d * "abstract module loaded"
Note: See TracBrowser for help on using the repository browser.