:- module(yaz_video_annotation, [ annotation_process/4, % ?User, ?Video, ?Process value_annotation/6, % +Value, ?Process, ?User, -Video, -Entry, -Time video_annotations/3, % +Video, -Annotations, +Options video_annotation/5, % +Video, -AnnotationId, -Value, -Time, -Score video_annotation/6, % +Video, -AnnotationId, -Value, -Time, -Score, +Options video_tag/2, % +Video, -Tag video_provenance/2, % +Video, -Provenance video_transaction/2, % +Video, -Transaction annotations_per_interval/3, % +Annotations, +Interval, +Groups annotation_value/2, % +AnnotationId, -Value annotation_provenance/2, % +AnnotationId, -Provenance annotation_transaction/2, % +AnnotationId, -Transaction process_provenance/3, % +Process, +Condiation, -Provenance process_transaction/3, % +Process, +Condition, -Transaction user_transaction/4, % +Process, +User, +Condition, -Transaction create_video_annotation/4, % +Video, +Value, +Playhead, -AnnotationId create_video_annotation/5, % +Video, +Value, +Playhead, +User, -AnnotationId remove_video_annotation/2, % +Video, +AnnotationId update_annotation_value/2, % +AnnotationId, +Value update_annotation_time/2 % +AnnotationId, +Time ]). :- use_module(library(http/http_dispatch)). :- use_module(library(http/http_parameters)). :- use_module(library(http/http_path)). :- use_module(library(http/http_json)). :- use_module(library(http/json)). :- use_module(library(http/json_convert)). :- use_module(library(http/http_session)). :- use_module(library(semweb/rdf_db)). :- use_module(library(semweb/rdfs)). :- use_module(library(semweb/rdf_label)). :- use_module(user(user_db)). :- use_module(library(rdf_history)). :- use_module(library(user_process)). :- use_module(library(yaz_util)). :- use_module(library(find_resource)). /** Handling of time-based video annotations This module deals with accessing and modifying video annotations. It uses the rdf_history for Wiki-like collaborative editing of an RDF graph. The video annotations can be accessed, created and modified through an HTTP API yaz/data/video +(list,create,remove,update/value,update/time) The API uses the current session to provide provenance information to the created and modified triples. @TBD Support compound time objects for intervals @TBD rdf_history to OPM library for export of provenance @author Michiel Hildebrand */ /******************************* * db access * *******************************/ %% annotation_process(?User, ?Video, ?Process, -Time) % % True if Video is annotated by User and has at least one % transaction. When User is undefined all processes are returned. annotation_process(User, Video, Process, Time) :- nonvar(User), !, rdf_has(Process, opmv:wasControlledBy, User), rdf(Process, opmv:used, Video), rdf(Process, opmv:wasStartedAt, literal(L)), literal_text(L, Time). %has_transaction(Process). annotation_process(_, Video, Process, Time) :- rdf(Video, rdf:type, pprime:'Video'), rdf(Process, opmv:used, Video), rdf(Process, opmv:wasStartedAt, literal(L)), literal_text(L, Time). %has_transaction(Process). has_transaction(Process) :- rdf(_,opmv:used,Process), !. has_transaction(Process) :- user_transaction(Process, _User, true, _), !. %% value_annotation(+Value, ?Process, ?User, -Video, %% -Annotation, -Time) % % True if Time is playHead at which Value has been added. value_annotation(Value, Process, User, Video, Annotation, Time) :- rdf(Annotation, rdf:value, Value, Process), rdf(Video, pprime:hasAnnotation, Annotation), rdf(Annotation, pprime:creator, User), rdf(Annotation, pprime:videoPlayhead, literal(Time0)), literal_to_number(Time0, Time). %% video_annotations(+Video, -Annotations, +Options) % % Returns all Annotations for Video. % Options: % % * user(User) % Limit to annotations created by User % % * process(Process) % Limit to annotations made or modified within Process % % * interval(Interval) % group all annotations with a similar value and within interval % together. % % * confirmed(Confirmed) % When set to true only annotations with score>0 are included. video_annotations(Video, Annotations, Options) :- A = a(Value,Time,Id,Score), findall(A, video_annotation(Video, Id, Value, Time, Score, Options), As0), ( option(type(Type), Options), Type \== false -> filter_by_type(As0, Type, As1) ; As1 = As0 ), ( option(role(Role), Options), Role \== false -> filter_by_role(As1, Role, As2) ; As2 = As1 ), sort(As2, As), ( option(interval(Interval0), Options), Interval0 > 0 -> Interval is Interval0*1000, annotations_per_interval(As, Interval, Annotations) ; maplist(annotation_term, As, Annotations) ). annotation_term(a(Value,Time,Id,Score), annotation(Value,Time,Time,[i(Id,Time)],Score)). filter_by_type([], _, []). filter_by_type([A|As], Type, Filtered) :- A = a(Value,_,_,_), ( Value = uri(R, _), tag_of_type(Type, R) -> Filtered = [A|Rest] ; Filtered = Rest ), filter_by_type(As, Type, Rest). filter_by_role([], _, []). filter_by_role([A|As], Role, Filtered) :- A = a(_,_,Id,_), ( rdf(Id, pprime:role, literal(Role)) -> Filtered = [A|Rest] ; Filtered = Rest ), filter_by_role(As, Role, Rest). :- multifile yaz:tag_type/2. tag_of_type(Type, R) :- yaz:tag_type(Type, R). %% annotations_per_interval(+Terms, +Interval, -GroupedAnnotations) % % A group contains all annotations with a similar value and within % time Interval. Similarity of the annotation value is defined by % matching_annotation_value/2. % % @TBD only the first Score is used annotations_per_interval([], _, []). annotations_per_interval([a(Value, Start, Id, Score)|T], Interval, [A|As]) :- A = annotation(Value, Start, End, [i(Id,Start)|Is], Score), matching_value_in_interval(T, Value, Start, Start, Interval, Is, End, Rest), annotations_per_interval(Rest, Interval, As). matching_value_in_interval([a(V0,T0,Id,_)|As], V, Time, _, Interval, [i(Id,T0)|Is], End, Rest) :- matching_annotation_value(V0, V), T0 < Time+Interval, !, matching_value_in_interval(As, V, Time, T0, Interval, Is, End, Rest). matching_value_in_interval(Rest, _V, _Time, End, _Interval, [], End, Rest). matching_annotation_value(V, V). %% video_annotation(+Video, -AnnotationId, -Value, -Time, -Score). % video_annotation(+Video, -AnnotationId, -Value, -Time, -Score % +Options). % % True if Video is annotated with AnnotationId and has properties % Value and Time. % % search only works for tags modeled as a URI video_annotation(Video, AnnotationId, Value, Time, Score) :- video_annotation(Video, AnnotationId, Value, Time, Score, []). video_annotation(Video, AnnotationId, Value, Time, Score, Options) :- option(query(Query), Options), Query \== '', !, option(process(Process), Options, _), option(user(User), Options, _), option(confirmed(Confirmed), Options, false), find_literal(Query, prefix, Label), ( rdf_has(Tag, rdfs:label, literal(Label)), rdf(Tag, rdf:type, pprime:'Tag') -> rdf(AnnotationId, rdf:value, Tag), Value = uri(Tag,Label) ; rdf(AnnotationId, rdf:value, literal(Label)), Value = literal(Label) ), rdf(AnnotationId, rdf:type, pprime:'TagEntry'), annotation_in_process(Process, Video, AnnotationId), ( nonvar(User) -> rdf(AnnotationId, pprime:creator, User) ; true ), rdf(AnnotationId, pprime:videoPlayhead, Time0), literal_to_number(Time0, Time1), rdf(AnnotationId, pprime:typingDuration, TypingDuration0), literal_to_number(TypingDuration0, TypingDuration), Time is Time1-TypingDuration, ( rdf(AnnotationId, pprime:score, Score0) -> literal_to_number(Score0, Score) ; Score = 0 ), ( Confirmed -> Score > 5 ; true ). video_annotation(Video, AnnotationId, Value, Time, Score, Options) :- option(process(Process), Options, _), option(user(User), Options, _), option(confirmed(Confirmed), Options, false), annotation_in_process(Process, Video, AnnotationId), ( nonvar(User) -> rdf(AnnotationId, pprime:creator, User) ; true ), rdf(AnnotationId, rdf:value, V), annotation_obj(V, Value), rdf(AnnotationId, pprime:videoPlayhead, Time0), literal_to_number(Time0, Time), ( rdf(AnnotationId, pprime:score, Score0) -> literal_to_number(Score0, Score) ; Score = 0 ), ( Confirmed -> Score > 5 ; true ). annotation_in_process(Process, Video, AnnotationId) :- var(Process), !, rdf(Video, pprime:hasAnnotation, AnnotationId). annotation_in_process(Process, Video, AnnotationId) :- rdf(Video, pprime:hasAnnotation, AnnotationId, F), ( F = Process:_ % provenance is stored in the transaction -> true ; rdf(AnnotationId, opmv:used, Process) % provenance is stored explicit ). annotation_obj(V, Term) :- ( V = literal(_) -> Term = V ; rdf_label(V, Lit) -> literal_text(Lit, Label), Term = uri(V, Label) ; Term = uri(V, V) ). video_fragment_annotation(Video, Start, End, AnnotationId, Value, Time, Options) :- option(process(Process), Options, _), option(user(User), Options, _), rdf(Video, pprime:hasAnnotation, AnnotationId, Process), rdf(AnnotationId, pprime:videoPlayhead, literal(between(Start,End),Time0)), once(rdf(AnnotationId, pprime:creator, User)), rdf(AnnotationId, rdf:value, Value), literal_to_number(Time0, Time). %% video_tag(?Video, ?Tag) % % Tag is an annotation of Video. video_tag(Video, Tag) :- ground(Tag), !, rdf(AnnotationId, rdf:value, Tag), rdf(Video, pprime:hasAnnotation, AnnotationId). video_tag(Video, Tag) :- rdf(Video, pprime:hasAnnotation, AnnotationId), rdf(AnnotationId, rdf:value, Tag). %% video_provenance(+Video, -Provenance) % % Provenance is a list of all Transactions on % Video. video_provenance(Video, Provenance) :- findall(T, video_transaction(Video, T), Transactions0), sort_by_arg(Transactions0, 2, Transactions), transactions_to_provenance(Transactions, Provenance). %% video_transactions(+Video, -Transactions) % % True if Transaction is a addition or a modification of an % annotation on Video. video_transaction(Video, Transaction) :- findall(P, rdf(P,opmv:used,Video), Processes), member(Process, Processes), rdfh_db_transaction(Process, true, Transaction). %% annotation_value(?AnnotationId, ?Value) % % True if Value is used in Annotation. annotation_value(Annotation, Value) :- rdf(_, pprime:hasAnnotation, Annotation), rdf(Annotation, rdf:value, Value). %% annotation_provenance(+AnnotationId, -Provenance) % % Provenance a list of all Transactions on % AnnotationId. annotation_provenance(AnnotationId, Provenance) :- findall(T, annotation_transaction(AnnotationId, T), Transactions0), sort(Transactions0, Transactions), transactions_to_provenance(Transactions, Provenance). %% annotation_transactions(+AnnotationId, -Transactions) % % True if Transaction is an addition or a modification of an % annotation. annotation_transaction(AnnotationId, Transaction) :- rdf(AnnotationId, pprime:creator, User, Graph), rdf(AnnotationId, opmv:wasPerformedAt, literal(Time)), rdf(AnnotationId, pprime:videoPlayhead, literal(Playhead)), rdf(AnnotationId, rdf:value, Value), rdf(Video, pprime:hasAnnotation, AnnotationId), Transaction = action(AnnotationId,Time,User,Graph,Action), Action = added(Video, AnnotationId, Value, Playhead). annotation_transaction(AnnotationId, Transaction) :- findall(P, rdf(AnnotationId,_,_,P), Processes0), sort(Processes0, Processes), member(Process:_Time, Processes), %After is Time - 1, rdfh_db_transaction(Process, true, Transaction), is_annotation_transaction(Transaction, AnnotationId). is_annotation_transaction(Transaction, Id) :- ( rdfh_transaction_memberchk(assert(Id,_,_,_), Transaction) -> true ; rdfh_transaction_memberchk(assert(_,_,Id,_), Transaction) -> true ). %% process_provenance(+Process, +Condition, -Provenance) % % Provenance is a list of Transactions in % Process process_provenance(Process, Cond, Provenance) :- findall(T, process_transaction(Process, Cond, T), Transactions0), sort(Transactions0, Transactions), transactions_to_provenance(Transactions, Provenance). %% process_transaction(+Process, -Transaction) % % True if Transaction is a transaction done in Process. process_transaction(Process, Cond, Transaction) :- rdfh_db_transaction(Process, Cond, Transaction), Transaction = rdf_transaction(_,_,_,rdfh([_,graph(Process)|_]), _, _). %% user_transaction(+Process, +User, +Condition, -Transaction) % % True if Transaction is performed by User in Process. % % Param % *Condition see @rdfh_db_transaction/3. user_transaction(Process, User, Cond, Transaction) :- rdfh_db_transaction(Process, Cond, Transaction), Transaction = rdf_transaction(_,_,_,rdfh([user(User)|_]), _, _). /******************************* * DB update * *******************************/ :- http_handler(yaz('data/video/create'), http_create_video_annotation, []). /* :- http_handler(yaz('data/video/remove'), http_remove_video_annotation, []). :- http_handler(yaz('data/video/update/value'), http_update_video_annotation_value, []). :- http_handler(yaz('data/video/update/time'), http_update_video_annotation_time, []). */ %% http_save_tag_entry(+Request). % % Handler to store a tag entry for a URI. % See http://n2.talis.com/wiki/RDF_JSON_Specification for JSON % notation of RDF object. http_create_video_annotation(Request) :- logged_on(_), http_parameters(Request, [ video(Video, [description('URL of a video')]), value(Value, [jsonresource, description('JSON notation of an RDF object')]), time(Time, [number, description('Time within current video')]) ]), create_video_annotation(Video, Value, Time, AnnotationId), reply_json(json([annotation=AnnotationId])). %% create_video_annotation(+Video, +Value, +Time, -AnnotationId) % % Assert an annotation for Video at time Playhead. Returns the Id % of the annotation object. create_video_annotation(Video, Value0, Time0, AnnotationId) :- atom(Video), valid_value(Value0, Value), valid_time(Time0, Time), rdf_bnode(AnnotationId), rdfh_transaction((rdfh_assert(Video, pprime:hasAnnotation, AnnotationId), rdfh_assert(AnnotationId, rdf:value, Value), rdfh_assert(AnnotationId, pprime:videoPlayhead, Time) )). %% create_video_annotation(+Video, +Value, +Time, %% +User, -AnnotationId) % % HACK to implicitly store the User. % @TBD provide a means to quickly access the creator of a tag from % the provenance. create_video_annotation(Video, Value0, Time0, User, AnnotationId) :- atom(Video), valid_value(Value0, Value), valid_time(Time0, Time), rdf_bnode(AnnotationId), rdfh_transaction((rdfh_assert(Video, pprime:hasAnnotation, AnnotationId), rdfh_assert(AnnotationId, rdf:value, Value), rdfh_assert(AnnotationId, pprime:videoPlayhead, Time), rdfh_assert(AnnotationId, pprime:creator, User) )). %% remove_video_annotation(+Video, +AnnotationId) % % Retract a video annotation. remove_video_annotation(Video, AnnotationId) :- atom(Video), atom(AnnotationId), rdfh_transaction((rdfh_retractall(Video, pprime:hasAnnotation, AnnotationId) %rdfh_retractall(AnnotationId, rdf:value, _), %rdfh_retractall(AnnotationId, pprime:videoPlayhead, _) )). %% update_annotation_value(+AnnotationId, +NewValue) % % Replace the existing annotation value with NewValue. update_annotation_value(AnnotationId, NewValue0) :- atom(AnnotationId), valid_value(NewValue0, NewValue), rdf(AnnotationId, rdf:value, Value), rdfh_transaction((rdfh_update(AnnotationId, rdf:value, Value->NewValue))). %% update_annotation_time(+AnnotationId, +Time) % % Replace the existing annotation time with Time. update_annotation_time(AnnotationId, NewTime0) :- atom(AnnotationId), valid_time(NewTime0, NewTime), rdf(AnnotationId, pprime:videoPlayhead, Time), rdfh_transaction((rdfh_update(AnnotationId, pprime:videoPlayhead, Time->NewTime))). %% transactions_to_provenance(+TransactionList, -Provenance) % % Translate a list of transaction to a provenance description. transactions_to_provenance([], []). transactions_to_provenance([Action|Ts], [Action|Ps]) :- Action = action(_,_,_,_,_), % already in right format !, transactions_to_provenance(Ts, Ps). transactions_to_provenance([T|Ts], [P|Ps]) :- T = rdf_transaction(Id, _Nesting, Time, rdfh(Message), Actions, _Graphs), canonical_action(Actions, CanonicalAction), !, memberchk(user(User), Message), memberchk(graph(Graph), Message), P = action(Id,Time,User,Graph,CanonicalAction), transactions_to_provenance(Ts, Ps). transactions_to_provenance([_T|Ts], Ps) :- transactions_to_provenance(Ts, Ps). canonical_action([assert(Video, _, AnnotationId, _), assert(_, P1, Value, _), assert(_, P2, Time, _) |_% hack ], Action) :- rdf_equal(P1, rdf:value), rdf_equal(P2, pprime:videoPlayhead), !, Action = added(Video, AnnotationId, Value, Time). canonical_action([retract(Video, P, AnnotationId, _) ], Action) :- rdf_equal(P, pprime:hasAnnotation), !, Action = removed(AnnotationId, Video). canonical_action(Actions, Action) :- ( Actions = [ retract(AnnotationId, P, _Value, _), assert(AnnotationId, P, NewValue, _) ] -> true ; Actions = [ assert(AnnotationId, P, NewValue, _) ] ), ( rdf_equal(P, pprime:videoPlayhead) -> Type = timeChange ; rdf_equal(P, rdf:value) -> Type = valueChange ), Action =.. [Type, AnnotationId, NewValue]. %% valid_value(+Value, -ValidValue) % % True if Value is ground and either a literal or a URI. valid_value(Value, Valid) :- ground(Value), ( Value = literal(_) % TBD test for lang and type? -> Valid = Value ; Value = uri(Valid) -> atom(Valid) ; atom(Value) -> Valid = literal(Value) ; type_error(value_object, Value) ). %% valid_time(+Time, -ValidTime) % % True if Value is ground and either a literal or a number. valid_time(Time, Valid) :- ground(Time), ( Time = literal(_) -> Valid = Time ; number(Time) -> Valid = literal(Time) ; type_error(time_object, Time) ). /******************************* * misc * *******************************/ rdf_history:rdfh_hook(graph(Process)) :- current_user_process(Process). rdf_history:rdfh_hook(user(anonymous)).