yaz/commit

support ingestion

authorMichiel Hildebrand
Mon Aug 22 18:43:26 2011 +0200
committerMichiel Hildebrand
Mon Aug 22 18:43:26 2011 +0200
commite44ae994297ef8200b1f472c09e827bb27a8443e
treeca08290458070be7f7221b83626c372da4f18a3a
parent5e3414496268ef7be5400413ca740ea68b1fe16b
Diff style: patch stat
diff --git a/api/ugm_ingest.pl b/api/ugm_ingest.pl
new file mode 100644
index 0000000..528c8c4
--- /dev/null
+++ b/api/ugm_ingest.pl
@@ -0,0 +1,153 @@
+:- module(ugm_ingest,
+	  []).
+
+:- 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(rdf_write)).
+:- use_module(library(semweb/rdf_db)).
+:- use_module(library(semweb/rdf_label)).
+
+:- use_module(library(yaz_util)).
+:- use_module(library(video_annotation)).
+:- use_module(library(download_video)).
+
+:- http_handler(yaz(api/ugmingest), http_api_ugm_ingest, []).
+
+:- debug(ugm_ingest).
+:- debug(stream_download).
+
+
+%%	local_video_file(+StreamURL, -File)
+%
+%	Create a local filename for a stream url.
+
+local_video_file(URL, File) :-
+	www_form_encode(URL, File0),
+	absolute_file_name(video(File0), File).
+
+
+%%	http_api_tag_ingest(+Request)
+%
+%	Handler for the tag ingestion service.
+
+http_api_ugm_ingest(Request) :-
+		http_parameters(Request,
+				[ videoId(VideoId,
+					  [description('Identifier of the video')]),
+				  videoTitle(Title,
+					[default(''),
+					 description('Title of the video')]),
+				  videoDuration(Duration,
+					   [default(0),
+					    description('Duration of the video in seconds')]),
+				  videoDescription(Desc,
+						   [default(''),
+						    description('Description of the video')]),
+				  streamURL(StreamURL,
+					    [description('URL of the video stream')]),
+				  entries(Entries,
+					      [json_tag_entries,
+					       description('JSON object with the annotations')])
+				]),
+		pprime_url(VideoId, video, VideoURL),
+		(   rdf(VideoURL, rdf:type, pprime:'Video')
+		->  reply_json(json([error='video already ingested']))
+		;   length(Entries, EntryCount),
+		    local_video_file(StreamURL, File),
+		    save_video_stream(StreamURL, File),
+		    rdf_transaction((
+				    import_video(VideoURL, VideoId, StreamURL, Title, Desc, Duration),
+				    debug(ugm_ingest, 'added video ~w', [VideoURL, StreamURL]),
+				    import_entries(Entries, VideoURL),
+				    debug(ugm_ingest, 'added ~w tag entries', [EntryCount])
+				    )),
+
+		    reply_json(json([success=true,
+				     videoURL=VideoURL
+				    ]))
+		).
+
+http:convert_parameter(json_tag_entries, Atom, Term) :-
+	atom_json_term(Atom, JSON, []),
+	json_to_prolog(JSON, Term).
+
+:- json_object
+	tag_entry(tag:atom, time:number),
+	tag_entry(id:atom, game_id:atom, createdOn:atom,
+		  tag:atom, player_id:atom, time:number, typingDuration:number, score:number).
+
+
+%%	import_video(+VideoURL, +Id, +StreamURL, +Title, +Desc,
+%%	+Duration)
+%
+%	Add a Video to the RDF database and store it's metadata
+%	properties
+%
+%	@see video_property/2
+
+import_video(URL, Id, Stream, Title, Desc, Duration0) :-
+	get_time(Now),
+	rdf_atom_object(Duration0, Duration),
+	rdf_assert(URL, dc:id, literal(Id), URL),
+	rdf_assert(URL, rdf:type, pprime:'Video', URL),
+	rdf_assert(URL, pprime:source, Stream, URL),
+	rdf_assert(URL, dc:title, literal(Title), URL),
+	rdf_assert(URL, dc:description, literal(Desc), URL),
+	rdf_assert(URL, pprime:duration, literal(Duration), URL),
+	rdf_assert(URL, pprime:ingestedAt, literal(type(xsd:date, Now)), URL).
+
+
+%%	import_entries(+TagEntryList, +VideoId)
+%
+%	Add the annotations for VideoId to the RDF db.
+
+import_entries([], _).
+import_entries([TagEntry|Es], VideoURL) :-
+	import_tag_entry(TagEntry, VideoURL),
+	import_entries(Es, VideoURL).
+
+import_tag_entry(tag_entry(Tag, Playhead0), VideoURL) :-
+	rdf_bnode(URL),
+	rdf_atom_object(Playhead0, Playhead),
+	rdf_assert(VideoURL, pprime:hasAnnotation, URL, VideoURL),
+	rdf_assert(URL, rdf:type, pprime:'TagEntry', VideoURL),
+	rdf_assert(URL, rdf:value, literal(Tag), VideoURL),
+	rdf_assert(URL, pprime:videoPlayhead, literal(Playhead), VideoURL).
+
+import_tag_entry(tag_entry(Id,GameId,CreationTime,
+			   Tag,PlayerId,Playhead0,TypingDuration0,Score0), VideoURL) :-
+	pprime_url(Id, entry, URL),
+	pprime_url(GameId, game, GameURL),
+	pprime_url(PlayerId, player, PlayerURL),
+	rdf_atom_object(Playhead0, Playhead),
+	rdf_atom_object(TypingDuration0, TypingDuration),
+	rdf_atom_object(Score0, Score),
+	rdf_assert(VideoURL, pprime:hasAnnotation, URL, VideoURL),
+	rdf_assert(URL, rdf:type, pprime:'TagEntry', VideoURL),
+	rdf_assert(URL, opmv:used, GameURL, VideoURL),
+	rdf_assert(URL, opmv:wasPerformedAt, literal(CreationTime), VideoURL),
+	rdf_assert(URL, rdf:value, Tag, VideoURL),
+	rdf_assert(URL, pprime:videoPlayhead, literal(Playhead), VideoURL),
+	rdf_assert(URL, pprime:creator, PlayerURL, VideoURL),
+	rdf_assert(URL, pprime:score, literal(Score), VideoURL),
+	rdf_assert(URL, pprime:typingDuration, literal(TypingDuration), VideoURL).
+
+
+%%	pprime_url(+Id, +Specifier, -URL)
+%
+%	URL in prestoprime namespace.
+
+pprime_url(Id, Spec, URL) :-
+	atom_concat(Spec, Id, Local),
+	rdf_global_id(pprime:Local, URL).
+
+
+rdf_atom_object(N, A) :-
+	number(N),
+	!,
+	atom_number(A, N).
+rdf_atom_object(A, A).
diff --git a/applications/yaz_admin.pl b/applications/yaz_admin.pl
index 402e762..b66c032 100644
--- a/applications/yaz_admin.pl
+++ b/applications/yaz_admin.pl
@@ -10,7 +10,7 @@
 
 :- use_module(library(yaz_util)).
 :- use_module(components(yaz_page)).
-:- use_module(applications(yaz_user)).
+:- use_module(applications(yaz_home)).
 :- use_module(applications(yaz_videos)).
 :- use_module(applications(yaz_tags)).
 
diff --git a/applications/yaz_garden.pl b/applications/yaz_garden.pl
index fc261bb..26de9c2 100644
--- a/applications/yaz_garden.pl
+++ b/applications/yaz_garden.pl
@@ -28,6 +28,7 @@
 :- use_module(library(user_process)).
 
 :- http_handler(yaz(garden), http_yaz_garden, []).
