1/*  Part of SWISH
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@cs.vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (C): 2014-2016, VU University Amsterdam
    7			      CWI Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(avatar,
   37	  [ email_gravatar/2,			% +Email, -AvatarURL
   38	    valid_gravatar/1,			% +AvatarURL
   39	    random_avatar/1,			% -AvatarURL
   40	    release_avatar/1,			% +AvatarURL
   41
   42	    clean_avatar_cache/0
   43	  ]).   44:- use_module(library(uri)).   45:- use_module(library(md5)).   46:- use_module(library(lists)).   47:- use_module(library(random)).   48:- use_module(library(apply)).   49:- use_module(library(http/http_path)).   50:- use_module(library(http/http_open)).   51:- use_module(library(error)).

 email_avatar(+Email, -AvatarImageLink) is det

See also

- https://en.gravatar.com/site/implement/hash/

- https://en.gravatar.com/site/implement/images/

   63email_gravatar(Email, AvatarURL) :-
   64	downcase_atom(Email, CanonicalEmail),
   65	md5_hash(CanonicalEmail, Hash, []),
   66	atom_concat('/avatar/', Hash, Path),
   67	uri_data(scheme,    Components, https),
   68	uri_data(authority, Components, 'www.gravatar.com'),
   69	uri_data(path,      Components, Path),
   70	uri_components(AvatarURL, Components).

 valid_gravatar(+URL) is semidet

True if URL is a real gravatar. We cache results for 300 seconds.

   78:- dynamic
   79	gravatar_tested/3.			% URL, Time, Result
   80
   81valid_gravatar(URL) :-
   82	gravatar_tested(URL, Time, Result),
   83	get_time(Now),
   84	(   Now - Time < 300
   85	->  !,
   86	    Result == true
   87	;   retractall(gravatar_tested(URL,_,_))
   88	).
   89valid_gravatar(URL) :-
   90	string_concat(URL, "?d=404", URL2),
   91	(   catch(http_open(URL2, In, [method(head)]),
   92		  error(_,_),
   93		  fail)
   94	->  close(In),
   95	    Result = true
   96	;   Result = false
   97	),
   98	get_time(Now),
   99	asserta(gravatar_tested(URL, Now, Result)),
  100	Result == true.

 random_avatar(-AvatarURL) is det

Generate a random avatar image url. This uses an arbitrary image from the virtual path icons(avatar). This predicate never replies with the same URL.

Arguments:

AvatarURL

- is a relative URL (does not include the host)

Errors

- resource_error(avatars) if no more avatars are available

  111random_avatar(AvatarURL) :-
  112	avatar_cache(_Size),
  113	repeat,
  114	findall(I, free_avatar(I), L),
  115	    (	L == []
  116	    ->	resource_error(avatars)
  117	    ;	random_member(A, L),
  118		avatar(A, AvatarURL),
  119		with_mutex(avatar, claim_avatar(A)),
  120		!
  121	    ).
  122
  123free_avatar(I) :-
  124	avatar(I, _),
  125	\+ used_avatar(I).
  126
  127claim_avatar(I) :-
  128	used_avatar(I), !, fail.
  129claim_avatar(I) :-
  130	assertz(used_avatar(I)).

 release_avatar(+URL) is det

Release the avatar to the pool of free avatars.

  136release_avatar(URL0) :-
  137	atom_string(URL, URL0),
  138	forall(avatar(I, URL),
  139	       retractall(used_avatar(I))).
  140
  141clean_avatar_cache :-
  142	retractall(avatar_cache_size(_)),
  143	retractall(avatar(_,_)).
  144
  145:- dynamic
  146	used_avatar/1,
  147	avatar_cache_size/1,
  148	avatar/2.  149:- volatile
  150	used_avatar/1,
  151	avatar_cache_size/1,
  152	avatar/2.  153
  154avatar_cache(Size) :-
  155	avatar_cache_size(Size), !.
  156avatar_cache(Size) :-
  157	findall(Path, avatar_path(Path), Paths),
  158	foldl(assert_avatar, Paths, 0, Size0),
  159	assertz(avatar_cache_size(Size0)),
  160	Size = Size0.
  161
  162avatar_path(icons(avatar/File)) :-
  163	absolute_file_name(icons(avatar), Dir,
  164			   [ file_type(directory),
  165			     solutions(all)
  166			   ]),
  167	directory_files(Dir, Files),
  168	member(File, Files),
  169	file_name_extension(_, Ext, File),
  170	downcase_atom(Ext, LwrExt),
  171	image_extension(LwrExt).
  172
  173image_extension(png).
  174image_extension(jpg).
  175image_extension(jpeg).
  176image_extension(gif).
  177
  178assert_avatar(Path, N, N2) :-
  179	http_absolute_location(Path, HREF, []),
  180	assertz(avatar(N, HREF)),
  181	N2 is N+1