server/ext/map-tags.ext

#! perl # mandatory

our $SCHEDULE_INTERVAL = $cf::CFG{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

sub remove_tag_target {
   my ($txn, $tag, $target) = @_;
   #    -     U     O

   utf8::encode $tag;
   BDB::db_get $db_target, $txn, $tag, my $data;
   my @tags = split /\x00/, $data;
   @tags = grep $_ ne $target, @tags;

   if (@tags) {
      BDB::db_put $db_target, $txn, $tag, join "\x00", @tags;
   } else {
      BDB::db_del $db_target, $txn, $tag;
   }
}

sub add_tag_target {
   my ($txn, $tag, $target) = @_;

   utf8::encode $tag;
   BDB::db_put $db_target, $txn, $tag, my $data;
   my @tags = split /\x00/, $data;
   push @tags, $target;
   BDB::db_put $db_target, $txn, $tag, join "\x00", @tags;
}

sub scan_map($$) {
   my ($key, $file) = @_;
   # unicode key, octets file

   Coro::AIO::aio_stat $file
      and next;

   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;
      return if $data->{hash} eq $hash;
      $old_tags = $data->{tags};
   }

   $old_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 };

   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;
   }

   # 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) <@tags>\n"
      if @tags;
}

sub scan_static {
   my ($dir, $map) = @_;

   my ($dirs, $files) = Coro::AIO::aio_scandir $dir, 2
      or return;

   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;
}

sub reload {
   my $guard = cf::lock_acquire "map-tags::reload";

   my $start = Event::time;

   # 1. check for maps no longer existing
   {
      my @delkeys;

      my $cursor = $db_mapinfo->cursor;
      for (;;) {
         BDB::db_c_get $cursor, my $key, my $data, BDB::NEXT;
         last if $!;

         my $data = JSON::XS::from_json $data;
         my ($ver, undef, undef, $path) = split /,/, $data->{hash}, 4;
         push @delkeys, [$key, $data->{tags}]
            if $ver != 1 || Coro::AIO::aio_stat $path;
      }
      BDB::db_c_close $cursor;

      for (@delkeys) {
         my ($key, $tags) = @$_;
         my $txn = $cf::DB_ENV->txn_begin;
         BDB::db_del $db_mapinfo, $txn, $key;
         for my $tag (@{ $tags || [] }) {
            remove_tag_target $txn, $tag, $key;
         }
         BDB::db_txn_finish $txn;
      }
   }

   # 2. scan all static maps
   scan_static $cf::MAPDIR, "/";

   # 3. scan all dynamic maps
   for my $path (@{ cf::map::tmp_maps or [] }, @{ cf::map::random_maps or [] }) {
#         my $map = cf::map::find $path;
#         extract_map_tags "t/$map", $path;
   }
   
      # now hunt for all per-player maps
#      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
#
#         my $base = cf::map::find $1;
#
#         # skip maps without base maps on the assumption
#         # that those are old, unresettable maps
#         next unless $base;
#
#         # skip unresettable maps, for speed
#         next if $base->{deny_reset};
#
#         my $map = cf::map::find $path;
#
#         if ($map->{deny_reset}) {
#            warn "found noreset map with resettable base map, resetting: $path\n";
#            delete $map->{deny_reset};
#         }
#      }
#   }

   warn sprintf "map-tag scan (%fs)", Event::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;
   },
);

