:- module(video_frames, [ cache_tag_frames/3, video_frame/3 ]). :- use_module(library(settings)). :- use_module(library(http/url_cache)). :- use_module(library(http/http_dispatch)). :- use_module(library(http/http_parameters)). :- use_module(library(http/http_header)). :- use_module(library(http/http_path)). :- use_module(library(semweb/rdf_db)). :- use_module(user(user_db)). :- use_module(library(yaz_util)). :- use_module(library(thread_pool)). % Windows: 'cmd.exe /C ffmpeg.exe' :- setting(frame_program, atom, ffmpeg, 'FFMPEG convert used to extract video frames'). :- setting(frame_size, any, size(120,96), 'Term size(W,H) into which video frames are scaled'). :- setting(cache_directory, atom, 'cache/frames', 'Directory for caching video frames'). http:location(video, root(video), []). user:file_search_path(video, videos). %:- thread_pool_create(video, 20, []). :- http_handler(root(videoframe), serve_video_frame, []). :- http_handler(video(.), serve_video, [spawn(video), prefix]). %% serve_video(+Request) % % Serve a video. % % @TBD How can we know the mimetype serve_video(Request) :- %ensure_logged_on(_), http_parameters(Request, [ url(URL, [ optional(true), description('URL of video that is stored locally') ]), t(Time, [ optional(true), description('URL of the video')]) ]), ( nonvar(URL) -> www_form_encode(URL, Video) ; memberchk(path_info(Video), Request) ), ( nonvar(Time), parse_time_param(Time, Start, End) -> video_fragment(Video, Start, End, Fragment) ; Fragment = video(Video) ), %Mimetype = 'video/x-ms-wmv', Mimetype = 'video/flv', http_reply_file(Fragment, [mimetype(Mimetype), unsafe(true)], Request). %% video_fragment(+VideoFile, +Start, +End, -Fragment) % % @TBD video_fragment(Video, _, _, Video). parse_time_param(S, Start, End) :- concat_atom([Start, End], ',', S). %% cache_tag_frames(+Video, +Game, +User) % % Precompute the frames for each tag assinged to Video. cache_tag_frames(VideoURL, Game, User) :- absolute_file_name(video(VideoURL), Video), findall(Time, tag_entry_time(Game, VideoURL, User, Time), Times0), sort(Times0, Times), length(Times, Count), debug(frame, 'caching ~w frames for ~w', [Count, VideoURL]), forall(member(T, Times), video_frame(Video, T, _)). %% tag_entry(?Game, ?Video, ?User, ?TagEntry, ?TagTerm, ?Tag, %% ?Time) % % Enumerates the tag entries and their Terms entered by User % for Video in Game. tag_entry_time(Game, Video, User, Time) :- rdf(Game, sem:involves, Video), rdf(TagEntry, sem:subEventOf, Game), rdf(TagEntry, sem:hasActor, User), rdf(TagEntry, pprime:playheadTime, Time0), literal_to_number(Time0, Time). %% serve_video_frame(+Request) % % Reply PNG of the frame in Video at a given time point. serve_video_frame(Request) :- http_parameters(Request, [ url(VideoURL, [ description('URL of the video')]), time(Time, [ description('Time in the video')]) ]), debug(frame, 'Frame for ~w', [VideoURL]), ( atom_concat('/video/', Local, VideoURL) -> true ; www_form_encode(VideoURL, Local) ), absolute_file_name(video(Local), VideoFile), ( exists_file(VideoFile) -> video_frame(VideoFile, Time, FrameFile) ; http_absolute_location(icon('no_image.jpg'), FrameFile, []) ), http_reply_file(FrameFile, [mimetype('image/png'), unsafe(true)], Request). %% video_frame(+Video, +Time, -File) % % Return thumbnail file for video frame at Time. video_frame(Video, Time, File) :- video_frame_dir(Dir0), atom_concat(Video, Time, FrameUrl), url_cache_file(FrameUrl, Dir0, '', File0), concat_atom([File0, '%d', '.jpg'], ExtractFile), atom_concat(File0, '1.jpg', File), ( exists_file(File) -> debug(frame, 'CACHE: ~w', [File]) ; debug(frame, 'Extracting frame from ~w at time ~w', [Video, Time]), extract_video_frame(Video, Time, ExtractFile) ). %% video_frame_dir(-AbsDir) % % Directory for caching video frames. Create if it doesn't exist. video_frame_dir(AbsDir) :- setting(cache_directory, Dir), Dir \== '', absolute_file_name(Dir, AbsDir), ensure_directory(AbsDir). %% extract_video_frame(+Video, +Time, +Frame) % % Use ffmpeg to extract a frame from Video at time point Time. % The operation is controlled by the following settings: % % * video_frames:frame_size % A term size(W,H) that specifies the size of Frame. % % * video_frames:frame_program % Name of the ffmpeg executable. extract_video_frame(Video, Time, File) :- setting(frame_size, size(W, H)), setting(frame_program, Prog), convert_prog_term(Prog, Exe), win_relative_path(Video, OSVideo), win_relative_path(File, OSFile), format(string(SizeOpt), '~wx~w', [W, H]), debug(frame, 'Running ffmpeg ...', []), process_create(Exe, [ '-vframes', '1', '-ss', Time, '-s', SizeOpt, '-i', file(OSVideo), file(OSFile) ], [ stderr(pipe(Error)), process(PID) ]), read_stream_to_codes(Error, Messages), close(Error), process_wait(PID, Status), ( Status == exit(0) -> debug(frame, 'ffmpeg: ok', []) ; debug(frame, 'ffmpeg: status ~w: ~s', [Status, Messages]), atom_codes(Text, Messages), catch(delete_file(File), _, true), throw(error(frame_extract_failed(Status, Text), _)) ). convert_prog_term(Prog, Prog) :- is_absolute_file_name(Prog), !. convert_prog_term(Prog, path(Prog)). %% 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). %% ensure_directory(+Dir:atom)is det. % % Create directory and -if needed- parents. May generate file % system errors. ensure_directory(Dir) :- exists_directory(Dir), !. ensure_directory(Dir) :- file_directory_name(Dir, Parent), Parent \== Dir, ensure_directory(Parent), make_directory(Dir).