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, http),
   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 gavatar.

   77valid_gravatar(URL) :-
   78	string_concat(URL, "?d=404", URL2),
   79	catch(http_open(URL2, In, [method(head)]),
   80	      error(existence_error(_,_),_),
   81	      fail),
   82	close(In).

 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

   94random_avatar(AvatarURL) :-
   95	avatar_cache(_Size),
   96	repeat,
   97	findall(I, free_avatar(I), L),
   98	    (	L == []
   99	    ->	resource_error(avatars)
  100	    ;	random_member(A, L),
  101		avatar(A, AvatarURL),
  102		with_mutex(avatar, claim_avatar(A)),
  103		!
  104	    ).
  105
  106free_avatar(I) :-
  107	avatar(I, _),
  108	\+ used_avatar(I).
  109
  110claim_avatar(I) :-
  111	used_avatar(I), !, fail.
  112claim_avatar(I) :-
  113	assertz(used_avatar(I)).

 release_avatar(+URL) is det

Release the avatar to the pool of free avatars.

  119release_avatar(URL0) :-
  120	atom_string(URL, URL0),
  121	forall(avatar(I, URL),
  122	       retractall(used_avatar(I))).
  123
  124clean_avatar_cache :-
  125	retractall(avatar_cache_size(_)),
  126	retractall(avatar(_,_)).
  127
  128:- dynamic
  129	used_avatar/1,
  130	avatar_cache_size/1,
  131	avatar/2.  132:- volatile
  133	used_avatar/1,
  134	avatar_cache_size/1,
  135	avatar/2.  136
  137avatar_cache(Size) :-
  138	avatar_cache_size(Size), !.
  139avatar_cache(Size) :-
  140	findall(Path, avatar_path(Path), Paths),
  141	foldl(assert_avatar, Paths, 0, Size0),
  142	assertz(avatar_cache_size(Size0)),
  143	Size = Size0.
  144
  145avatar_path(icons(avatar/File)) :-
  146	absolute_file_name(icons(avatar), Dir,
  147			   [ file_type(directory),
  148			     solutions(all)
  149			   ]),
  150	directory_files(Dir, Files),
  151	member(File, Files),
  152	file_name_extension(_, Ext, File),
  153	downcase_atom(Ext, LwrExt),
  154	image_extension(LwrExt).
  155
  156image_extension(png).
  157image_extension(jpg).
  158image_extension(jpeg).
  159image_extension(gif).
  160
  161assert_avatar(Path, N, N2) :-
  162	http_absolute_location(Path, HREF, []),
  163	assertz(avatar(N, HREF)),
  164	N2 is N+1