+:- http_handler(yaz(gardenaccept), http_yaz_garden_accept, []).
 :- http_handler(yaz(data/reconcileentries), http_data_reconcile_entries, []).
 
 reconcile_source(gtaa,
@@ -56,7 +57,39 @@ reconcile_source(freebase,
 		 '').
 
 
-%%	Http_Yaz_Garden(+Request)
+%%	http_yaz_garden_accept(+Request)
+%
+%	Emit an HTML page to link tags to concepts.
+
+http_yaz_garden_accept(Request) :-
+	ensure_logged_on(User0),
+	http_parameters(Request,
+			[ video(Video,
+				[description('Current video')])
+			]),
+	user_property(User0, url(User)),
+	(   current_user_process(Process),
+	    rdf(Process, rdf:type, pprime:'TagGarden'),
+	    rdf(Process, opmv:used, Video)
+	->  true
+	;   create_user_process(User, [rdf:type=pprime:'TagGarden',
+				       opmv:used=Video
+				      ], _GardenProcess)
+	),
+	start_user_process(Process),
+	http_link_to_id(http_yaz_garden, [video(Video)], HREF),
+	reply_html_page(yaz,
+			[ title(['YAZ accept - ', Video])
+			],
+			[ div(['You accepted to moderate ', Video]),
+			  div([a(href(HREF), 'start gardening'),
+			       ' or go back to ',
+			       a(href(location_by_id(http_yaz_home)), 'your videos')
+			      ])
+			]).
+
+
+%%	http_yaz_garden(+Request)
 %
 %	Emit an HTML page to link tags to concepts.
 
diff --git a/applications/yaz_home.pl b/applications/yaz_home.pl
new file mode 100644
index 0000000..46f9021
--- /dev/null
+++ b/applications/yaz_home.pl
@@ -0,0 +1,130 @@
+:- module(yaz_home,
+	  [http_yaz_home/1
+	  ]).
+
+:- use_module(library(http/http_dispatch)).
+:- use_module(library(http/http_parameters)).
+:- use_module(library(http/html_write)).
+:- use_module(library(http/html_head)).
+:- use_module(user(user_db)).
+
+:- use_module(library(yaz_util)).
+:- use_module(library(video_annotation)).
+:- use_module(components(yaz_page)).
+:- use_module(components(yaz_video_item)).
+:- use_module(applications(yaz_tags)).
+:- use_module(library(videos)).
+
+:- http_handler(yaz(.), http_yaz_home, []).
+
+%%	http_yaz_home(+Request)
+%
+%       Emit yaz homepage, including videos, tags and ranks.
+%       Show User specific info when logged on.
+
+http_yaz_home(Request) :-
+	http_parameters(Request,
+			[login(Login,
+			       [ default(false),
+				 description('When set to true user must be logged on')
+			       ])
+			]),
+	logged_on(User0, _),
+	(   Login == true,
+	    var(User0)
+	->  ensure_logged_on(_User)
+	;   nonvar(User0)
+	->  user_property(User0, url(User)),
+	    html_user_home_page(User)
+	;   html_home_page
+	).
+
+
+		 /*******************************
+		 *               html		*
+		 *******************************/
+
+%%	html_home_page
+%
+%	Emit general home page
+
+html_home_page :-
+	video_queue(Queue0),
+	active_videos(_, Active0),
+	moderated_videos(_, Moderated0),
+	list_limit(Queue0, 5, Queue, _),
+	list_limit(Active0, 5, Active, _),
+	list_limit(Moderated0, 5, Moderated, _),
+	reply_html_page(yaz,
+			[ title(['YAZ'])
+			],
+			[ \html_topic(Queue, queue, false, _),
+			  \html_topic(Active, active, false, _),
+			  \html_topic(Moderated, moderated, false, _)
+			]).
+
+%%	html_user_home_page(+User)
+%
+%	Emit home page for User
+
+html_user_home_page(User) :-
+	video_queue(Queue0),
+	active_videos(User, Active0),
+	moderated_videos(User, Moderated0),
+	suggested_videos(User, Suggested0),
+	list_limit(Queue0, 5, Queue, _),
+	list_limit(Active0, 5, Active, _),
+	list_limit(Moderated0, 5, Moderated, _),
+	list_limit(Suggested0, 5, Suggested, _),
+	reply_html_page(yaz,
+			[ title(['YAZ - ', User])
+			],
+			[ \html_topic(Active, active, true, User),
+			  \html_topic(Suggested, suggested, false, User),
+			  \html_topic(Queue, queue, false, User),
+			  \html_topic(Moderated, moderated, true, User)
+			]).
+
+
+html_topic(Videos, Type, AllLink, User) -->
+	{  http_link_to_id(http_yaz_videos, [type(Type)], HREF)
+	},
+	html(div([class(topic)],
+		 [ div(class(header),
+		       h2([a(href(HREF), \topic_header(Type, User)),
+			   \html_all_link(AllLink, Type)
+			  ])),
+		   div(class(body),
+		       ul(class('result-line'),
+			  \html_video_list(Videos, [])))
+		 ])).
+
+html_all_link(true, Type) -->
+	{ http_link_to_id(http_yaz_videos, [type(Type),user(all)], HREF)
+	},
+	html([' / ', a(href(HREF), \all_link(Type))]).
+
+topic_header(queue, _) -->
+	html('Videos waiting for a moderator').
+topic_header(moderated,	User) -->
+	{ nonvar(User) }, !,
+	html('Videos moderated by you').
+topic_header(moderated, _) --> !,
+	html('Videos finished moderation').
+topic_header(active, User) -->
+	{ nonvar(User) }, !,
+	html('Your active videos').
+topic_header(active, _) --> !,
+	html('Videos under moderation').
+topic_header(suggested, _) -->
+	html('Your suggestions').
+
+all_link(active) -->
+	html('all active videos').
+all_link(moderated) -->
+	html('all moderated videos').
+
+html_video_list([], _) --> !.
+html_video_list([Video|Vs], Options) -->
+	html(li(\yaz_video_result(Video, Options))),
+	html_video_list(Vs, Options).
diff --git a/applications/yaz_player.pl b/applications/yaz_player.pl
index 704f817..c125e52 100644
--- a/applications/yaz_player.pl
+++ b/applications/yaz_player.pl
@@ -130,6 +130,7 @@ html_page(Video, Annotations, StartTime, Options) :-
 			],
 			[ \html_requires(css('player.css')),
 			  \html_requires(css('tag.css')),
+			  \html_video_status(Video),
 			  \yaz_video_header(Video),
 			  div([style('display:none'), class(controls)],
 			      [a([href('javascript:{}'), id(toggleOptions)],
@@ -160,6 +161,42 @@ html_page(Video, Annotations, StartTime, Options) :-
 				\html_video_page_yui(Video, Annotations, StartTime, Options))
 			]).
 
+html_video_status(Video) -->
+	{ moderated_video(User, Video, _Process, StartTime, EndTime)
+	},
+	!,
+	html(div(class(status),
+		 ['This video was moderated by ', User,
+		  ' from ', StartTime,
+		  ' to ', EndTime])).
+html_video_status(Video) -->
+	{ active_video(User, Video, _Process, StartTime),
+	  logged_on(User0, false),
+	  user_property(User0, url(User)),
+	  http_link_to_id(http_yaz_garden, [video(Video)], HREF)
+	},
+	!,
+	html(div(class(status),
+		 ['You started moderation of this video at ', StartTime,
+		  div(a(href(HREF), 'continue gardening'))
+		 ])).
+html_video_status(Video) -->
+	{ active_video(User, Video, _Process, StartTime)
+	},
+	!,
+	html(div(class(status),
+		 ['This video is under moderation by ', User,
+		  ' from ', StartTime
+		 ])).
+html_video_status(Video) -->
+	{ http_link_to_id(http_yaz_garden_accept, [video(Video)], HREF)
+	},
+	html(div(class(status),
+		 ['This video is not yet under moderation',
+		  div(a(href(HREF), 'accept moderation'))
+		 ])).
+
+
 html_select_options([]) --> !.
 html_select_options([option(Value, Name, Label)|Ts]) -->
 	html(option([value(Value), name(Name)], Label)),
diff --git a/applications/yaz_user.pl b/applications/yaz_user.pl
index 8fae59b..c4cde55 100644
--- a/applications/yaz_user.pl
+++ b/applications/yaz_user.pl
@@ -1,229 +1,133 @@
 :- module(yaz_user,
-	  [http_yaz_home/1,
-	   http_yaz_user/1,
- 	   html_tag_cloud//2
- 	  ]).
+	  []).
 
 :- use_module(library(http/http_dispatch)).
 :- use_module(library(http/http_parameters)).
