View source with formatted comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@cs.vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (C): 2013, VU University Amsterdam
    7
    8    This program is free software; you can redistribute it and/or
    9    modify it under the terms of the GNU General Public License
   10    as published by the Free Software Foundation; either version 2
   11    of the License, or (at your option) any later version.
   12
   13    This program is distributed in the hope that it will be useful,
   14    but WITHOUT ANY WARRANTY; without even the implied warranty of
   15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   16    GNU General Public License for more details.
   17
   18    You should have received a copy of the GNU General Public
   19    License along with this library; if not, write to the Free Software
   20    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   21
   22    As a special exception, if you link this library with other files,
   23    compiled with a Free Software compiler, to produce an executable, this
   24    library does not by itself cause the resulting executable to be covered
   25    by the GNU General Public License. This exception does not however
   26    invalidate any other reasons why the executable file might be covered by
   27    the GNU General Public License.
   28*/
   29
   30:- module(register, []).   31:- use_module(library(http/html_write)).   32:- use_module(library(http/http_dispatch)).   33:- use_module(library(http/http_parameters)).   34:- use_module(openid).   35:- use_module(library(smtp)).   36
   37:- http_handler(root(register),            register,            []).   38:- http_handler(root(submit_registration), submit_registration, []).   39
   40register(Request) :-
   41	http_parameters(Request,
   42			[ for(Kind, [ oneof([wiki,news]),
   43				      default(wiki)
   44				    ])
   45			]),
   46	site_user(Request, User),
   47	reg_title(Kind, Title),
   48	reply_html_page(
   49	    user(form(register(User, Kind))),
   50	    title(Title),
   51	    \reg_body(User, Kind)).
   52
   53reg_title(wiki, 'Register to edit SWI-Prolog wiki pages').
   54reg_title(news, 'Register to manage news postings').
   55
   56reg_body(User, Kind) -->
   57	reg_explain(Kind),
   58	form(User, Kind).
   59
   60reg_explain(wiki) -->
   61	html({|html||
   62	      <p>This form allows you to request permission to edit
   63	      the SWI-Prolog wiki pages.  That is, the pages that have
   64	      an <b>Edit this page</b> in the <b>WIKI</b> menu.
   65	      </p>
   66
   67	      <h2 class="wiki">Registration form</h2>
   68	      |}).
   69reg_explain(news) -->
   70	html({|html||
   71	      <p>This form allows you to request permission to post
   72	      news articles using the menu <b>COMMUNITY/News</b>
   73	      </p>
   74
   75	      <h2 class="wiki">Registration form</h2>
   76	      |}).
   77
   78
   79form(UUID, Kind) -->
   80	{ http_location_by_id(submit_registration, Action),
   81	  PlaceHolder = 'Please tell us your plans, so that we can \c
   82	  tell you are a genuine human Prolog user',
   83	  site_user_property(UUID, name(Name), 'anonymous'),
   84	  site_user_property(UUID, email(Email), 'unknown')
   85	},
   86	html(form(action(Action),
   87		  [ input([type(hidden), name(kind), value(Kind)]),
   88		    table([ tr([ th([align(right)], 'Name'),
   89				 td(input([name(name),
   90					   placeholder(
   91					       'Name associated to commits'),
   92					   disabled(disabled),
   93					   value(Name)
   94					  ]))
   95			       ]),
   96			    tr([ th([align(right)], 'Email'),
   97				 td(input([name(email),
   98					   placeholder(
   99					       'Displayed with GIT commit'),
  100					   disabled(disabled),
  101					   value(Email)
  102					  ]))
  103			       ]),
  104			    tr([ th([align(right), valign(top)], 'Comments:'),
  105				 td([ class(wiki_text), colspan(2) ],
  106				    textarea([ cols(50),rows(10),name(comment),
  107					       placeholder(PlaceHolder)
  108					     ],
  109					     ''))
  110			       ]),
  111			    tr([ td([ colspan(2), align(right) ],
  112				    input([ type(submit),
  113					    value('Sent request')
  114					  ]))
  115			       ])
  116			  ])
  117		  ])).
  118
  119
  120%%	submit_registration(+Request) is det.
  121%
  122%	Sent E-mail to submit a registration
  123
  124submit_registration(Request) :-
  125	site_user(Request, UUID),
  126	http_parameters(Request,
  127			[ comment(Comment, [optional(true)]),
  128			  kind(Kind, [])
  129			]),
  130	mail(UUID, Kind, Comment),
  131	reply_html_page(
  132	    user(mailed(admin, permission(Kind))),
  133	    title('Mail sent'),
  134	    [ p([ 'A mail has been sent to the site adminstrator. ',
  135		  'You will be informed when the account has been ',
  136		  'created.'
  137		])
  138	    ]).
  139
  140mail(UUID, Kind, Comment) :-
  141	smtp_send_mail('jan@swi-prolog.org',
  142		       message(UUID, Kind, Comment),
  143		       [ subject('SWI-Prolog permission request'),
  144			 from('jan@swi-prolog.org')
  145		       ]).
  146
  147message(UUID, Kind, Comment, Out) :-
  148	site_user_property(UUID, name(Name), 'anonymous'),
  149	site_user_property(UUID, email(EMail), 'unknown'),
  150	format(Out, 'New site permission request\n\n', []),
  151	format(Out, '\t  Kind: ~w~n', [Kind]),
  152	format(Out, '\t  UUID: ~w~n', [UUID]),
  153	format(Out, '\t  Name: ~w~n', [Name]),
  154	format(Out, '\tE-Mail: ~w~n', [EMail]),
  155	format(Out, '~n~w~n', [Comment]).
  156
  157
  158site_user_property(UUID, P, Default) :-
  159	(   site_user_property(UUID, P)
  160	->  true
  161	;   arg(1, P, Default)
  162	).
  163
  164:- multifile
  165	plweb:page_title//1.  166
  167
  168plweb:page_title(user(form(register(_User, Kind)))) -->
  169	{ reg_title(Kind, Title) },
  170	html(Title).
  171plweb:page_title(user(mailed(To, permission(_Kind)))) -->
  172	html('Mail sent to ~w'-[To])