--- deliantra/server/ext/map-tags.ext	2007/09/13 16:16:36	1.7
+++ deliantra/server/ext/map-tags.ext	2012/02/03 03:01:45	1.28
@@ -1,11 +1,11 @@
 #! perl # mandatory
 
-our $SCHEDULE_INTERVAL = $cf::CFG{extractor_schedule_interval} || 3600;
+CONF SCHEDULE_INTERVAL : extractor_schedule_interval = 3600;
 
 use JSON::XS;
 
-my $db_mapinfo = cf::sync_job { cf::db_table "tag-mapinfo" }; # info/cache for maps
-my $db_target  = cf::sync_job { cf::db_table "tag-target"  };     # tag => maps
+our $db_mapinfo = cf::db_table "tag-mapinfo"; # info/cache for maps
+our $db_target  = cf::db_table "tag-target";  # tag => maps
 
 sub remove_tag_target {
    my ($txn, $tag, $target) = @_;
@@ -42,68 +42,51 @@
 
    my $hash = join ",", 1, (stat _)[7,9], $file;
 
-   my $old_tags;
-
    my $txn = $cf::DB_ENV->txn_begin;
 
    utf8::encode $key;
    BDB::db_get $db_mapinfo, $txn, $key, my $data;
 
    unless ($!) {
-      $data = from_json $data;
+      $data = decode_json $data;
       return if $data->{hash} eq $hash;
-      $old_tags = $data->{tags};
-   }
 
-   $old_tags ||= [];
+      # remove all old tags unconditionally
+      remove_tag_target $txn, $_, $key
+         for @{ $data->{tags} };
+   }
 
    my $f = new_from_file cf::object::thawer $file
       or return;
 
    my @tags = sort $f->extract_tags;
-   $data = to_json { hash => $hash, tags => \@tags };
+   $data = encode_json { hash => $hash, tags => \@tags };
 
    BDB::db_put $db_mapinfo, $txn, $key, $data;
 
-   # 1. remove tags no longer existing
-   for my $tag (@$old_tags) {
-      next if grep $_ eq $tag, @tags;
-      remove_tag_target $txn, $tag, $key;
-   }
-
-   # 2. add tags that are new
-   for my $tag (@tags) {
-      next if grep $_ eq $tag, @$old_tags;
-      add_tag_target $txn, $tag, $key;
-   }
+   # add all tags
+   add_tag_target $txn, $_, $key
+      for @tags;
 
    # we don't actually care if it succeeds or not, as we
    # will just retry an hour later
    BDB::db_txn_finish $txn;
 
-#   warn "tag-updated $file (= $key) $hash\n";#d#
+   cf::debug "tag-updated $file (= $key) <@tags>\n"
+      if @tags;
 }
 
 sub scan_static {
-   my ($dir, $map) = @_;
-
-   my ($dirs, $files) = Coro::AIO::aio_scandir $dir, 2
-      or return;
+   my $maps = cf::map::static_maps;
 
-   for my $file (@$files) {
-      my $name = $file;
-      next unless $name =~ s/\.map$//;
-      utf8::decode $name;
-
-      scan_map "s$map$name", "$dir/$file";
-   }
-
-   &scan_static ("$dir/$_", "$map$_/")
-      for @$dirs;
+   scan_map "s$_", "$cf::MAPDIR$_.map"
+      for @$maps;
 }
 
 sub reload {
-   my $start = Event::time;
+   my $guard = cf::lock_acquire "map-tags::reload";
+
+   my $start = AE::time;
 
    # 1. check for maps no longer existing
    {
@@ -114,7 +97,7 @@
          BDB::db_c_get $cursor, my $key, my $data, BDB::NEXT;
          last if $!;
 
-         my $data = JSON::XS::from_json $data;
+         my $data = JSON::XS::decode_json $data;
          my ($ver, undef, undef, $path) = split /,/, $data->{hash}, 4;
          push @delkeys, [$key, $data->{tags}]
             if $ver != 1 || Coro::AIO::aio_stat $path;
@@ -145,7 +128,6 @@
 #      scan_dir $cf::PLAYERDIR
 #      for my $login (@{ cf::player::list_logins or [] }) {
 #      for my $path (@{ cf::player::maps $login or [] }) {
-#         cf::cede_to_tick;
 #
 #         $path =~ /^~[^\/]+(\/.*)$/
 #            or next; # doh
@@ -168,18 +150,18 @@
 #      }
 #   }
 
-   warn sprintf "map-tag scan (%fs)", Event::time - $start;
+      cf::info sprintf "map-tag scan finished (%fs)\n", AE::time - $start;
 }
 
-our $RELOAD_SCHEDULER = Event->timer (
-   after    => 0,
-   interval => $SCHEDULE_INTERVAL,
-   data     => cf::WF_AUTOCANCEL,
-   cb       => Coro::unblock_sub {
-      $Coro::current->prio (Coro::PRIO_MIN);
-      reload;
-   },
-);
+our $RELOAD_SCHEDULER = cf::periodic $SCHEDULE_INTERVAL, Coro::unblock_sub {
+   $Coro::current->prio (Coro::PRIO_MIN);
+   $Coro::current->desc ("map-tag scanner");
+   reload;
+};
+
+cf::post_init {
+   $RELOAD_SCHEDULER->invoke (0); # force at startup
+};
 
 # find all objects with the given tag, or at least try to
 sub find($) {
@@ -195,3 +177,11 @@
       grep s/^s//,
       split /\x00/, $data
 }
+
+sub unload {
+   my $guard = cf::lock_acquire "map-tags::reload";
+
+   BDB::db_close $db_target;
+   BDB::db_close $db_mapinfo;
+}
+