+:- use_module(library(http/http_path)).
 :- use_module(library(http/html_write)).
 :- use_module(library(http/html_head)).
-:- use_module(library(semweb/rdf_db)).
+:- use_module(library(http/js_write)).
+:- use_module(library(http/http_json)).
+:- use_module(library(http/json)).
 :- use_module(user(user_db)).
-:- use_module(library(yaz_util)).
-:- use_module(library(video_annotation)).
-:- use_module(components(yaz_page)).
-:- use_module(components(yaz_video_item)).
-:- use_module(applications(yaz_tags)).
+:- use_module(library(semweb/rdf_db)).
 
-:- http_handler(yaz(.), http_yaz_home, []).
-:- http_handler(yaz(user), http_yaz_user, []). % to user home page
+:- use_module(components(yaz_page)).
+:- use_module(components(tag_cloud)).
+:- use_module(library(videos)).
 
-%%	http_yaz_home(+Request)
-%
-%       Emit yaz homepage, including videos, tags and ranks.
-%       Show User specific info when logged on.
-
-http_yaz_home(_Request) :-
-	logged_on(User0, _),
-	(   nonvar(User0)
-	->  user_property(User0, url(User)),
-	    Options = [user(User)]
-	;   Options = []
-	),
-	user_videos(User, Videos),
-	list_limit(Videos, 5, Recent, _),
-   	popular_tags(User, 100, Tags),
- 	html_home_page(Recent, Tags, Options).
+:- http_handler(yaz(user), http_yaz_user, []).
 
 %%	http_yaz_user(+Request)
 %
-%	Same as http_yaz_home, but ensure that the user is logged on.
+%	User profile page
 
 http_yaz_user(Request) :-
-	ensure_logged_on(_User),
-	http_yaz_home(Request).
+	ensure_logged_on(User),
+	http_parameters(Request,
+			[ tags(Tags,
+			       [ optional(true),
+				 description('String with tags separated by a comma')
+			       ])
+			]),
+	user_profile_tags(User, ProfileTags0),
+	(   nonvar(Tags)
+	->  ProfileTags = NewTags,
+	    concat_atom(NewTags0, ',', Tags),
+	    maplist(trim_spaces, NewTags0, NewTags1),
+	    sort(NewTags1, NewTags),
+	    update_tags(NewTags, ProfileTags0, User)
+	;   ProfileTags = ProfileTags0
+	),
+	html_page(User, ProfileTags, []).
+
+update_tags(NewTags, OldTags, User) :-
+	ord_subtract(NewTags, OldTags, Add),
+	ord_subtract(OldTags, NewTags, Remove),
+	rdf_transaction((forall(member(R,Remove),
+				rdf_retractall(User, pprime:profileTag, literal(R), User)),
+			 forall(member(A,Add),
+				rdf_assert(User, pprime:profileTag, literal(A), User))
+
+			)).
+
+user_profile_tags(User, Tags) :-
+	findall(Tag, rdf(User, pprime:profileTag, literal(Tag)), Tags0),
+	sort(Tags0, Tags).
 
 
-%%	user_videos(?User, +Limit, -RecentVideos)
-%
-%	Returns a list Videos that have been annotated, sorted by Time.
-%
-%	Params:
-%	 * User
-%	 When defined Videos are limited to annotated by this User.
-
-% hack for the review demo to get 5 nice videos
-
-user_videos(User, Videos) :-
-	var(User),
-	!,
-	Videos = [ 'http://semanticweb.cs.vu.nl/prestoprime/video655',
-		   'http://semanticweb.cs.vu.nl/prestoprime/video2726',
-		   'http://semanticweb.cs.vu.nl/prestoprime/video585',
-		   'http://semanticweb.cs.vu.nl/prestoprime/video420',
-		   'http://semanticweb.cs.vu.nl/prestoprime/video743'
-
-		 ].
-
-user_videos(User, SortedVideos) :-
-	%fail,
-	findall(Time-Video,
-		annotation_process(User, Video, _Process, Time),
-		Pairs0),
-	keysort(Pairs0, Pairs1),
-	reverse(Pairs1, Pairs),
-	pairs_values(Pairs, SortedVideos).
-
-user_videos(User, Videos) :-
- 	find_unique(Video,
-		    annotation_process(User, Video, _Process, _Time),
-		    5,
-		    Videos).
-
-:- dynamic
-	popular_tags_cache/1.
-
-%%	popular_tags(?User, +Limit, -AnnotationsByTag)
-%
-%	Returns a list with the most popular tags, Tag-[Annotations]
-%
-%	Param
-%	 * User
-%        when defined limited to the tags added by User.
-
-popular_tags(User, _, PopularTags) :-
-	var(User),
-	popular_tags_cache(PopularTags),
-	!.
-popular_tags(User, Limit, PopularTags) :-
-	findall(Value-Annotation,
-		user_tag(User, Annotation, Value),
- 		Pairs0),
- 	keysort(Pairs0, Pairs),
-	group_pairs_by_key(Pairs, Groups),
-	pairs_sort_by_value_count(Groups, Tags),
-	list_limit(Tags, Limit, PopularTags, _),
-	(   var(User)
-	->  assert(popular_tags_cache(PopularTags))
-	;   true
-	).
-
-user_tag(User, Annotation, Value) :-
-	nonvar(User),
-	!,
-	rdf(Annotation, pprime:creator, User),
-	annotation_value(Annotation, Value).
-user_tag(_User, Annotation, Value) :-
- 	annotation_value(Annotation, Value).
-
-:- rdf_monitor(empty_popular_tags_cache, [assert]).
-
-empty_popular_tags_cache(assert(_S,P,_O,_DB)) :-
-	rdf_equal(P, pprime:hasAnnotation),
-	retractall(popular_tags_cache(_)).
-
-
-
-		 /*******************************
-		 *               html		*
-		 *******************************/
-
-%%	html_home_page(+Videos, +Tags, Options)
-%
-%	Emit home page for User.
 
