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