# find all objects with the given tag, or at least try to
sub find($) {
   my ($tag) = @_;

   utf8::encode (my $key = $tag);
   BDB::db_get $db_target, undef, $key, my $data;
   utf8::decode $data;

   map { $_->load; $_->find_tagged_objects ($tag) }
      grep $_,
      map { cf::map::find $_ }
      grep s/^s//,
      split /\x00/, $data
}
Revision:	1.8
Committed:	Mon Sep 17 11:45:41 2007 UTC (16 years, 8 months ago) by root
Branch:	MAIN
Changes since 1.7:	+4 -1 lines
Log Message:	lock against multiple reloads
#	User	Rev	Content
1	root	1.1	#! perl # mandatory
2
3	root	1.3	our $SCHEDULE_INTERVAL = $cf::CFG{extractor_schedule_interval} \|\| 3600;
4	root	1.1
5			use JSON::XS;
6
7			my $db_mapinfo = cf::sync_job { cf::db_table "tag-mapinfo" }; # info/cache for maps
8			my $db_target = cf::sync_job { cf::db_table "tag-target" }; # tag => maps
9
10			sub remove_tag_target {
11			my ($txn, $tag, $target) = @_;
12			# - U O
13
14			utf8::encode $tag;
15			BDB::db_get $db_target, $txn, $tag, my $data;
16			my @tags = split /\x00/, $data;
17			@tags = grep $_ ne $target, @tags;
18
19			if (@tags) {
20			BDB::db_put $db_target, $txn, $tag, join "\x00", @tags;
21			} else {
22			BDB::db_del $db_target, $txn, $tag;
23			}
24			}
25
26			sub add_tag_target {
27			my ($txn, $tag, $target) = @_;
28
29			utf8::encode $tag;
30			BDB::db_put $db_target, $txn, $tag, my $data;
31			my @tags = split /\x00/, $data;
32			push @tags, $target;
33			BDB::db_put $db_target, $txn, $tag, join "\x00", @tags;
34			}
35
36			sub scan_map($$) {
37			my ($key, $file) = @_;
38			# unicode key, octets file
39
40			Coro::AIO::aio_stat $file
41			and next;
42
43			my $hash = join ",", 1, (stat _)[7,9], $file;
44
45			my $old_tags;
46
47			my $txn = $cf::DB_ENV->txn_begin;
48
49			utf8::encode $key;
50			BDB::db_get $db_mapinfo, $txn, $key, my $data;
51
52			unless ($!) {
53			$data = from_json $data;
54			return if $data->{hash} eq $hash;
55			$old_tags = $data->{tags};
56			}
57
58			$old_tags \|\|= [];
59
60			my $f = new_from_file cf::object::thawer $file
61			or return;
62
63			my @tags = sort $f->extract_tags;
64			$data = to_json { hash => $hash, tags => \@tags };
65
66			BDB::db_put $db_mapinfo, $txn, $key, $data;
67
68			# 1. remove tags no longer existing
69			for my $tag (@$old_tags) {
70			next if grep $_ eq $tag, @tags;
71			remove_tag_target $txn, $tag, $key;
72			}
73
74			# 2. add tags that are new
75			for my $tag (@tags) {
76			next if grep $_ eq $tag, @$old_tags;
77			add_tag_target $txn, $tag, $key;
78			}
79
80			# we don't actually care if it succeeds or not, as we
81			# will just retry an hour later
82	root	1.7	BDB::db_txn_finish $txn;
83	root	1.1
84	root	1.8	warn "tag-updated $file (= $key) <@tags>\n"
85			if @tags;
86	root	1.1	}
87
88			sub scan_static {
89			my ($dir, $map) = @_;
90
91			my ($dirs, $files) = Coro::AIO::aio_scandir $dir, 2
92			or return;
93
94			for my $file (@$files) {
95			my $name = $file;
96			next unless $name =~ s/\.map$//;
97			utf8::decode $name;
98
99			scan_map "s$map$name", "$dir/$file";
100			}
101
102			&scan_static ("$dir/$_", "$map$_/")
103			for @$dirs;
104			}
105
106	root	1.5	sub reload {
107	root	1.8	my $guard = cf::lock_acquire "map-tags::reload";
108
109	root	1.5	my $start = Event::time;
110	root	1.1
111	root	1.5	# 1. check for maps no longer existing
112	root	1.6	{
113			my @delkeys;
114
115			my $cursor = $db_mapinfo->cursor;
116			for (;;) {
117			BDB::db_c_get $cursor, my $key, my $data, BDB::NEXT;
118			last if $!;
119
120			my $data = JSON::XS::from_json $data;
121			my ($ver, undef, undef, $path) = split /,/, $data->{hash}, 4;
122			push @delkeys, [$key, $data->{tags}]
123			if $ver != 1 \|\| Coro::AIO::aio_stat $path;
124			}
125			BDB::db_c_close $cursor;
126
127			for (@delkeys) {
128			my ($key, $tags) = @$_;
129			my $txn = $cf::DB_ENV->txn_begin;
130			BDB::db_del $db_mapinfo, $txn, $key;
131			for my $tag (@{ $tags \|\| [] }) {
132			remove_tag_target $txn, $tag, $key;
133			}
134	root	1.7	BDB::db_txn_finish $txn;
135	root	1.6	}
136			}
137	root	1.1
138	root	1.5	# 2. scan all static maps
139			scan_static $cf::MAPDIR, "/";
140	root	1.1
141	root	1.5	# 3. scan all dynamic maps
142			for my $path (@{ cf::map::tmp_maps or [] }, @{ cf::map::random_maps or [] }) {
143	root	1.1	# my $map = cf::map::find $path;
144			# extract_map_tags "t/$map", $path;
145	root	1.5	}
146
147	root	1.1	# now hunt for all per-player maps
148			# scan_dir $cf::PLAYERDIR
149			# for my $login (@{ cf::player::list_logins or [] }) {
150			# for my $path (@{ cf::player::maps $login or [] }) {
151			# cf::cede_to_tick;
152			#
153			# $path =~ /^~[^\/]+(\/.*)$/
154			# or next; # doh
155			#
156			# my $base = cf::map::find $1;
157			#
158			# # skip maps without base maps on the assumption
159			# # that those are old, unresettable maps
160			# next unless $base;
161			#
162			# # skip unresettable maps, for speed
163			# next if $base->{deny_reset};
164			#
165			# my $map = cf::map::find $path;
166			#
167			# if ($map->{deny_reset}) {
168			# warn "found noreset map with resettable base map, resetting: $path\n";
169			# delete $map->{deny_reset};
170			# }
171			# }
172			# }
173
174	root	1.5	warn sprintf "map-tag scan (%fs)", Event::time - $start;
175			}
176
177			our $RELOAD_SCHEDULER = Event->timer (
178			after => 0,
179			interval => $SCHEDULE_INTERVAL,
180			data => cf::WF_AUTOCANCEL,
181			cb => Coro::unblock_sub {
182			$Coro::current->prio (Coro::PRIO_MIN);
183			reload;
184			},
185			);
186	root	1.1
187	root	1.5	# find all objects with the given tag, or at least try to
188	root	1.2	sub find($) {
189			my ($tag) = @_;
190	root	1.1
191	root	1.3	utf8::encode (my $key = $tag);
192			BDB::db_get $db_target, undef, $key, my $data;
193	root	1.2	utf8::decode $data;
194
195	root	1.4	map { $_->load; $_->find_tagged_objects ($tag) }
196	root	1.2	grep $_,
197			map { cf::map::find $_ }
198			grep s/^s//,
199			split /\x00/, $data
200			}