-html_home_page(Videos, Tags, Options) :-
+
+html_page(User, ProfileTags, VideoTags) :-
 	reply_html_page(yaz,
-			[ title(['YAZ - ',
-				 \page_title(Options)])
+			[ title(['YAZ - ', User])
 			],
-			[ div([id(videos), class(topic)],
-			       \html_video_stream(Videos, Options)),
- 			  div([id(tags), class(topic)],
-			      \html_tag_stream(Tags, Options))
+			[ h2(User),
+			  div([class(topic)],
+			      [ div(class(header), 'Statistics'),
+				div(class(body),
+				    \html_user_statistics(User))
+			      ]),
+			  div([class(topic)],
+			      [ div(class(header), 'Profile'),
+				div(class(body),
+				    [ \html_tag_field(ProfileTags),
+				      \html_tag_cloud(VideoTags, [])
+				    ])
+			      ])
 			]).
 
-page_title(Options) -->
-	{ option(user(User), Options)
+html_user_statistics(User) -->
+	{ ingested_videos(User, VL),
+	  video_queue(User, QL),
+	  moderated_videos(User, ML),
+	  length(VL, VN),
+	  length(QL, QN),
+	  length(ML, MN),
+	  http_link_to_id(http_yaz_videos, [user(User)], HREF)
 	},
-	html([User, '\'s annotation zone']).
-page_title(_Options) -->
-	html(['annotation zone']).
+	html(ul([li([VN, ' ', \video_label(VN), ' assigned to you', \browse(HREF, all)]),
+		 li([MN, ' ', \video_label(MN), ' moderated by you', \browse(HREF, moderated)]),
+		 li([QN, ' ', \video_label(ML), ' waiting for your moderation', \browse(HREF, queue)])
+		])).
 
-%%	html_video_stream(+Videos, +Options)
-%
-%	Emit html with a list of videos.
+browse(HREF, Type) -->
+	html([' (', a(href(HREF+'&type='+Type), browse), ')']).
 
-html_video_stream(Videos, Options) -->
-	{ http_link_to_id(http_yaz_videos, Options, Link)
-	},
- 	html([ div(class(header),
-		   h2(a(href(Link), \video_stream_header(Options)))),
-	       div(class(body),
-		   ul(class('result-line'),
-		      \html_video_list(Videos, Options)))
-	     ]).
-
-video_stream_header(Options) -->
-	{ option(user(_User), Options)
-	},
-	html('Your recently tagged videos').
-video_stream_header(_Options) -->
-	html('Recently tagged videos').
 
-html_video_list([], _) --> !.
-html_video_list([Video|Vs], Options) -->
-	html(li(\yaz_video_result(Video, Options))),
- 	html_video_list(Vs, Options).
 
-%%	html_tag_stream(+Tags, +Options)
-%
-%	Emit tags.
+html_tag_field(Tags) -->
+	html(form(action(location_by_id(http_yaz_user)),
+		  [textarea([name(tags), id(tags)],
+			    \html_tags(Tags)),
+		   div(class(buttons),
+		       [ input(type(submit))
+		       ])
+		  ])).
 
-html_tag_stream(TopNTags, Options) -->
-	{ http_link_to_id(http_yaz_tags, Options, Link)
-	},
- 	html([ div(class(header),
-		   h2(a(href(Link), \tag_stream_header(Options)))),
-	       div(class(body),
-		   p(class('tag-cloud'),
-		       \html_tag_cloud(TopNTags, Options)))
-	     ]).
-tag_stream_header(Options) -->
-	{ option(user(_User), Options)
-	},
-	html('Your most popular tags').
-tag_stream_header(_Options) -->
-	html('Most popular tags').
+html_tags([]) --> !.
+html_tags([Tag]) --> !, html(Tag).
+html_tags([Tag|T]) -->
+	html([Tag, ', ']),
+	html_tags(T).
 
-%%	html_tag_cloud(+Pairs:count-tag, +Options)
-%
-%	Emit an HTML tag cloud.
-
-html_tag_cloud([], _) --> !.
-html_tag_cloud(Tags, Options) -->
-	{ maplist(tag_term_pair, Tags, TagsByLabel),
-	  keysort(TagsByLabel, Sorted),
-	  pairs_values(Sorted, TagTerms),
-	  pairs_keys(Tags, Counts),
-	  max_list(Counts, Max),
-	  min_list(Counts, Min)
- 	},
-	html_tag_cloud(TagTerms, Min, Max, Options).
-
-html_tag_cloud([], _, _, _) --> !.
-html_tag_cloud([tag(_Term, Label, Count)|T], Min, Max, Options) -->
-	{ http_link_to_id(isearch_page, [q(Label)|Options], Link),
-	  Size0 is (log((20*max((Count-Min),1)) / max((Max-Min),5))) * 10,
-	  Size is max(10, Size0)
-	},
-	html([' ',
-	      a([title(Count),
-		 href(Link),
-		 style('font-size:'+Size+'px')], Label),
-	      ' ']),
-	html_tag_cloud(T, Min, Max, Options).
-
-tag_term_pair(Count-Tag, Label-tag(Term, Label, Count)) :-
-	tag_term_label(Tag, Term, Label).
+
+
+
+trim_spaces(A0,A) :-
+	atom_codes(A0, Codes0),
+	phrase(trim(Codes0), Codes),
+	atom_codes(A, Codes).
+
+trim([]) -->
+	[].
+trim([H|T]) -->
+	trim_code(H), !,
+	trim(T).
+trim([H|T]) -->
+	[H],
+	trim(T).
+
+trim_code(32) --> !.
+trim_code(13) --> !.
+trim_code(10) --> !.
diff --git a/applications/yaz_videos.pl b/applications/yaz_videos.pl
index dd696ff..17ab2fe 100644
--- a/applications/yaz_videos.pl
+++ b/applications/yaz_videos.pl
@@ -1,6 +1,6 @@
 :- module(yaz_videos,
 	  [ http_yaz_videos/1
-  	  ]).
+	  ]).
 
 :- use_module(library(http/http_dispatch)).
 :- use_module(library(http/http_parameters)).
@@ -13,8 +13,7 @@
 :- use_module(user(user_db)).
 
 :- use_module(library(yaz_util)).
-:- use_module(library(user_process)).
-:- use_module(library(video_annotation)).
+:- use_module(library(videos)).
 
 :- use_module(components(yaz_page)).
 :- use_module(components(yaz_video_item)).
@@ -28,45 +27,59 @@
 
 http_yaz_videos(Request) :-
 	http_parameters(Request,
-			[ user(User,
-				[optional(true), description('Current user id')]),
- 			  offset(Offset,
-				[default(0), integer, description('Offset of the result list')]),
+			[ user(User0,
+				[default(''),
+				 description('Current user id')]),
+			  type(Type,
+			       [oneof([active,suggested,queue,moderated,all]),
+				default(all)]),
+			  offset(Offset,
+				[default(0), integer,
+				 description('Offset of the result list')]),
 			  limit(Limit,
-				[default(20), integer, description('Limit on the number of results')])
- 			]),
- 	user_videos(User, Videos),
+				[default(20), integer,
+				 description('Limit on the number of results')])
+			]),
+	logged_on(LoggedOn0, _),
+	(   nonvar(LoggedOn0)
+	->  user_property(LoggedOn0, url(LoggedOn))
+	;   var(LoggedOn)
+	),
+	(   User0 == all
+	->  var(User)
+	;   User0 == ''
+	->  User = LoggedOn
+	;   User = User0
+	),
+	(   Type == queue
+	->  video_queue(Videos)
+	;   Type = moderated
+	->  moderated_videos(User, Videos)
+	;   Type = active
+	->  active_videos(User, Videos)
+	;   Type = suggested
+	->  suggested_videos(User, Videos)
+	;   ingested_videos(Videos)
+	),
 	length(Videos, NumberOfResults),
-  	list_offset(Videos, Offset, OffsetResults),
+	list_offset(Videos, Offset, OffsetResults),
 	list_limit(OffsetResults, Limit, LimitResults, _),
- 	html_page(LimitResults, NumberOfResults, Offset, Limit).
-
-user_videos(User, SortedVideos) :-
- 	findall(Video-Time,
-		annotation_process(User, Video, _Process, Time),
-		Pairs0),
-	keysort(Pairs0, Pairs1),
-	group_pairs_by_key(Pairs1, Groups),
-	maplist(last_process, Groups, Pairs2),
-	keysort(Pairs2, Pairs3),
-	reverse(Pairs3, Pairs),
-	pairs_values(Pairs, SortedVideos).
-
-last_process(Video-Times, Last-Video) :-
-	sort(Times, Times1),
-	reverse(Times1, [Last|_]).
+	html_page(LimitResults, NumberOfResults, Offset, Limit, Type, User, LoggedOn).
+
 
 %%	html_page(+Videos, +NumberOfResults, +Offset, +Limit)
 %
 %	Emit HTML page with a list of Videos.
 
-html_page(Results, NumberOfResults, Offset, Limit) :-
+html_page(Results, NumberOfResults, Offset, Limit, Type, User, LoggedOn) :-
 	reply_html_page(yaz,
 			[ title(['YAZ - sessions'])
 			],
 			[ div(class(topic),
 			      [ div(class(header),
-				    h2(\video_count(NumberOfResults))),
+				    h2([\header(Type, User, NumberOfResults),
+					\other_link(LoggedOn, User, Type)
+				       ])),
 				div(class(body),
 				    ol(class('result-list'),
 				       \html_video_list(Results, [desc(true)]))),
@@ -76,10 +89,45 @@ html_page(Results, NumberOfResults, Offset, Limit) :-
 					   ))
 			      ])]).
 
