ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/ext/map-tags.ext
Revision: 1.24
Committed: Thu Apr 29 08:13:50 2010 UTC (14 years ago) by root
Branch: MAIN
Changes since 1.23: +2 -2 lines
Log Message:
reduce sync job warnings, we have no sync jobs left that we should warn about

File Contents

# 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 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.8 warn "tag-updated $file (= $key) <@tags>\n"
76     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     # cf::cede_to_tick;
132     #
133     # $path =~ /^~[^\/]+(\/.*)$/
134     # or next; # doh
135     #
136     # my $base = cf::map::find $1;
137     #
138     # # skip maps without base maps on the assumption
139     # # that those are old, unresettable maps
140     # next unless $base;
141     #
142     # # skip unresettable maps, for speed
143     # next if $base->{deny_reset};
144     #
145     # my $map = cf::map::find $path;
146     #
147     # if ($map->{deny_reset}) {
148     # warn "found noreset map with resettable base map, resetting: $path\n";
149     # delete $map->{deny_reset};
150     # }
151     # }
152     # }
153    
154 root 1.23 warn sprintf "map-tag scan finished (%fs)\n", AE::time - $start;
155 root 1.5 }
156    
157 root 1.11 our $RELOAD_SCHEDULER = cf::periodic $SCHEDULE_INTERVAL, Coro::unblock_sub {
158     $Coro::current->prio (Coro::PRIO_MIN);
159     $Coro::current->desc ("map-tag scanner");
160     reload;
161 root 1.10 };
162 root 1.1
163 root 1.15 cf::post_init {
164     $RELOAD_SCHEDULER->invoke (0); # force at startup
165     };
166 root 1.12
167 root 1.5 # find all objects with the given tag, or at least try to
168 root 1.2 sub find($) {
169     my ($tag) = @_;
170 root 1.1
171 root 1.3 utf8::encode (my $key = $tag);
172     BDB::db_get $db_target, undef, $key, my $data;
173 root 1.2 utf8::decode $data;
174    
175 root 1.4 map { $_->load; $_->find_tagged_objects ($tag) }
176 root 1.2 grep $_,
177     map { cf::map::find $_ }
178     grep s/^s//,
179     split /\x00/, $data
180     }
181 root 1.20
182     sub unload {
183     my $guard = cf::lock_acquire "map-tags::reload";
184    
185 root 1.21 BDB::db_close $db_target;
186     BDB::db_close $db_mapinfo;
187 root 1.20 }