30
31
32:- module(tagit,
33 [ user_tags//2, 34 user_tag_count/2, 35 tagit_footer//2 36 ]). 37:- use_module(generics). 38:- use_module(library(debug)). 39:- use_module(library(persistency)). 40:- use_module(library(aggregate)). 41:- use_module(library(error)). 42:- use_module(library(dcg/basics)). 43:- use_module(library(http/html_head)). 44:- use_module(library(http/html_write)). 45:- use_module(library(http/js_write)). 46:- use_module(library(http/http_dispatch)). 47:- use_module(library(http/http_wrapper)). 48:- use_module(library(http/http_parameters)). 49:- use_module(library(http/http_json)). 50:- use_module(library(pldoc/doc_search)). 51:- use_module(library(pldoc/doc_html)). 52:- use_module(notify). 53:- use_module(object_support). 54:- use_module(openid). 55
56:- html_resource(tagit,
57 [ ordered(true),
58 requires([ jquery_ui,
59 js('tagit/js/tag-it.min.js'),
60 js('tagit/css/jquery.tagit.css'),
61 js('tagit/css/tagit.ui-zendesk.css')
62 ]),
63 virtual(true)
64 ]). 65:- html_resource(css('tags.css'), []). 66
67
68 71
72:- persistent
73 tagged(tag:atom, 74 object:any, 75 time:integer, 76 user:atom), 77 tag(tag:atom,
78 time:integer, 79 user:atom). 80
81user_tag_count(User, Count) :-
82 aggregate_all(count, tagged(_,_,_,User), Count).
83
84
85:- initialization
86 absolute_file_name(data('tags.db'), File,
87 [ access(write) ]),
88 db_attach(File,
89 [ sync(close)
90 ]). 91
92current_tag(Tag) :-
93 tag(Tag, _, _).
94
95create_tag(Tag, _User) :-
96 tag(Tag, _, _), !.
97create_tag(Tag, User) :-
98 get_time(NowF),
99 Now is round(NowF),
100 assert_tag(Tag, Now, User), !.
108tagit_user(_Request, uuid, User) :-
109 site_user_logged_in(User), !.
110tagit_user(Request, ip, Peer) :-
111 http_peer(Request, Peer).
112
113peer(Peer) :-
114 atom_codes(Peer, Codes),
115 phrase(ip, Codes).
116
117ip -->
118 integer(_), ".",
119 integer(_), ".",
120 integer(_), ".",
121 integer(_).
122
123
124 127
128:- http_handler(root('complete-tag'), complete_tag, []). 129:- http_handler(root('show-tag'), show_tag, []). 130:- http_handler(root('add-tag'), add_tag, []). 131:- http_handler(root('remove-tag'), remove_tag, []). 132:- http_handler(root('list-tags'), list_tags, []). 133:- http_handler(root('tag-abuse'), tag_abuse, []).
139tagit_footer(Obj, _Options) -->
140 { http_link_to_id(complete_tag, [], Complete),
141 http_link_to_id(show_tag, [], OnClick),
142 http_link_to_id(add_tag, [], AddTag),
143 http_link_to_id(remove_tag, [], RemoveTag),
144 object_label(Obj, Label),
145 object_id(Obj, ObjectID),
146 format(atom(PlaceHolder), 'Tag ~w', [Label]),
147 object_tags(Obj, Tags)
148 },
149 html(div(id='tags-component',
150 [ \tag_notes(ObjectID, Tags),
151 div(id='tags-label', 'Tags:'),
152 div(id='tags-bar', ul(id=tags, \tags_li(Tags))),
153 div(id='tags-warnings', [])
154 ])),
155 html_requires(css('tags.css')),
156 html_requires(tagit),
157 js_script({|javascript(Complete, OnClick, PlaceHolder, ObjectID,
158 AddTag, RemoveTag)||
159 function tagInfo(text) {
160 $("#tags-warnings").text(text);
161 $("#tags-warnings").removeClass("warning");
162 $("#tags-warnings").addClass("informational");
163 }
164 function tagWarning(text) {
165 $("#tags-warnings").text(text);
166 $("#tags-warnings").addClass("warning");
167 $("#tags-warnings").removeClass("informational");
168 }
169
170 $(document).ready(function() {
171 $("#tags").tagit({
172 autocomplete: { delay: 0.3,
173 minLength: 1,
174 source: Complete
175 },
176 onTagClicked: function(event, ui) {
177 window.location.href = OnClick+"?tag="+
178 encodeURIComponent(ui.tagLabel);
179 },
180 beforeTagAdded: function(event, ui) {
181 if ( !ui.duringInitialization ) {
182 var result = false;
183 tagInfo("Submitting ...");
184 $.ajax({ dataType: "json",
185 url: AddTag,
186 data: { tag: ui.tagLabel,
187 obj: ObjectID
188 },
189 async: false,
190 success: function(data) {
191 if ( data.status == true ) {
192 tagInfo("Added: "+ui.tagLabel);
193 result = true;
194 } else {
195 tagWarning(data.message);
196 }
197 }
198 });
199 return result;
200 }
201 },
202 beforeTagRemoved: function(event, ui) {
203 var result = false;
204 if ( !ui.tagLabel ) {
205 return false;
206 }
207 tagInfo("Submitting ...");
208 $.ajax({ dataType: "json",
209 url: RemoveTag,
210 data: { tag: ui.tagLabel,
211 obj: ObjectID
212 },
213 async: false,
214 success: function(data) {
215 if ( data.status == true ) {
216 tagInfo("Removed: "+ui.tagLabel);
217 result = true;
218 } else {
219 tagWarning(data.message);
220 }
221 }
222 });
223 return result;
224 },
225 placeholderText: PlaceHolder
226 });
227 });
228 |}).
229
230tags_li([]) --> [].
231tags_li([H|T]) --> html(li(H)), tags_li(T).
232
233tag_notes(ObjectID, Tags) -->
234 html(div(id='tags-notes',
235 [ \why_login,
236 \abuse_link(ObjectID, Tags)
237 ])).
238
239abuse_link(_, []) --> [].
240abuse_link(ObjectID, _) -->
241 sep,
242 { http_link_to_id(tag_abuse, [obj=ObjectID], HREF)
243 },
244 html(a(href(HREF), 'Report abuse')).
245
246why_login -->
247 { site_user_logged_in(_) }, !.
248why_login -->
249 html('Tags are associated to your profile if you are logged in').
250
251sep -->
252 html(span(class(separator), '|')).
253
254object_tags(Object, Tags) :-
255 findall(Tag, tagged(Tag, Object, _Time, _User), Tags0),
256 sort(Tags0, Tags).
265complete_tag(Request) :-
266 http_parameters(Request,
267 [ term(Q, [])
268 ]),
269 debug(tag(autocomplete), 'Autocomplete ~q', [Q]),
270 ( setof(A, tag_holding(Q,A), List)
271 -> true
272 ; List = []
273 ),
274 reply_json(List).
275
276tag_holding(Term, Tag) :-
277 current_tag(Tag),
278 ( sub_atom(Tag, _, _, _, Term)
279 -> true
280 ).
286add_tag(Request) :-
287 http_parameters(Request,
288 [ tag(Tag, []),
289 obj(Hash, [])
290 ]),
291 object_id(Object, Hash),
292 tagit_user(Request, UserType, User),
293 debug(tagit, 'add_tag: ~q: ~q to ~q', [User, Tag, Object]),
294 add_tag_validate(Tag, Object, UserType, Message),
295 ( var(Message)
296 -> create_tag(Tag, User),
297 get_time(NowF),
298 Now is round(NowF),
299 assert_tagged(Tag, Object, Now, User),
300 notify(Object, tagged(Tag)),
301 reply_json_dict(json{status:true})
302 ; reply_json_dict(json{status:false,
303 message:Message})
304 ).
305
306add_tag_validate(Tag, _Object, UserType, Message) :-
307 tag_create_not_ok(Tag, UserType, Message), !.
308add_tag_validate(Tag, Object, _UserType, Message) :-
309 object_label(Object, Label),
310 sub_atom_icasechk(Label, _, Tag), !,
311 Message = 'Rejected: tag is part of object name'.
312add_tag_validate(Tag, _Object, _UserType, Message) :-
313 \+ current_op(_,_,system:Tag),
314 tag_not_ok(Tag, Message), !.
315add_tag_validate(_, _, _, _).
316
317tag_not_ok(Tag, Message) :-
318 sub_atom(Tag, _, 1, _, Char),
319 \+ tag_char_ok(Char), !,
320 format(atom(Message), 'Illegal character: ~w', [Char]).
321
322tag_char_ok(Char) :- char_type(Char, alnum).
323tag_char_ok('_').
324tag_char_ok('-').
325tag_char_ok('/').
326tag_char_ok('(').
327tag_char_ok(')').
328
330tag_create_not_ok(_, ip, 'Not logged-in users can not add tags').
337remove_tag(Request) :-
338 http_parameters(Request,
339 [ tag(Tag, []),
340 obj(Hash, [])
341 ]),
342 object_id(Object, Hash),
343 tagit_user(Request, _, User),
344 debug(tagit, 'remove_tag: ~q: ~q to ~q', [User, Tag, Object]),
345 tagged(Tag, Object, _, Creator),
346 ( may_remove(User, Creator)
347 -> ( retract_tagged(Tag, Object, _, Creator),
348 gc_tag(Tag)
349 -> notify(Object, untagged(Tag)),
350 reply_json(json{status:true})
351 ; reply_json(json{status:false,
352 message:"Unknown error"
353 })
354 )
355 ; reply_json(json{status:false,
356 message:"Permission denied"
357 })
358 ).
362may_remove(User, User) :- !.
363may_remove(User, _Anonymous) :-
364 site_user_property(User, granted(admin)).
370gc_tag(Tag) :-
371 tagged(Tag, _, _, _), !.
372gc_tag(Tag) :-
373 retract_tag(Tag, _, _).
374
375gc_tags :-
376 forall(tag(Tag,_,_),
377 gc_tag(Tag)).
383show_tag(Request) :-
384 http_parameters(Request,
385 [ tag(Tag, [])
386 ]),
387 findall(Obj, tagged(Tag, Obj, _, _), Objects0),
388 sort(Objects0, Objects),
389 reply_html_page(wiki(tags),
390 title('Pages tagged "~w"'-[Tag]),
391 [ h1(class(wiki), 'Pages tagged "~w"'-[Tag]),
392 \doc_resources([]),
393 \matching_object_table(Objects, [])
394 ]).
400tag_abuse(Request) :-
401 site_user_logged_in(_), !,
402 http_parameters(Request,
403 [ obj(Hash, [])
404 ]),
405 object_id(Object, Hash),
406 Link = \object_ref(Object,[]),
407 tagit_user(Request, uuid, _User),
408 notify(Object, tag_abuse),
409 reply_html_page(
410 wiki(tags),
411 title('Notification of abuse'),
412 {|html(Link)||
413 <h1 class="wiki">Notification of abuse sent</h1>
414 <p>
415 Thanks for reporting abuse of tagging on documentation object
416 <span>Link</span>.
417 |}).
418tag_abuse(Request) :-
419 memberchk(path(Path), Request),
420 permission_error(access, http_location, Path).
421
422
423
424 427
428:- multifile
429 prolog:ac_object/3,
430 prolog:doc_object_href/2, 431 prolog:doc_object_label_class/3,
432 prolog:ac_object_attributes/2.
439prolog:ac_object(name, Term, Tag-tag(Tag)) :-
440 current_tag(Tag),
441 ( sub_atom_icasechk(Tag, 0, Term),
442 tagged(Tag, _, _, _)
443 -> true
444 ).
445prolog:ac_object(token, Term, Tag-tag(Tag)) :-
446 current_tag(Tag),
447 ( sub_atom_icasechk(Tag, _, Term),
448 tagged(Tag, _, _, _)
449 -> true
450 ).
451
452prolog:doc_object_href(tag(Tag), HREF) :-
453 http_link_to_id(show_tag, [tag(Tag)], HREF).
454
455prolog:doc_object_label_class(tag(Tag), Tag, tag).
456
457prolog:ac_object_attributes(tag(Tag), [tag=Info]) :-
458 aggregate_all(count, tagged(Tag,_,_,_), Used),
459 format(atom(Info), 'tag x~D', [Used]).
460
461
462
470list_tags(Request) :-
471 http_parameters(Request,
472 [ sort_by(SortBy, [ oneof([ name,
473 popularity,
474 time
475 ]),
476 default(name)
477 ])
478 ]),
479 reply_html_page(
480 tags(list),
481 title('Overview of tags'),
482 \user_tags(_, [sort_by(SortBy)])).
489user_tags(User, Options) -->
490 { findall(Tag-tag(Obj,Time), tagged(Tag, Obj, Time, User), Pairs),
491 Pairs \== [], !,
492 keysort(Pairs, Sorted),
493 group_pairs_by_key(Sorted, Keyed),
494 option(sort_by(SortBy), Options, name),
495 sort_tags(Keyed, SortedTags, SortBy)
496 },
497 html([ \tag_list_header(User, SortBy),
498 table(class('user-tags'),
499 \list_tags(SortedTags))
500 ]).
501user_tags(_, _) --> [].
502
(User, _SortBy) -->
504 { nonvar(User),
505 site_user_property(User, name(Name))
506 }, !,
507 html(h2(class(wiki), 'Tags by ~w'-[Name])).
508tag_list_header(_User, SortBy) -->
509 html(h2(class(wiki), 'Tags sorted by ~w'-[SortBy])).
510
511sort_tags(Tags, Tags, name) :- !.
512sort_tags(Tags, Sorted, SortBy) :-
513 map_list_to_pairs(sort_key_tag(SortBy), Tags, Keyed),
514 keysort(Keyed, KeySorted),
515 pairs_values(KeySorted, Sorted).
516
517sort_key_tag(name, Tag-_, Tag).
518sort_key_tag(popularity, _-Tagged, Count) :-
519 length(Tagged, Count).
520sort_key_tag(time, _-Tagged, Last) :-
521 maplist(arg(2), Tagged, Times),
522 max_list(Times, Last).
528list_tags([]) --> [].
529list_tags([H|T]) --> list_tag(H), list_tags(T).
530
531list_tag(Tag-Objects) -->
532 { http_link_to_id(show_tag, [tag(Tag)], HREF)
533 },
534 html(tr([td(a([class(tag),href(HREF)], Tag)),
535 td(\objects(Objects))
536 ])).
537
538objects([]) --> [].
539objects([tag(Obj,_Time)|T]) -->
540 object_ref(Obj, []),
541 ( { T == [] }
542 -> []
543 ; html(', '),
544 objects(T)
545 ).
546
547
548 551
552:- multifile
553 mail_notify:event_subject//1, 554 mail_notify:event_message//1. 555
556mail_notify:event_subject(tagged(Tag)) -->
557 [ 'tagged with ~w'-[Tag] ].
558mail_notify:event_subject(untagged(Tag)) -->
559 [ 'removed tag ~w'-[Tag] ].
560mail_notify:event_subject(tag_abuse) -->
561 [ 'tag abuse'-[] ].
562
563
564mail_notify:event_message(tagged(Tag)) -->
565 [ 'tagged with "~w"'-[Tag] ].
566mail_notify:event_message(untagged(Tag)) -->
567 [ 'removed tag "~w"'-[Tag] ].
568mail_notify:event_message(tag_abuse) -->
569 [ 'tag abuse'-[] ]