-video_count(1) -->
-	html('1 tagged video').
-video_count(N) -->
-	html([N, ' videos tagged']).
+other_link(LoggedOn, all, Type) -->
+	{ nonvar(LoggedOn),
+	  http_link_to_id(http_yaz_videos, [type(Type)], HREF)
+	}, !,
+	html([' / ', a(href(HREF), \other_label(Type, user))]).
+other_link(LoggedOn, _User, Type) -->
+	{ nonvar(LoggedOn),
+	  http_link_to_id(http_yaz_videos, [type(Type),user(all)], HREF)
+	},
+	!,
+	html([' / ', a(href(HREF), \other_label(Type, all))]).
+other_link(_, _, _) --> !.
+
+
+header(queue, _, N) --> !,
+	html([N, ' ', \video_label(N), ' waiting for moderation']).
+header(moderated, User, N) --> { nonvar(User) }, !,
+	html([N, ' ', \video_label(N), ' moderated by you']).
+header(moderated, _, N) --> !,
+	html([N, ' moderated ', \video_label(N)]).
+header(suggested, _, N) --> !,
+	html([N, \video_label(N), ' suggested to you']).
+header(active, User, N) --> { nonvar(User) }, !,
+	html([N, ' ', \video_label(N), ' being moderated by you']).
+header(active, _User, N) -->
+	html([N, ' ', \video_label(N), ' under moderation']).
+header(all, User, N) --> { nonvar(User) }, !,
+	html([N, ' ', \video_label(N), ' assigned to you']).
+header(all, _, N) -->
+	html([N, ' ingested ', \video_label(N)]).
+
+other_label(moderated, all) -->
+	html('all moderated videos').
+other_label(moderated, user) -->
+	html('your moderated videos').
+other_label(active, all) -->
+	html('all videos being moderated').
+other_label(active, user) -->
+	html('your active videos').
 
 
 %%	html_video_list(+Videos, +Options)//
@@ -89,4 +137,4 @@ video_count(N) -->
 html_video_list([], _) --> !.
 html_video_list([Video|Vs], Options) -->
 	html(li(\yaz_video_result(Video, Options))),
- 	html_video_list(Vs, Options).
+	html_video_list(Vs, Options).
diff --git a/components/tag_cloud.pl b/components/tag_cloud.pl
new file mode 100644
index 0000000..9f42b3d
--- /dev/null
+++ b/components/tag_cloud.pl
@@ -0,0 +1,39 @@
+:- module(tag_cloud,
+	  [ html_tag_cloud//2
+	  ]).
+
+:- use_module(library(http/http_dispatch)).
+:- use_module(library(http/html_write)).
+:- use_module(library(yaz_util)).
+
+
+%%	html_tag_cloud(+Pairs:count-tag, +Options)
+%
+%	Emit an HTML tag cloud.
+
+html_tag_cloud([], _) --> !.
+html_tag_cloud(Tags, Options) -->
+	{ maplist(tag_term_pair, Tags, TagsByLabel),
+	  keysort(TagsByLabel, Sorted),
+	  pairs_values(Sorted, TagTerms),
+	  pairs_keys(Tags, Counts),
+	  max_list(Counts, Max),
+	  min_list(Counts, Min)
+	},
+	html_tag_cloud(TagTerms, Min, Max, Options).
+
+html_tag_cloud([], _, _, _) --> !.
+html_tag_cloud([tag(_Term, Label, Count)|T], Min, Max, Options) -->
+	{ http_link_to_id(isearch_page, [q(Label)|Options], Link),
+	  Size0 is (log((20*max((Count-Min),1)) / max((Max-Min),5))) * 10,
+	  Size is max(10, Size0)
+	},
+	html([' ',
+	      a([title(Count),
+		 href(Link),
+		 style('font-size:'+Size+'px')], Label),
+	      ' ']),
+	html_tag_cloud(T, Min, Max, Options).
+
+tag_term_pair(Count-Tag, Label-tag(Term, Label, Count)) :-
+	tag_term_label(Tag, Term, Label).
diff --git a/components/yaz_page.pl b/components/yaz_page.pl
index 8780e20..f5f3738 100644
--- a/components/yaz_page.pl
+++ b/components/yaz_page.pl
@@ -3,6 +3,7 @@
 	  ]).
 
 :- use_module(library(http/html_write)).
+:- use_module(library(http/http_dispatch)).
 :- use_module(library(http/http_host)).
 :- use_module(library(http/http_path)).
 :- use_module(library(http/html_head)).
@@ -11,7 +12,6 @@
 :- use_module(applications(isearch)).
 :- use_module(library(http/http_wrapper)).
 :- use_module(library(semweb/rdf_db)).
-:- use_module(components(yaz_video_item)).
 
 :- multifile
 	user:body//2.
@@ -31,7 +31,7 @@ yaz_page(Body) -->
 		  [\html_page_header,
 		   div(id(body),
 		       div(id(content), Body))
-  		  ])).
+		  ])).
 
 %%	yaz_search_page(+Body)
 %
@@ -42,68 +42,18 @@ yaz_search_page(Body) -->
 	html(body([\html_page_header,
 		   div([id(body), class(search)],
 		       Body)
-   		  ])).
-
-:- rdf_equal(pprime:'Video', Video),
-	set_setting_default(search:target_class, Video).
-:- set_setting_default(search:pattern_literal, false).
-:- set_setting_default(search:pattern_resource, false).
-
-cliopatria:facet_weight(P, 0) :- rdf_equal(pprime:description,P), !.
-cliopatria:facet_weight(P, 0) :- rdf_equal(pprime:duration,P), !.
-cliopatria:facet_weight(P, 0) :- rdf_equal(pprime:source,P), !.
-
-
-cliopatria:search_pattern(Label, Target,
-	       [ rdf(Tag, PL, literal(Value)),
-		 rdf(TN, PN, Tag),
-		 rdf(Target, P, TN)
-	       ]) :-
-	rdf_equal(PL, rdfs:label),
-	rdf_equal(PN, rdf:value),
-	rdf_equal(P, pprime:hasAnnotation),
-	rdf(Tag, PL, literal(exact(Label), Value)),
-	rdf(TN, PN, Tag),
-	rdf(Target, P, TN).
-
-cliopatria:format_search_result(R, Query, Graph) -->
-	{ Query = query(Search,_,_,_,_,_,_),
-	  result_frame(R, Graph, Frame)
-	},
-	html(div(class('result-item'),
-		 \yaz_video_result(R, [desc(true), query(Search), frame(Frame)]))).
-
-cliopatria:facet_weight(P, 0) :-
-	rdf_equal(pprime:hasAnnotation, P).
-
-result_frame(R, Graph, Frame) :-
-	rdf_equal(pprime:hasAnnotation, P),
-	memberchk(rdf(R,P,Entry), Graph),
-	rdf(Entry, pprime:videoPlayhead, literal(F0)),
-	atom_number1(F0, F),
-	(   rdf(Entry, pprime:typingDuration, literal(D0)),
-	    atom_number1(D0, D)
-	->  Frame is (F-D)/1000
-	;   Frame is F/1000
-	).
-result_frame(_, _, 5).
-
-atom_number1(N,N) :-
-	number(N),
-	!.
-atom_number1(A,N) :-
-	atom_number(A,N).
+		  ])).
 
 %%	html_page_header//
 %
 %	Emit header of the html page.
 
 html_page_header -->
