1:- module(bc_view, [
    2    bc_view_cached/1,       % +Path
    3    bc_view_send/2,         % +Name, +Data
    4    bc_view_send/3,         % +Name, +Data, +ContentType
    5    bc_view_enable_cache/0,
    6    bc_view_disable_cache/0,
    7    bc_view_purge_cache/0,
    8    bc_view_not_found/0,
    9    bc_view_see_other/1     % + URL
   10]).   11
   12:- use_module(library(http/http_wrapper)).   13:- use_module(library(http/http_dispatch)).   14:- use_module(library(http/http_header)).   15:- use_module(library(debug)).   16:- use_module(library(st/st_file)).   17:- use_module(library(st/st_render)).   18
   19:- use_module(bc_data_config).   20:- use_module(bc_headers).   21:- use_module(bc_env).   22
   23:- dynamic(cache_enabled/0).   24:- dynamic(cache/4).
 bc_view_enable_cache is det
Enables view caching.
   30bc_view_enable_cache:-
   31    asserta(cache_enabled),
   32    debug(bc_view, 'view caching is enabled', []).
 bc_view_disable_cache is det
Disables view caching. Purges all cache entries.
   38bc_view_disable_cache:-
   39    retractall(cache_enabled),
   40    retractall(cache(_, _, _, _)),
   41    debug(bc_view, 'view caching is disabled', []).
 bc_view_purge_cache is det
Purges all cache entries.
   47bc_view_purge_cache:-
   48    retractall(cache(_, _, _, _)),
   49    debug(bc_view, 'purged cache', []).
 bc_view_not_found is det
Sends non-cached 404 response. Uses exceptions mechanism to produce the response.
   56bc_view_not_found:-
   57    http_current_request(Request),
   58    http_404([], Request).
 bc_view_see_other(+Url) is det
Sends redirect 303 (see other) for the current request.
   65bc_view_see_other(Url):-
   66    http_current_request(Request),
   67    http_redirect(see_other, Url, Request).
 bc_view_cached(+Path, +Content) is semidet
Produces reply from cached view. Fails when there is no cached result for the URL path.
   74bc_view_cached(Path):-
   75    cache(Path, Content, Type, Time),
   76    http_current_request(Request),
   77    (   bc_if_modified_since(Request, Since),
   78        Since >= Time
   79    ->  debug(bc_view, 'sending not-modified status for ~p', [Path]),
   80        throw(http_reply(not_modified))
   81    ;   debug(bc_view, 'sending cached view for ~p', [Path]),
   82        get_time(Now),
   83        write_cache_control_public,
   84        write_last_modified(Now),
   85        write_content_type(Type),
   86        write(Content)).
 bc_view_send(+Name, +Data) is det
Same as bc_view_send/3 with the default content type. The default content type is Content-type: text/html; charset=UTF-8.
   94bc_view_send(Name, Data):-
   95    default_content_type(Type),
   96    bc_view_send(Name, Data, Type).
 bc_view_send(+Name, +Data, +ContentType) is det
Renders and sends a simple-template view. Stores rendering result in cache when caching is enabled.
  104bc_view_send(Name, Data, Type):-
  105    cache_enabled, !,
  106    http_current_request(Request),
  107    memberchk(path(Path), Request),
  108    get_time(Now),
  109    write_cache_control_public,
  110    write_last_modified(Now),
  111    write_content_type(Type),
  112    with_output_to(string(Content),
  113        render_with_options(Name, Data)),
  114    asserta(cache(Path, Content, Type, Now)),
  115    debug(bc_view, 'stored view in cache ~p', [Path]),
  116    write(Content).
  117
  118bc_view_send(Name, Data, Type):-
  119    write_content_type(Type),
  120    render_with_options(Name, Data).
  121
  122render_with_options(Name, Data):-
  123    current_output(Stream),
  124    (   bc_env_production
  125    ->  Cache = true
  126    ;   Cache = false),
  127    bc_config_dict(Config),
  128    RenderData = Data.put(config, Config),
  129    st_render_file(Name, RenderData, Stream,
  130        _{ encoding: utf8, strip: true,
  131           cache: Cache, extension: html }).
  132
  133% The default content type for views.
  134
  135default_content_type('Content-type: text/html; charset=UTF-8').
 write_content_type(+Type) is det
Writes the given content type and charset. Does not validate anything.
  142write_content_type(Type):-
  143    format('~w\r\n\r\n', [Type]).
 write_cache_control_public is det
Writes Cache-control: public header.
  149write_cache_control_public:-
  150    write('Cache-Control: public\r\n').
 write_last_modified(+Timestamp) is det
Writes Last-Modified header based on the given timestamp.
  157write_last_modified(Timestamp):-
  158    http_timestamp(Timestamp, String),
  159    format('Last-Modified: ~w\r\n', [String])