:- use_module( library(http_unix_daemon_real)). % http_daemon/0 slightly patched. :- use_module( library(http/thread_httpd) ). :- use_module( library(http/http_session) ). :- use_module( library(http/html_write) ). % page/4, see also html/3 :- use_module( library(http/http_client) ). % http_read_data/3 :- use_module( library(http/http_dispatch) ). % http_reply_file/3 :- http_handler( /, reply, [prefix] ). % :- listen( http(post_server_start), r_thread_loop ). :- listen( http(pre_server_start), ws_hist_pre ). :- use_module( library(real) ). :- <- suppressPackageStartupMessages( library( "ggplot2" ) ). /* when included SWI server fails on its setup_signals/0 predicate huped( hup ) :- thread_send_message( main, stop ). :- on_signal( hup, _Old, huped ). */ % ws_hist. % % Run a simple web server demonstrating threaded use of the Real pack. It runs on SWI. % The server takes up to 4 lists of numbers and plots them as dodged histogram onto a PNG file. % % You can execute this file locally as far as you have R with the ggplot2 package. % % To run the server from the command line simply load this file into SWI. % % Then open your browser at http://localhost:7171 % % To run the server as a linux init.d script see http://stoics.org.uk/~nicos/sware/real/ws.html % % @author nicos angelopoulos % @version 0.1 2014/03/23 % ws_hist :- % called by initialization/2 current_prolog_flag( argv, Args ), ( (member(Arg,Args),atom_concat('--port',_,Arg)) -> true; fail ), !, http_daemon. ws_hist :- thread_create( delete_tmp_file, _, [alias(del_tmp),detached(true)] ), http_server( reply, [ timeout(600), port(7171) ] ), r_thread_loop. ws_hist_pre :- % connected to the http(pre...) listener thread_create( delete_tmp_file, _, [alias(del_tmp),detached(true)] ). /* repot( Term ) :- % if things go pairshape, try debugging: open( '/tmp/repot.txt', append, Out ), portray_clause( Out, Term ), close( Out ). */ reply( Request ) :- memberchk( path(Path), Request ), path_reply( Path, '', Request ). path_reply( '/', Pfx, _ ) :- debug( ws_hist, 'In root', [] ), reply_form( Form ), header( Pfx, Header ), footer( Footer ), flatten( [Header,Form,Footer], Body ), Head = title('Real in web services example'), phrase( page(Head,Body), HTML), format('Content-type: text/html~n~n'), print_html( HTML ). path_reply( '/plot', _, Request ) :- http_read_data(Request, Data, []), ( memberchk(session(Sess),Request) -> true; Sess = none_found ), alpha_num( Sess, SessTkn ), atomic_list_concat( [df,SessTkn], '_', Df ), data_ggplot_df( Data, Df ), data_labels( Data, Xlab, Ylab ), GG = ( ggplot( Df, aes(x='as.factor'(pos), y=pop, fill='as.factor'(list))) + geom_bar( position="dodge", stat="identity", width=0.5 ) + scale_fill_discrete( name = "lists") + labs( x=Xlab ) + labs( y=Ylab ) ), debug( ws_hist, 'attempting to plot: ~w', [GG] ), debug( wb_hist, 'Session: ~w', [Sess] ), directory_file_path( '/tmp', Sess, TmpSess ), file_name_extension( TmpSess, png, PngF ), atom_concat( TmpSess, '_dummy', CairoSess ), file_name_extension( CairoSess, png, CairoF ), % write( user_error, 'pnging' ), nl( user_error ), <- png( filename=+CairoF ), % this is only a decoy, to avoid an x11() starting ggplot <- GG, <- suppressMessages( ggsave( plot=GG, filename=+PngF, dpi=72 ) ), devoff, <- remove( Df ), !, ( getenv('USER',User) -> true; User = none ), path_record( User, successful, Data, Request ), debug( wb_hist, 'Png file: ~w', PngF ), thread_send_message( del_tmp, del(CairoF) ), thread_send_message( del_tmp, del(PngF) ), http_reply_file( PngF, [unsafe(true)], [] ). path_reply( '/plot', _, Request ) :- ( getenv('USER',User) -> true; User = none ), path_record( User, badly_formed, [], Request ), Pfx = 'Something is wrong with your input, have another go.', path_reply( '/', Pfx, Request ). reply_form( Form ) :- Form = [h4(real_example,style('color:darkgreen')), form( [action(plot),method('Post')], table( [ tr( [ td( input([type(text),name(val1),value('1,2,3')]) ), td( input([type(text),name(val2),value('2,4')]) ), td( input([type(text),name(val3),value('12,5,0,2')]) ), td( input([type(text),name(val4),value('1')]) ) ] ), tr( [] ), tr( [td(align(right),x_label), td( input( [type(text),name(xlab),value(xlab)] ) ) ] ), tr( [td(align(right),y_label), td( input( [type(text),name(ylab),value('some text')] ) ) ] ), tr( [] ), tr( [ td(''), td(''), td(''), td(input([type(submit),value('create plot')])) ] ), tr( [] ) ] ) ) ]. data_ggplot_df( Data, DFRv ) :- maplist( plot_list_term(Data), [1,2,3,4], PlistTermsPrv ), % fail on long input include( non_empty_arg_2, PlistTermsPrv, PLts ), maplist( arg(2), PLts, PLs ), maplist( length, PLs, PLlengths ), max_list( PLlengths, Max ), findall( Nths, (between(1,Max,N), findall(Nth,(member(pl(_,Pl),PLts),nth1(N,Pl,Nth)),Nths) ), NthPlNest ), flatten( NthPlNest, Pop ), debug( ws_hist, 'Populations : ~w', [Pop] ), findall( OT, (between(1,Max,N), findall(I,(member(pl(I,Pl),PLts),nth1(N,Pl,_Nth1)),OT) ), OTnest ), flatten( OTnest, ListIds ), debug( ws_hist, 'List ids: ~w', [ListIds] ), findall( Poss, (between(1,Max,N), findall(N,(member(pl(I,Pl),PLts),nth1(N,Pl,_Nth2)),Poss) ), PositsNest ), flatten( PositsNest, Posits ), debug( ws_hist, 'Posits : ~w', [Posits] ), DFRv <- 'data.frame'( pop=Pop, list=ListIds, pos=Posits ). non_empty_arg_2( Term ) :- arg( 2, Term, Arg2 ), Arg2 \== []. plot_list_term( Data, I, pl(I,VList) ) :- atomic_list_concat( [val,I], VLname ), memberchk( VLname=VListAtom, Data ), atom_length( VListAtom, VListAtomLen ), VListAtomLen < 200, atomic_list_concat( VListAtomsPrv, ',', VListAtom ), empty_list( VListAtomsPrv, VListAtoms ), maplist( atom_number, VListAtoms, VList ). empty_list( [''], [] ) :- !. empty_list( List, List ). data_labels( Data, Xlab, Ylab ) :- memberchk( xlab=XlabA, Data ), memberchk( ylab=YlabA, Data ), atom_string( XlabA, Xlab ), atom_string( YlabA, Ylab ). header( Pfx, Header ) :- Std1 = 'Enter up to 4 lists of comma separated numbers (each list should be less than 200 characters long).', Std2 = 'This script will create the "dodged" histogram of the inputs and serve it as a PNG.', Header = [ p( ['Demo for using ',a(href('http://stoics.org.uk/~nicos/sware/real'),real), ' ', ' in web services.'] ), p( [Pfx,br(''),Std1,br(''),Std2] ) ]. footer( Footer ) :- ( gethostname('vps34663.ovh.net') -> Extra = '(Be patient for the reply, this is a tiny server with a miniscule amount of memory.)' ; Extra = '' ), Footer = [ p(''), br(''),p(Extra),br(''), h3('software used in this demo'), p(''), ul( [ li( a(href('http://www.swi-prolog.org/'),'SWI Prolog') ), li( a(href('http://www.r-project.org/'),'R') ), li( a(href('http://ggplot2.org'),'ggplot2') ), li( a(href('http://stoics.org.uk/~nicos/sware/real'),'Real') ) ] ), p(''), p( ['The sources for this example can be found at: ', a(href('http://stoics.org.uk/~nicos/sware/real/web_srv_hist.pl'),'web_srv_hist.pl'),'.' ] ) ]. delete_tmp_file :- thread_get_message( Mess ), delete_tmp_file( Mess ). delete_tmp_file( halt ) :- !, thread_exit( true ). delete_tmp_file( del(Tmp) ) :- sleep( 2 ), % wait till the file is served ( atom_concat('/tmp',_,Tmp) -> catch(delete_file(Tmp),_,true) ; true ), delete_tmp_file. alpha_num( Atom, Token ) :- atom_codes( Atom, Codes ), include( alpha_num_code, Codes, Incl ), atom_codes( Token, Incl ). alpha_num_code( Code ) :- 0'0 =< Code, Code =< 0'9. alpha_num_code( Code ) :- 0'a =< Code, Code =< 0'z. alpha_num_code( Code ) :- 0'A =< Code, Code =< 0'Z. path_record( nicos, Res, _Data, Request ) :- ( memberchk( peer(Peer), Request ) -> true; Peer = no_peer_information ), File = '/srv/www/html/log/nicos/real/ws_hist/log.pl', catch( open(File,append,Out), _, fail ), !, get_time(TimeStamp), stamp_date_time(TimeStamp, DateTime, local), DateTime =.. [date,A,B,C,D,E|_Args], Date =.. [date,A,B,C,D,E], Term =.. [Res,Date,Peer], portray_clause( Out, Term ), close( Out ). % you can enable logging for your setup by writing a new clause here path_record( _User, _Res, _Data, _Request ). :- initialization( ws_hist, after_load ).