- 	html(div(id(header),
+	html(div(id(header),
 		 div(class('header-content'),
 		     [ h1(a(href(location_by_id(http_yaz_home)), 'YAZ')),
 		       div(id(pagesearch), \html_search),
-		       ul(id(pagenavigation), \html_navigation),
+		       %ul(id(pagenavigation), \html_navigation),
 		       div(id(pagecontrols), \html_page_controls)
 		     ]))).
 
@@ -113,7 +63,7 @@ html_search -->
 	  http_parameters(Request,
 			[ q(Query,
 			    [ default('')
- 			    ])
+			    ])
 			])
 	},
 	html(form(action(location_by_id(isearch_page)),
@@ -131,14 +81,15 @@ html_page_controls -->
 login -->
 	{ logged_on(User, _),
 	  nonvar(User)
- 	},
+	},
 	!,
 	html(div(class(login),
-		 [ User, ' | ',
+		 [ a(href(location_by_id(http_yaz_user)), User), ' | ',
 		   a(href(location_by_id(http_yaz_logout)), 'Sign out')
 		 ])).
 login -->
- 	html(div(class(login),
-		 a(href(location_by_id(http_yaz_user)), 'Sign in'))).
+	{ http_link_to_id(http_yaz_home, [login(true)], HREF) },
+	html(div(class(login),
+		 a(href(HREF), 'Sign in'))).
 
 
diff --git a/config-available/DEFAULTS b/config-available/DEFAULTS
index d3e8e27..917656b 100644
--- a/config-available/DEFAULTS
+++ b/config-available/DEFAULTS
@@ -1 +1,2 @@
 config(yaz, link).
+config(waisda_search, link).
diff --git a/config-available/waisda_search.pl b/config-available/waisda_search.pl
new file mode 100644
index 0000000..7d1cef6
--- /dev/null
+++ b/config-available/waisda_search.pl
@@ -0,0 +1,64 @@
+:- module(waisda_search, []).
+
+:- use_module(library(http/html_write)).
+:- use_module(library(semweb/rdf_db)).
+:- use_module(library(semweb/rdfs)).
+:- use_module(components(yaz_video_item)).
+
+
+:- rdf_equal(pprime:'Video', Video),
+	set_setting_default(search:target_class, Video).
+:- set_setting_default(search:pattern_literal, false).
+:- set_setting_default(search:pattern_resource, false).
+
+cliopatria:facet_weight(P, 0) :- rdf_equal(pprime:description,P), !.
+cliopatria:facet_weight(P, 0) :- rdf_equal(pprime:duration,P), !.
+cliopatria:facet_weight(P, 0) :- rdf_equal(pprime:source,P), !.
+
+cliopatria:search_pattern(Label, Target,
+	       [ rdf(TN, PN, literal(Value)),
+		 rdf(Target, P, TN)
+	       ]) :-
+	rdf_equal(PN, rdf:value),
+	rdf_equal(P, pprime:hasAnnotation),
+	rdf(TN, PN, literal(exact(Label), Value)),
+	rdf(Target, P, TN).
+cliopatria:search_pattern(Label, Target,
+	       [ rdf(Tag, PL, literal(Value)),
+		 rdf(TN, PN, Tag),
+		 rdf(Target, P, TN)
+	       ]) :-
+	rdf_equal(PL, rdfs:label),
+	rdf_equal(PN, rdf:value),
+	rdf_equal(P, pprime:hasAnnotation),
+	rdf(Tag, PL, literal(exact(Label), Value)),
+	rdf(TN, PN, Tag),
+	rdf(Target, P, TN).
+
+cliopatria:format_search_result(R, Query, Graph) -->
+	{ Query = query(Search,_,_,_,_,_,_),
+	  result_frame(R, Graph, Frame)
+	},
+	html(div(class('result-item'),
+		 \yaz_video_result(R, [desc(true), query(Search), frame(Frame)]))).
+
+cliopatria:facet_weight(P, 0) :-
+	rdf_equal(pprime:hasAnnotation, P).
+
+result_frame(R, Graph, Frame) :-
+	rdf_equal(pprime:hasAnnotation, P),
+	memberchk(rdf(R,P,Entry), Graph),
+	rdf(Entry, pprime:videoPlayhead, literal(F0)),
+	atom_number1(F0, F),
+	(   rdf(Entry, pprime:typingDuration, literal(D0)),
+	    atom_number1(D0, D)
+	->  Frame is (F-D)/1000
+	;   Frame is F/1000
+	).
+result_frame(_, _, 5).
+
+atom_number1(N,N) :-
+	number(N),
+	!.
+atom_number1(A,N) :-
+	atom_number(A,N).
diff --git a/config-available/yaz.pl b/config-available/yaz.pl
index cf55769..ccfa5aa 100644
--- a/config-available/yaz.pl
+++ b/config-available/yaz.pl
@@ -23,11 +23,12 @@
 :- rdf_register_ns(wn20i, 'http://www.w3.org/2006/03/wn/wn20/instances/').
 
 
-
-
+% APIs
+:- use_module(api(ugm_ingest)).
 :- use_module(api(annotations)).
 
-% yaz applications (or actually the different pages)
+% yaz applications
+:- use_module(applications(yaz_home)).
 :- use_module(applications(yaz_admin)).
 :- use_module(applications(yaz_user)).
 :- use_module(applications(yaz_videos)).
@@ -35,13 +36,8 @@
 :- use_module(applications(yaz_game)).
 :- use_module(applications(yaz_player)).
 :- use_module(applications(yaz_fplayer)).
-%:- use_module(applications(yaz_game_recap)).
-%:- use_module(applications(yaz_tag_garden)).
-%:- use_module(applications(yaz_sgarden)).
-%:- use_module(applications(yaz_mgarden)).
 :- use_module(applications(yaz_garden)).
 :- use_module(applications(yaz_video_stats)).
-%:- use_module(applications(yaz_new_user)).
 
 % http path and handlers
 http:location(yaz, cliopatria(yaz), []).
@@ -53,3 +49,7 @@ http:location(yaz, cliopatria(yaz), []).
 			]),
 		[ prefix
                 ]).
+
+
+
+
diff --git a/lib/download_video.pl b/lib/download_video.pl
new file mode 100644
index 0000000..c2e1a42
--- /dev/null
+++ b/lib/download_video.pl
@@ -0,0 +1,90 @@
+:- module(download_video,
+	  [ save_video_stream/2  % +StreamURL, +File
+	  ]).
+
+
+:- use_module(library(http/http_open)).
+:- use_module(library(xpath)).
+:- use_module(library(thread_pool)).
+
+
+:- thread_pool_create(stream_download_pool, 5, []).
+
+
+%%	save_video_stream(+StreamURL, +File)
+%
+%	Download video stream and save it to a local file.
+
+save_video_stream(URL, File) :-
+	(   exists_file(File)
+	->  debug(stream_download, 'file already exists', [])
+	;   thread_create_in_pool(stream_download_pool,
+				  download_video_stream(URL, File),
+				  _,
+				  [])
+	).
+
+%%	download_video_stream(+StreamLocation, +SrcFile)
+%
+%	Download video at StreamLocation to SrcFile
+
+download_video_stream(Stream, File0) :-
+	Prog = path(mplayer),
+	win_relative_path(File, File0),
+	debug(stream_download, 'Downloading video stream ...', []),
+	process_create(Prog,
+		       [ '-dumpstream', Stream,
+			 '-dumpfile', file(File)
+		       ],
+		       [ stderr(pipe(Error)),
+			 stdout(null),
+			 process(PID)
+		       ]),
+	read_stream_to_codes(Error, Messages),
+	close(Error),
+	process_wait(PID, Status),
+	(   Status == exit(0)
+	->  debug(stream_download, 'stream: ok', [])
+	;   debug(stream_download, 'stream: status ~w: ~s', [Status, Messages]),
+	    %atom_codes(Text, Messages),
+	    catch(delete_file(File), _, true)
+	    %throw(error(download_video_stream(Status, Text), _))
+	).
+
+
+%%	win_relative_path(+Path, -RelativePath) is det.
+%
+%	If Path is an absolute filename, translate it into a relative
+%	one to avoid too long commandlines on Windows.
+
+win_relative_path(Path, Local) :-
+	current_prolog_flag(windows, true),
+	is_absolute_file_name(Path), !,
+	relative_path(Path, Local).
+win_relative_path(Path, Path).
+
+%%	relative_path(+Path, -Relative)
+%
+%	Transform an absolute path  into  a   relative  one  to overcome
+%	limitations of the Windows commandline handling.
+
+relative_path(Path, RelPath) :-
+	working_directory(PWD, PWD),
+	relative_path(Path, PWD, RelPath), !.
+relative_path(Path, Path).
+
+relative_path(Path, RelTo, RelPath) :-
+	concat_atom(PL, /, Path),
+	concat_atom(RL, /, RelTo),
+	delete_common_prefix(PL, RL, PL1, PL2),
+	to_dot_dot(PL2, DotDot, PL1),
+	concat_atom(DotDot, /, RelPath).
+
+delete_common_prefix([H|T01], [H|T02], T1, T2) :- !,
+	delete_common_prefix(T01, T02, T1, T2).
+delete_common_prefix(T1, T2, T1, T2).
+
+to_dot_dot([], Tail, Tail).
+to_dot_dot([_], Tail, Tail) :- !.
+to_dot_dot([_|T0], ['..'|T], Tail) :-
+	to_dot_dot(T0, T, Tail).
diff --git a/lib/user_process.pl b/lib/user_process.pl
index ebe6376..f081ce6 100644
--- a/lib/user_process.pl
+++ b/lib/user_process.pl
@@ -6,7 +6,7 @@
 	    create_user_process/3,         % +User, +Properties, -ProcessURI
 	    start_user_process/1,          % ?ProcessURI
 	    join_user_process/2,           % +ProcessURI
