server/ext/map-tags.ext

#! perl # mandatory

CONF SCHEDULE_INTERVAL : extractor_schedule_interval = 3600;

use JSON::XS;

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) = @_;
   #    -     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 $txn = $cf::DB_ENV->txn_begin;

   utf8::encode $key;
   BDB::db_get $db_mapinfo, $txn, $key, my $data;

   unless ($!) {
      $data = decode_json $data;
      return if $data->{hash} eq $hash;

      # 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 = encode_json { hash => $hash, tags => \@tags };

   BDB::db_put $db_mapinfo, $txn, $key, $data;

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

   cf::debug "tag-updated $file (= $key) <@tags>\n"
      if @tags;
}

sub scan_static {
   my $maps = cf::map::static_maps;

   scan_map "s$_", "$cf::MAPDIR$_.map"
      for @$maps;
}

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

   my $start = AE::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::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;
      }
      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 [] }) {
#
#         $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};
#         }
#      }
#   }

      cf::info sprintf "map-tag scan finished (%fs)\n", AE::time - $start;
}

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($) {
   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
}

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

   BDB::db_close $db_target;
   BDB::db_close $db_mapinfo;
}

Revision:	1.28
Committed:	Fri Feb 3 03:01:45 2012 UTC (12 years, 3 months ago) by root
Branch:	MAIN
CVS Tags:	rel-3_1, HEAD
Changes since 1.27:	+1 -1 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	#! perl # mandatory
2
3	root	1.28	CONF SCHEDULE_INTERVAL : extractor_schedule_interval = 3600;
4	root	1.1
5			use JSON::XS;
6
7	root	1.24	our $db_mapinfo = cf::db_table "tag-mapinfo"; # info/cache for maps
8			our $db_target = cf::db_table "tag-target"; # tag => maps
9	root	1.1
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 $txn = $cf::DB_ENV->txn_begin;
46
47			utf8::encode $key;
48			BDB::db_get $db_mapinfo, $txn, $key, my $data;
49
50			unless ($!) {
51	root	1.13	$data = decode_json $data;
52	root	1.1	return if $data->{hash} eq $hash;
53	root	1.19
54			# remove all old tags unconditionally
55			remove_tag_target $txn, $_, $key
56			for @{ $data->{tags} };
57	root	1.1	}
58
59			my $f = new_from_file cf::object::thawer $file
60			or return;
61
62			my @tags = sort $f->extract_tags;
63	root	1.13	$data = encode_json { hash => $hash, tags => \@tags };
64	root	1.1
65			BDB::db_put $db_mapinfo, $txn, $key, $data;
66
67	root	1.19	# add all tags
68			add_tag_target $txn, $_, $key
69			for @tags;
70	root	1.1
71			# we don't actually care if it succeeds or not, as we
72			# will just retry an hour later
73	root	1.7	BDB::db_txn_finish $txn;
74	root	1.1
75	root	1.25	cf::debug "tag-updated $file (= $key) <@tags>\n"
76	root	1.8	if @tags;
77	root	1.1	}
78
79			sub scan_static {
80	root	1.17	my $maps = cf::map::static_maps;
81	root	1.1
82	root	1.18	scan_map "s$_", "$cf::MAPDIR$_.map"
83	root	1.17	for @$maps;
84	root	1.1	}
85
86	root	1.5	sub reload {
87	root	1.8	my $guard = cf::lock_acquire "map-tags::reload";
88
89	root	1.22	my $start = AE::time;
90	root	1.1
91	root	1.5	# 1. check for maps no longer existing
92	root	1.6	{
93			my @delkeys;
94
95			my $cursor = $db_mapinfo->cursor;
96			for (;;) {
97			BDB::db_c_get $cursor, my $key, my $data, BDB::NEXT;
98			last if $!;
99
100	root	1.13	my $data = JSON::XS::decode_json $data;
101	root	1.6	my ($ver, undef, undef, $path) = split /,/, $data->{hash}, 4;
102			push @delkeys, [$key, $data->{tags}]
103			if $ver != 1 \|\| Coro::AIO::aio_stat $path;
104			}
105			BDB::db_c_close $cursor;
106
107			for (@delkeys) {
108			my ($key, $tags) = @$_;
109			my $txn = $cf::DB_ENV->txn_begin;
110			BDB::db_del $db_mapinfo, $txn, $key;
111			for my $tag (@{ $tags \|\| [] }) {
112			remove_tag_target $txn, $tag, $key;
113			}
114	root	1.7	BDB::db_txn_finish $txn;
115	root	1.6	}
116			}
117	root	1.1
118	root	1.5	# 2. scan all static maps
119			scan_static $cf::MAPDIR, "/";
120	root	1.1
121	root	1.5	# 3. scan all dynamic maps
122			for my $path (@{ cf::map::tmp_maps or [] }, @{ cf::map::random_maps or [] }) {
123	root	1.1	# my $map = cf::map::find $path;
124			# extract_map_tags "t/$map", $path;
125	root	1.5	}
126
127	root	1.1	# now hunt for all per-player maps
128			# scan_dir $cf::PLAYERDIR
129			# for my $login (@{ cf::player::list_logins or [] }) {
130			# for my $path (@{ cf::player::maps $login or [] }) {
131			#
132			# $path =~ /^~[^\/]+(\/.*)$/
133			# or next; # doh
134			#
135			# my $base = cf::map::find $1;
136			#
137			# # skip maps without base maps on the assumption
138			# # that those are old, unresettable maps
139			# next unless $base;
140			#
141			# # skip unresettable maps, for speed
142			# next if $base->{deny_reset};
143			#
144			# my $map = cf::map::find $path;
145			#
146			# if ($map->{deny_reset}) {
147			# warn "found noreset map with resettable base map, resetting: $path\n";
148			# delete $map->{deny_reset};
149			# }
150			# }
151			# }
152
153	root	1.25	cf::info sprintf "map-tag scan finished (%fs)\n", AE::time - $start;
154	root	1.5	}
155
156	root	1.11	our $RELOAD_SCHEDULER = cf::periodic $SCHEDULE_INTERVAL, Coro::unblock_sub {
157			$Coro::current->prio (Coro::PRIO_MIN);
158			$Coro::current->desc ("map-tag scanner");
159			reload;
160	root	1.10	};
161	root	1.1
162	root	1.15	cf::post_init {
163			$RELOAD_SCHEDULER->invoke (0); # force at startup
164			};
165	root	1.12
166	root	1.5	# find all objects with the given tag, or at least try to
167	root	1.2	sub find($) {
168			my ($tag) = @_;
169	root	1.1
170	root	1.3	utf8::encode (my $key = $tag);
171			BDB::db_get $db_target, undef, $key, my $data;
172	root	1.2	utf8::decode $data;
173
174	root	1.4	map { $_->load; $_->find_tagged_objects ($tag) }
175	root	1.2	grep $_,
176			map { cf::map::find $_ }
177			grep s/^s//,
178			split /\x00/, $data
179			}
180	root	1.20
181			sub unload {
182			my $guard = cf::lock_acquire "map-tags::reload";
183
184	root	1.21	BDB::db_close $db_target;
185			BDB::db_close $db_mapinfo;
186	root	1.20	}
187	root	1.26