- 	    end_user_process/1,	           % +ProcessURI
+	    end_user_process/1,	           % +ProcessURI
 	    add_resource_properties/2,	   % +URI, +Properties:list(p=v)
 	    resource_properties/2	   % +URI, ?Properties:list(p=v)
 	  ]).
@@ -58,7 +58,7 @@ user_process_joined(Process, User) :-
 
 set_active_process(Process) :-
 	http_session_retractall(process(_)),
- 	http_session_assert(process(Process)).
+	http_session_assert(process(Process)).
 
 %%	create_user_process(+Properties, ?Process)
 %
@@ -76,10 +76,10 @@ create_user_process(User, Properties, Process) :-
 	->  rdf_bnode(Process)
 	;   true
 	),
- 	set_active_process(Process),
+	set_active_process(Process),
 	http_session_id(Session),
 	rdf_transaction((rdf_assert(Process, rdf:type, opmv:'Process', Process),
- 			 rdf_assert(Process, opmv:wasControlledBy, User, Process),
+			 rdf_assert(Process, opmv:wasControlledBy, User, Process),
 			 rdf_assert(Process, pprime:session, Session, Process),
 			 add_resource_properties_(Properties, Process)
 			)),
@@ -93,7 +93,10 @@ start_user_process(Process) :-
 	rdfs_individual_of(Process, opmv:'Process'),
 	get_time(StartTime0),
 	format_iso_dateTime(StartTime0, StartTime),
-	rdf_transaction(rdf_assert(Process, opmv:wasStartedAt, literal(type(xsd:date, StartTime)), Process)),
+	(   rdf(Process, opmv:wasStartedAt, _)
+	->  true
+	;   rdf_transaction(rdf_assert(Process, opmv:wasStartedAt, literal(type(xsd:date, StartTime)), Process))
+	),
 	debug(user_process, 'Process ~w started at ~w', [Process, StartTime]).
 
 %%	end_user_process(+Process)
@@ -102,10 +105,10 @@ start_user_process(Process) :-
 
 end_user_process(Process) :-
 	rdfs_individual_of(Process, opmv:'Process'),
- 	get_time(EndTime0),
+	get_time(EndTime0),
 	format_iso_dateTime(EndTime0, EndTime),
 	rdf_transaction((rdf_assert(Process, opmv:wasEndedAt, literal(type(xsd:date, EndTime), Process), Process)
-  			)),
+			)),
 	debug(user_process, 'Process ~w ended at ~w', [Process, EndTime]).
 
 %%	join_user_process(+Process, +User)
@@ -115,7 +118,7 @@ end_user_process(Process) :-
 join_user_process(Process, User) :-
 	rdfs_individual_of(Process, opmv:'Process'),
 	set_active_process(Process),
-  	rdf_transaction(rdf_assert(Process, opmv:wasPerformedBy, User, Process)),
+	rdf_transaction(rdf_assert(Process, opmv:wasPerformedBy, User, Process)),
 	debug(user_process, 'Process ~w joined by ~w', [Process, User]).
 
 
diff --git a/lib/video_annotation.pl b/lib/video_annotation.pl
index 104614c..fc355b9 100644
--- a/lib/video_annotation.pl
+++ b/lib/video_annotation.pl
@@ -5,7 +5,7 @@
 	    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_provenance/2,           % +Video, -Provenance
 	    video_transaction/2,          % +Video, -Transaction
 	    annotations_per_interval/3,	  % +Annotations, +Interval, +Groups
 	    annotation_value/2,		  % +AnnotationId, -Value
@@ -97,7 +97,7 @@ has_transaction(Process) :-
 value_annotation(Value, Process, User, Time) :-
 	rdf(Annotation, rdf:value, Value, Process),
 	rdf(_, pprime:hasAnnotation, Annotation),
- 	rdf(Annotation, pprime:creator, User),
+	rdf(Annotation, pprime:creator, User),
 	rdf(Annotation, pprime:videoPlayhead, literal(Time0)),
 	literal_to_number(Time0, Time).
 
@@ -179,13 +179,13 @@ tag_of_type(Type, R) :-
 
 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),
+	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).
+	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,
+	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).
@@ -199,11 +199,13 @@ matching_annotation_value(V, V).
 %
 %	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, uri(Tag,Label), Time, Score, Options) :-
+video_annotation(Video, AnnotationId, Value, Time, Score, Options) :-
 	option(query(Query), Options),
 	Query \== '',
 	!,
@@ -211,11 +213,19 @@ video_annotation(Video, AnnotationId, uri(Tag,Label), Time, Score, 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),
+	(   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),
-	rdf(AnnotationId, pprime:creator, User),
+	(   nonvar(User)
+	->  rdf(AnnotationId, pprime:creator, User)
+	;   true
+	),
 	rdf(AnnotationId, pprime:videoPlayhead, Time0),
 	literal_to_number(Time0, Time),
 	(   rdf(AnnotationId, pprime:score, Score0)
@@ -232,8 +242,11 @@ video_annotation(Video, AnnotationId, Value, Time, Score, Options) :-
 	option(user(User), Options, _),
 	option(confirmed(Confirmed), Options, false),
 	annotation_in_process(Process, Video, AnnotationId),
-	rdf(AnnotationId, pprime:creator, User),
- 	rdf(AnnotationId, rdf:value, V),
+	(   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),
@@ -250,9 +263,9 @@ video_annotation(Video, AnnotationId, Value, Time, Score, Options) :-
 annotation_in_process(Process, Video, AnnotationId) :-
 	var(Process),
 	!,
- 	rdf(Video, pprime:hasAnnotation, AnnotationId).
+	rdf(Video, pprime:hasAnnotation, AnnotationId).
 annotation_in_process(Process, Video, AnnotationId) :-
- 	rdf(Video, pprime:hasAnnotation, AnnotationId, F),
+	rdf(Video, pprime:hasAnnotation, AnnotationId, F),
 	(   F = Process:_  % provenance is stored in the transaction
 	->  true
 	;   rdf(AnnotationId, opmv:used, Process) % provenance is stored explicit
@@ -272,10 +285,10 @@ annotation_obj(V, Term) :-
 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(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),
+	rdf(AnnotationId, rdf:value, Value),
 	literal_to_number(Time0, Time).
 
 %%	video_tag(+Video, -Tag)
@@ -284,7 +297,7 @@ video_fragment_annotation(Video, Start, End, AnnotationId, Value, Time, Options)
 
 video_tag(Video, Tag) :-
 	rdf(Video, pprime:hasAnnotation, AnnotationId),
-  	rdf(AnnotationId, rdf:value, Tag).
+	rdf(AnnotationId, rdf:value, Tag).
 
 %%	video_provenance(+Video, -Provenance)
 %
@@ -304,7 +317,7 @@ video_provenance(Video, Provenance) :-
 video_transaction(Video, Transaction) :-
 	findall(P, rdf(P,opmv:used,Video), Processes),
 	member(Process, Processes),
- 	rdfh_db_transaction(Process, true, Transaction).
+	rdfh_db_transaction(Process, true, Transaction).
 
 
 %%	annotation_value(?AnnotationId, ?Value)
@@ -312,7 +325,7 @@ video_transaction(Video, Transaction) :-
 %	True if Value is used in Annotation.
 
 annotation_value(Annotation, Value) :-
- 	rdf(_, pprime:hasAnnotation, Annotation),
+	rdf(_, pprime:hasAnnotation, Annotation),
 	rdf(Annotation, rdf:value, Value).
 
 %%	annotation_provenance(+AnnotationId, -Provenance)
@@ -337,7 +350,7 @@ annotation_transaction(AnnotationId, Transaction) :-
 	rdf(AnnotationId, rdf:value, Value),
 	rdf(Video, pprime:hasAnnotation, AnnotationId),
 	Transaction = action(AnnotationId,Time,User,Graph,Action),
- 	Action = added(Video, AnnotationId, Value, Playhead).
+	Action = added(Video, AnnotationId, Value, Playhead).
 annotation_transaction(AnnotationId, Transaction) :-
 	findall(P, rdf(AnnotationId,_,_,P), Processes0),
 	sort(Processes0, Processes),
@@ -401,7 +414,7 @@ user_transaction(Process, User, Cond, Transaction) :-
 
 http_create_video_annotation(Request) :-
 	logged_on(_),
-  	http_parameters(Request,
+	http_parameters(Request,
 			[ video(Video,
 			      [description('URL of a video')]),
 			  value(Value,
@@ -474,8 +487,8 @@ update_annotation_value(AnnotationId, NewValue0) :-
 
 update_annotation_time(AnnotationId, NewTime0) :-
 	atom(AnnotationId),
- 	valid_time(NewTime0, NewTime),
- 	rdf(AnnotationId, pprime:videoPlayhead, Time),
+	valid_time(NewTime0, NewTime),
+	rdf(AnnotationId, pprime:videoPlayhead, Time),
 	rdfh_transaction((rdfh_update(AnnotationId, pprime:videoPlayhead, Time->NewTime))).
 
 
@@ -495,9 +508,9 @@ transactions_to_provenance([T|Ts], [P|Ps]) :-
 	memberchk(user(User), Message),
 	memberchk(graph(Graph), Message),
 	P = action(Id,Time,User,Graph,CanonicalAction),
- 	transactions_to_provenance(Ts, Ps).
+	transactions_to_provenance(Ts, Ps).
 transactions_to_provenance([_T|Ts], Ps) :-
- 	transactions_to_provenance(Ts, Ps).
+	transactions_to_provenance(Ts, Ps).
 
 canonical_action([assert(Video, _, AnnotationId, _),
 		  assert(_, P1, Value, _),
@@ -509,7 +522,7 @@ canonical_action([assert(Video, _, AnnotationId, _),
 	!,
 	Action = added(Video, AnnotationId, Value, Time).
 canonical_action([retract(Video, P, AnnotationId, _)
- 		 ], Action) :-
+		 ], Action) :-
 	rdf_equal(P, pprime:hasAnnotation),
 	!,
 	Action = removed(AnnotationId, Video).
@@ -520,7 +533,7 @@ canonical_action(Actions, Action) :-
 	->  true
 	;   Actions = [	assert(AnnotationId, P, NewValue, _) ]
 	),
- 	(   rdf_equal(P, pprime:videoPlayhead)
+	(   rdf_equal(P, pprime:videoPlayhead)
 	->  Type = timeChange
 	;   rdf_equal(P, rdf:value)
 	->  Type = valueChange
@@ -551,7 +564,7 @@ valid_time(Time, Valid) :-
 	ground(Time),
 	(   Time = literal(_)
 	->  Valid = Time
- 	;   number(Time)
+	;   number(Time)
 	->  Valid = literal(Time)
 	;   type_error(time_object, Time)
 	).
diff --git a/lib/videos.pl b/lib/videos.pl
new file mode 100644
index 0000000..f263a8b
--- /dev/null
+++ b/lib/videos.pl
@@ -0,0 +1,151 @@
+:- module(videos,
+	  [ ingested_videos/1,	  % -Videos
+	    video_queue/1,        % -Videos
+	    active_videos/2,      % ?User, -Videos
+	    moderated_videos/2,   % ?User, -Videos
+	    suggested_videos/2,	  % ?User, -Videos
+	    ingested_video/2,     % ?Video, ?IngestionTime
+	    active_video/4,       % ?User, ?Process, ?Video, ?StartTime
+	    moderated_video/5,    % ?User, ?Process, ?Video, ?StartTime, ?EndTime
+	    suggested_video/2,    % ?User, ?Video
+	    video_label//1        % +Count
+	  ]).
+
+
+:- use_module(library(semweb/rdf_db)).
+:- use_module(library(http/html_write)).
+
+
+%%	ingested_videos(-Videos)
+%
+%	Returns a list Videos that are ingested.
+%
+%	Params:
+%	 * User
+%	 When defined Videos are limited to the videos assigned to
+%	 this User.
+
+ingested_videos(SortedVideos) :-
+	findall(Time-Video,
+		ingested_video(Video, Time),
+		Pairs0),
+	keysort(Pairs0, Pairs1),
+	reverse(Pairs1, Pairs),
+	pairs_values(Pairs, SortedVideos).
+
+%%	video_queue(?User, -Videos)
+%
+%	Returns a list Videos that are ingested and not moderated
+%	yet.
+%
+%	Params:
+%	 * User
+%	 When defined Videos are limited to the videos assigned to
+%	 this User.
+
+video_queue(SortedVideos) :-
+	findall(Time-Video,
+		(   ingested_video(Video, Time),
+		    \+ in_moderation(Video, _)
+		),
+		Pairs0),
+	keysort(Pairs0, Pairs1),
+	reverse(Pairs1, Pairs),
+	pairs_values(Pairs, SortedVideos).
+
+%%	active_videos(?User, -Videos)
+%
+%	Returns a list Videos that are moderated.
+%
+%	Params:
+%	 * User
+%	 When defined Videos are limited to the videos assigned to
+%	 this User.
+
+active_videos(User, SortedVideos) :-
+	findall(Time-Video,
+		( active_video(User, Video, _, Time)
+		),
+		Pairs0),
+	keysort(Pairs0, Pairs1),
+	reverse(Pairs1, Pairs),
+	pairs_values(Pairs, SortedVideos).
+
+%%	moderated_videos(?User, -Videos)
+%
+%	Returns a list Videos that are moderated.
+%
+%	Params:
+%	 * User
+%	 When defined Videos are limited to the videos assigned to
+%	 this User.
+
+moderated_videos(User, SortedVideos) :-
+	findall(Time-Video,
+		( moderated_video(User, Video, _, _, Time)
+		),
+		Pairs0),
+	keysort(Pairs0, Pairs1),
+	reverse(Pairs1, Pairs),
+	pairs_values(Pairs, SortedVideos).
+
+
+%%	suggested_videos(+User, -Videos)
+%
+%	Returns a list Videos that are suggested to User
+
+suggested_videos(User, Videos) :-
+	findall(Video,
+		suggested_video(User, Video),
+		Videos).
+
+
+
+%%	ingested_video(?Video, ?Time)
+%
+%	True if Video is ingested at Time by User.
+
+ingested_video(Video, Time) :-
+	rdf(Video, pprime:ingestedAt, literal(Time)).
+
+
+%%	active_video(?User, ?Video, ?Process, -StartTime)
+%
+%	True if Video is currently under moderation by User in Process.
+
+active_video(User, Video, Process, Time) :-
+	rdf(Process, opmv:used, Video),
+	rdf(Process, opmv:wasControlledBy, User),
+	rdf(Process, rdf:type, pprime:'TagGarden'),
+	rdf(Process, opmv:wasStartedAt, literal(Time)),
+	\+ rdf(Process, opmv:wasEndAt, _).
+
+%%	moderated_video(?User, ?Video, ?Process, -StartTime, -EndTime)
+%
+%	True if Video is moderated by User in Process.
+
+moderated_video(User, Video, Process, StartTime, EndTime) :-
+	rdf(Process, opmv:used, Video),
+	rdf(Process, opmv:wasControlledBy, User),
+	rdf(Process, rdf:type, pprime:'TagGarden'),
+	rdf(Process, opmv:wasStartedAt, literal(StartTime)),
+	rdf(Process, opmv:wasEndAt, literal(EndTime)).
+
+%%	suggested_video(?User, ?Video, ?Process)
+%
+%	True if video is suggested to User by Process.
+
+suggested_video(User, Video) :-
+	rdf(User, pprime:suggestion, Video),
+	\+ in_moderation(Video, _).
+
+
+
+in_moderation(Video, Process) :-
+	rdf(Process, opmv:used, Video),
+	rdf(Process, rdf:type, pprime:'TagGarden').
+
+video_label(1) -->
+	html(video).
+video_label(_) -->
+	html(videos).
diff --git a/web/css/player.css b/web/css/player.css
index 32d6d29..4f6375c 100644
--- a/web/css/player.css
+++ b/web/css/player.css
@@ -13,6 +13,12 @@
 	clear: both;
 }
 
+.status {
+	width: 100%;
+	padding: 1.5em;
+	background-color: #EEE;
+}
+
 /* element style */
 
 #video {