├── CHANGELOG.txt ├── LICENSE.TXT ├── Makefile ├── README.txt ├── doc ├── edoc-info ├── erlang.png ├── erlsql.html ├── erltl.html ├── erlydb.html ├── erlydb_base.html ├── erlydb_field.html ├── erlydb_mnesia.html ├── erlydb_mysql.html ├── erlydb_psql.html ├── erlyweb.html ├── erlyweb_forms.html ├── erlyweb_util.html ├── index.html ├── modules-frame.html ├── overview-summary.html ├── overview.edoc ├── packages-frame.html ├── smerl.html ├── stylesheet.css ├── yaws_arg.html └── yaws_headers.html ├── make.bat ├── make.sh ├── make_erlyweb.erl ├── scripts └── create_app.sh ├── src ├── erlang-mysql-driver │ ├── mysql.erl │ ├── mysql.hrl │ ├── mysql_auth.erl │ ├── mysql_conn.erl │ └── mysql_recv.erl ├── erlang-psql-driver │ ├── Emakefile │ ├── psql.app.src │ ├── psql.erl │ ├── psql.hrl │ ├── psql_app.erl │ ├── psql_con_sup.erl │ ├── psql_connection.erl │ ├── psql_lib.erl │ ├── psql_logic.erl │ ├── psql_pool.erl │ ├── psql_protocol.erl │ └── psql_sup.erl ├── erlsql │ └── erlsql.erl ├── erltl │ └── erltl.erl ├── erlydb │ ├── erlydb.erl │ ├── erlydb_base.erl │ ├── erlydb_field.erl │ ├── erlydb_mnesia.erl │ ├── erlydb_mysql.erl │ └── erlydb_psql.erl ├── erlyweb │ ├── erlyweb.erl │ ├── erlyweb_compile.erl │ ├── erlyweb_controller.erl │ ├── erlyweb_forms.erl │ ├── erlyweb_html.et │ ├── erlyweb_util.erl │ ├── erlyweb_view.et │ ├── yaws_arg.erl │ └── yaws_headers.erl ├── lib │ └── mochinum.erl └── smerl │ └── smerl.erl └── test ├── Emakefile ├── erltl ├── album.et └── test_erltl.erl ├── erlydb ├── customer.erl ├── developer.erl ├── employee.erl ├── erlydb.sql ├── erlydb_mnesia_schema.erl ├── erlydb_psql.sql ├── erlydb_test.erl ├── item.erl ├── language.erl ├── musician.erl ├── person.erl ├── project.erl └── store.erl ├── erlyweb └── music.sql ├── make_test.erl └── test.bat /LICENSE.TXT: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/yariv/erlyweb/87bc26d08a428ca69b2ff9b3a929447db4e0490c/LICENSE.TXT -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | all: 2 | sh make.sh 3 | 4 | app: src/erlang-psql-driver/psql.app.src 5 | (cd src/erlang-psql-driver && sed "s|Modules|`ls -x -m *.erl | sed 's|.erl||g' | tr \\\n ' '`|g" `basename $<` > ../../ebin/`basename $< .src`) 6 | 7 | docs: 8 | erl -pa `pwd`/ebin \ 9 | -noshell 10 | -run edoc_run application "'ErlyWeb'" '"."' '[no_packages]' 11 | 12 | install: 13 | 14 | cp -r . `erl -noshell -eval 'io:format(code:lib_dir()).' -s erlang halt`/erlyweb-0.7.3 15 | 16 | clean: 17 | rm ebin/*.beam 18 | 19 | cleanapp: 20 | rm -fv ebin/*.app 21 | 22 | cleandocs: 23 | rm -fv doc/*.html 24 | rm -fv doc/edoc-info 25 | rm -fv doc/*.css -------------------------------------------------------------------------------- /README.txt: -------------------------------------------------------------------------------- 1 | Author: Yariv Sadan (yarivsblog@gmail.com) 2 | Date: 10/27/2006 3 | 4 | ErlyWeb is a web development framework for Erlang. It lets you quickly and easily build database-driven webapps following the MVC pattern. 5 | 6 | 7 | === Installation instructions === 8 | 9 | In the ErlyWeb directory, execute 10 | 11 | ./configure 12 | make 13 | sudo make install 14 | 15 | 16 | This assumes you have yaws installed under your Erlang lib directory (which you can find by calling code:lib_dir() in the Erlang shell). 17 | -------------------------------------------------------------------------------- /doc/edoc-info: -------------------------------------------------------------------------------- 1 | {application,'ErlyWeb'}. 2 | {packages,[]}. 3 | {modules,[erlsql, 4 | erltl, 5 | erlydb, 6 | erlydb_base, 7 | erlydb_field, 8 | erlydb_mnesia, 9 | erlydb_mysql, 10 | erlydb_psql, 11 | erlyweb, 12 | erlyweb_forms, 13 | erlyweb_util, 14 | smerl, 15 | yaws_arg, 16 | yaws_headers]}. 17 | -------------------------------------------------------------------------------- /doc/erlang.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/yariv/erlyweb/87bc26d08a428ca69b2ff9b3a929447db4e0490c/doc/erlang.png -------------------------------------------------------------------------------- /doc/erlsql.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/yariv/erlyweb/87bc26d08a428ca69b2ff9b3a929447db4e0490c/doc/erlsql.html -------------------------------------------------------------------------------- /doc/erltl.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/yariv/erlyweb/87bc26d08a428ca69b2ff9b3a929447db4e0490c/doc/erltl.html -------------------------------------------------------------------------------- /doc/erlydb.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/yariv/erlyweb/87bc26d08a428ca69b2ff9b3a929447db4e0490c/doc/erlydb.html -------------------------------------------------------------------------------- /doc/erlydb_base.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/yariv/erlyweb/87bc26d08a428ca69b2ff9b3a929447db4e0490c/doc/erlydb_base.html -------------------------------------------------------------------------------- /doc/erlydb_field.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/yariv/erlyweb/87bc26d08a428ca69b2ff9b3a929447db4e0490c/doc/erlydb_field.html -------------------------------------------------------------------------------- /doc/erlydb_mnesia.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/yariv/erlyweb/87bc26d08a428ca69b2ff9b3a929447db4e0490c/doc/erlydb_mnesia.html -------------------------------------------------------------------------------- /doc/erlydb_mysql.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/yariv/erlyweb/87bc26d08a428ca69b2ff9b3a929447db4e0490c/doc/erlydb_mysql.html -------------------------------------------------------------------------------- /doc/erlydb_psql.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/yariv/erlyweb/87bc26d08a428ca69b2ff9b3a929447db4e0490c/doc/erlydb_psql.html -------------------------------------------------------------------------------- /doc/erlyweb.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/yariv/erlyweb/87bc26d08a428ca69b2ff9b3a929447db4e0490c/doc/erlyweb.html -------------------------------------------------------------------------------- /doc/erlyweb_forms.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/yariv/erlyweb/87bc26d08a428ca69b2ff9b3a929447db4e0490c/doc/erlyweb_forms.html -------------------------------------------------------------------------------- /doc/erlyweb_util.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/yariv/erlyweb/87bc26d08a428ca69b2ff9b3a929447db4e0490c/doc/erlyweb_util.html -------------------------------------------------------------------------------- /doc/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | The ErlyWeb application 5 | 6 | 7 | 8 | 9 | 10 | 11 | <h2>This page uses frames</h2> 12 | <p>Your browser does not accept frames. 13 | <br>You should go to the <a href="overview-summary.html">non-frame version</a> instead. 14 | </p> 15 | 16 | 17 | -------------------------------------------------------------------------------- /doc/modules-frame.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | The ErlyWeb application 5 | 6 | 7 | 8 |

Modules

9 |
erlsql
erltl
erlydb
erlydb_base
erlydb_field
erlydb_mnesia
erlydb_mysql
erlydb_psql
erlyweb
erlyweb_forms
erlyweb_util
smerl
yaws_arg
yaws_headers
10 | 11 | -------------------------------------------------------------------------------- /doc/overview-summary.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/yariv/erlyweb/87bc26d08a428ca69b2ff9b3a929447db4e0490c/doc/overview-summary.html -------------------------------------------------------------------------------- /doc/packages-frame.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | The ErlyWeb application 5 | 6 | 7 | 8 |

Packages

9 | 10 | 11 | -------------------------------------------------------------------------------- /doc/smerl.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/yariv/erlyweb/87bc26d08a428ca69b2ff9b3a929447db4e0490c/doc/smerl.html -------------------------------------------------------------------------------- /doc/stylesheet.css: -------------------------------------------------------------------------------- 1 | body { font-family: Verdana, Arial, Helvetica, sans-serif; 2 | margin-left: .25in; 3 | margin-right: .2in; 4 | margin-top: 0.2in; 5 | margin-bottom: 0.2in; 6 | color: #000000; 7 | background-color: #ffffff } 8 | h1,h2 { margin-left: -0.2in } 9 | -------------------------------------------------------------------------------- /doc/yaws_arg.html: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/yariv/erlyweb/87bc26d08a428ca69b2ff9b3a929447db4e0490c/doc/yaws_arg.html -------------------------------------------------------------------------------- /doc/yaws_headers.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | Module yaws_headers 5 | 6 | 7 | 8 | 9 |

Module yaws_headers

10 | This module provides functions for getting and setting 11 | values of the Yaws 'headers' record. 12 | 13 |

Authors: Roberto Saccon (rsaccon@gmail.com).

14 | 15 |

Description

This module provides functions for getting and setting 16 | values of the Yaws 'headers' record. You can use these functions 17 | instead of using the record access syntax, and without 18 | having to include yaws_api.hrl.

19 | 20 | As with yaws_arg, most functions have 2 variations: if it takes 21 | 1 parameter, it returns the record's value for the field, and if it 22 | takes two parameters, it returns a new record with the field having the 23 | new value. 24 |

Function Index

25 |
26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 |
accept/1
accept/2
accept_ranges/1
accept_ranges/2
authorization/1
authorization/2
connection/1
connection/2
content_length/1
content_length/2
content_type/1
content_type/2
cookie/1
cookie/2
host/1
host/2
if_match/1
if_match/2
if_modified_since/1
if_modified_since/2
if_none_match/1
if_none_match/2
if_range/1
if_range/2
if_unmodified_since/1
if_unmodified_since/2
keep_alive/1
keep_alive/2
new/0Create a new 'headers' record.
other/1
other/2
range/1
range/2
referer/1
referer/2
user_agent/1
user_agent/2
63 | 64 |

Function Details

65 | 66 |

accept/1

67 | accept(Arg) -> term() 68 | 69 | 70 |

accept/2

71 | accept(Arg, Val) -> term() 72 | 73 | 74 |

accept_ranges/1

75 | accept_ranges(Arg) -> term() 76 | 77 | 78 |

accept_ranges/2

79 | accept_ranges(Arg, Val) -> term() 80 | 81 | 82 |

authorization/1

83 | authorization(Arg) -> term() 84 | 85 | 86 |

authorization/2

87 | authorization(Arg, Val) -> term() 88 | 89 | 90 |

connection/1

91 | connection(Arg) -> term() 92 | 93 | 94 |

connection/2

95 | connection(Arg, Val) -> term() 96 | 97 | 98 |

content_length/1

99 | content_length(Arg) -> term() 100 | 101 | 102 |

content_length/2

103 | content_length(Arg, Val) -> term() 104 | 105 | 106 |

content_type/1

107 | content_type(Arg) -> term() 108 | 109 | 110 |

content_type/2

111 | content_type(Arg, Val) -> term() 112 | 113 | 114 |

cookie/1

115 | cookie(Arg) -> term() 116 | 117 | 118 |

cookie/2

119 | cookie(Arg, Val) -> term() 120 | 121 | 122 |

host/1

123 | host(Arg) -> term() 124 | 125 | 126 |

host/2

127 | host(Arg, Val) -> term() 128 | 129 | 130 |

if_match/1

131 | if_match(Arg) -> term() 132 | 133 | 134 |

if_match/2

135 | if_match(Arg, Val) -> term() 136 | 137 | 138 |

if_modified_since/1

139 | if_modified_since(Arg) -> term() 140 | 141 | 142 |

if_modified_since/2

143 | if_modified_since(Arg, Val) -> term() 144 | 145 | 146 |

if_none_match/1

147 | if_none_match(Arg) -> term() 148 | 149 | 150 |

if_none_match/2

151 | if_none_match(Arg, Val) -> term() 152 | 153 | 154 |

if_range/1

155 | if_range(Arg) -> term() 156 | 157 | 158 |

if_range/2

159 | if_range(Arg, Val) -> term() 160 | 161 | 162 |

if_unmodified_since/1

163 | if_unmodified_since(Arg) -> term() 164 | 165 | 166 |

if_unmodified_since/2

167 | if_unmodified_since(Arg, Val) -> term() 168 | 169 | 170 |

keep_alive/1

171 | keep_alive(Arg) -> term() 172 | 173 | 174 |

keep_alive/2

175 | keep_alive(Arg, Val) -> term() 176 | 177 | 178 |

new/0

179 | new() -> term() 180 |

Create a new 'headers' record.

181 | 182 |

other/1

183 | other(Arg) -> term() 184 | 185 | 186 |

other/2

187 | other(Arg, Val) -> term() 188 | 189 | 190 |

range/1

191 | range(Arg) -> term() 192 | 193 | 194 |

range/2

195 | range(Arg, Val) -> term() 196 | 197 | 198 |

referer/1

199 | referer(Arg) -> term() 200 | 201 | 202 |

referer/2

203 | referer(Arg, Val) -> term() 204 | 205 | 206 |

user_agent/1

207 | user_agent(Arg) -> term() 208 | 209 | 210 |

user_agent/2

211 | user_agent(Arg, Val) -> term() 212 | 213 | 214 | 215 | -------------------------------------------------------------------------------- /make.bat: -------------------------------------------------------------------------------- 1 | erlc make_erlyweb.erl 2 | erl -noshell -run make_erlyweb -pa ebin -run erlang halt -------------------------------------------------------------------------------- /make.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | ERLIB=$(erl -noshell -eval 'io:format(code:lib_dir()).' -s erlang halt) 4 | YAWS=$(ls $ERLIB | grep yaws) 5 | 6 | cat >Emakefile < erltl:compile(F, [{outdir, "ebin"}, debug_info, show_errors, show_warnings]) end, []).' -pa ebin -s erlang halt -------------------------------------------------------------------------------- /make_erlyweb.erl: -------------------------------------------------------------------------------- 1 | -module(make_erlyweb). 2 | -export([start/0]). 3 | 4 | start() -> 5 | make:all(), 6 | filelib:fold_files("src/", 7 | ".+\.et$", 8 | true, 9 | fun(F, _Acc) -> 10 | erltl:compile(F, 11 | [{outdir, "ebin"}, 12 | debug_info, 13 | show_errors, 14 | show_warnings]) 15 | end, 16 | []). 17 | -------------------------------------------------------------------------------- /scripts/create_app.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | erl -noshell -eval "erlyweb:create_app(\"$1\", \"$2\")" \ 4 | -s erlang halt 5 | -------------------------------------------------------------------------------- /src/erlang-mysql-driver/mysql.erl: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/yariv/erlyweb/87bc26d08a428ca69b2ff9b3a929447db4e0490c/src/erlang-mysql-driver/mysql.erl -------------------------------------------------------------------------------- /src/erlang-mysql-driver/mysql.hrl: -------------------------------------------------------------------------------- 1 | %% MySQL result record: 2 | -record(mysql_result, 3 | {fieldinfo=[], 4 | rows=[], 5 | affectedrows=0, 6 | error=""}). 7 | -------------------------------------------------------------------------------- /src/erlang-mysql-driver/mysql_auth.erl: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/yariv/erlyweb/87bc26d08a428ca69b2ff9b3a929447db4e0490c/src/erlang-mysql-driver/mysql_auth.erl -------------------------------------------------------------------------------- /src/erlang-mysql-driver/mysql_conn.erl: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/yariv/erlyweb/87bc26d08a428ca69b2ff9b3a929447db4e0490c/src/erlang-mysql-driver/mysql_conn.erl -------------------------------------------------------------------------------- /src/erlang-mysql-driver/mysql_recv.erl: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/yariv/erlyweb/87bc26d08a428ca69b2ff9b3a929447db4e0490c/src/erlang-mysql-driver/mysql_recv.erl -------------------------------------------------------------------------------- /src/erlang-psql-driver/Emakefile: -------------------------------------------------------------------------------- 1 | {'*', [{outdir, "../ebin"}, debug_info, strict_record_tests]}. 2 | -------------------------------------------------------------------------------- /src/erlang-psql-driver/psql.app.src: -------------------------------------------------------------------------------- 1 | %% copyright 2006 Reliance Commnication inc 2 | %% author Martin Carlson 3 | %% version $Rev$ 4 | %% psql spec 5 | %%------------------------------------------------------------------- 6 | {application, psql, [{description, "psql $Rev$"}, 7 | {vsn, "0.0.2"}, 8 | {modules, [Modules]}, 9 | {registered, [psql_sup]}, 10 | {applications, [kernel, stdlib]}, 11 | {mod, {psql, []}}, 12 | {env, [{erlydb_psql, {"localhost", 5432, "postgres", "password", "test"}}, 13 | {pools, [{erlydb_psql, 1}]}]}]}. 14 | -------------------------------------------------------------------------------- /src/erlang-psql-driver/psql.erl: -------------------------------------------------------------------------------- 1 | %%%------------------------------------------------------------------- 2 | %%% BASIC INFORMATION 3 | %%%------------------------------------------------------------------- 4 | %%% @copyright 2006 Erlang Training & Consulting Ltd 5 | %%% @author Martin Carlson 6 | %%% @version 0.2.0 7 | %%% @doc Interface module for the PostgreSQL driver 8 | %%% @end 9 | %%%------------------------------------------------------------------- 10 | -module(psql). 11 | -author("support@erlang-consulting.com"). 12 | -copyright("Erlang Training & Consulting Ltd"). 13 | -vsn("$Rev"). 14 | 15 | -behaviour(application). 16 | 17 | %% Application callbacks 18 | -export([start/2, stop/1]). 19 | 20 | %% API 21 | -export([connect/4, 22 | connect/6, 23 | allocate/0, 24 | free/0, 25 | sql_query/2, 26 | parse/4, 27 | bind/4, 28 | describe/3, 29 | execute/3, 30 | execute/4, 31 | close/3, 32 | transaction/1, 33 | commit/1, 34 | rollback/1]). 35 | 36 | -define(REREQUEST_FREQ, 1000). 37 | -define(DEFAULT_PORT, 5432). 38 | 39 | %% Global types 40 | %% @type query() = string(). 41 | %% SQL conformant query with omitted semicolon 42 | %% 43 | %% @type result() = [] | [{Command::binary(), Data::rows()}] | 44 | %% {sql_error, term()} | term(). 45 | %% Query results, rows are represented as tuples and 46 | %% values are converted to the closest erlang type 47 | %% 48 | %% @type rows() = [row()] | []. 49 | %% 50 | %% @type row() = tuple() | binary(). 51 | %% A tuple with one element per column converted to erlang terms 52 | %% if the sql_query is used or if a description is passed to execute 53 | %% else a binary representation for each column 54 | %% 55 | %% @type portal() = string() | []. 56 | %% A string representation of a postgre portal, see postgres documentation 57 | %% 58 | %% @type statement() = string() | []. 59 | %% A string representation of a postgre statement, see postgres documentation 60 | %% 61 | %% @type sql_type() = integer(). 62 | %% A integer representing the OID of the type, see postgres documentation 63 | 64 | 65 | %%==================================================================== 66 | %% Application callbacks 67 | %%==================================================================== 68 | start(normal, []) -> 69 | case psql_sup:start_link() of 70 | {ok, Pid} -> 71 | {ok, Pools} = application:get_env(psql, pools), 72 | F = fun({Pool, _}) -> 73 | {ok, PS} = application:get_env(psql, Pool), 74 | psql_con_sup:start_connection({Pool, PS}) 75 | end, 76 | lists:foreach(F, Pools), 77 | {ok, Pid}; 78 | Error -> 79 | Error 80 | end. 81 | 82 | stop(_State) -> 83 | ok. 84 | 85 | %%==================================================================== 86 | %% API 87 | %%==================================================================== 88 | %%-------------------------------------------------------------------- 89 | %% @spec connect(Pid::pid(), Host::string(), 90 | %% Usr::string(), Pwd::string()) -> ok 91 | %% @doc Connect to database 92 | %% @end 93 | %%-------------------------------------------------------------------- 94 | connect(Pid, Host, Usr, Pwd) -> 95 | connect(Pid, Host, ?DEFAULT_PORT, Usr, Pwd, Usr). 96 | 97 | %%-------------------------------------------------------------------- 98 | %% @spec connect(Pid::pid(), Host::string(), Port::integer(), 99 | %% Usr::string(), Pwd::string(), DB::string) -> ok 100 | %% @doc Connect to database 101 | %% @end 102 | %%-------------------------------------------------------------------- 103 | connect(Pid, Host, Port, Usr, Pwd, DB) -> 104 | psql_logic:command(Pid, {connect, self(), Host, Port, Usr, Pwd, DB}), 105 | receive 106 | ready_for_query -> 107 | ok; 108 | Error -> 109 | Error 110 | end. 111 | 112 | %%-------------------------------------------------------------------- 113 | %% @spec allocate() -> pid() 114 | %% @doc Allocate a connection from the pool 115 | %% @end 116 | %%-------------------------------------------------------------------- 117 | allocate() -> 118 | psql_pool:alloc(self()). 119 | 120 | %%-------------------------------------------------------------------- 121 | %% @spec free() -> ok 122 | %% @doc Free a connection back to the pool 123 | %% @end 124 | %%-------------------------------------------------------------------- 125 | free() -> 126 | psql_pool:free(self()). 127 | 128 | %%-------------------------------------------------------------------- 129 | %% @spec sql_query(Pid::pid(), Query::query()) -> result() 130 | %% @doc Simple sql query 131 | %% @end 132 | %%-------------------------------------------------------------------- 133 | sql_query(Pid, Query) -> 134 | psql_logic:command(Pid, {simple_query, self(), Query}), 135 | result([], []). 136 | 137 | %%-------------------------------------------------------------------- 138 | %% @spec parse(Pid::pid(), Name::statement(), 139 | %% Query::query(), Args::[sql_type()]) -> {[],[]} 140 | %% @doc Parse a sql query, can contain placeholders, i.e $N 141 | %% @end 142 | %%-------------------------------------------------------------------- 143 | parse(Pid, Name, Query, Args) -> 144 | psql_logic:command(Pid, {parse, self(), Name, Query, Args}), 145 | result([], []). 146 | 147 | %%-------------------------------------------------------------------- 148 | %% @spec bind(Pid::pid(), Portal::portal(), 149 | %% Statement::statement(), Args::[string()]) -> {[], []} 150 | %% @doc Bind variables to placeholders. Variables must be strings 151 | %% @end 152 | %%-------------------------------------------------------------------- 153 | bind(Pid, Portal, Statement, Args) -> 154 | psql_logic:command(Pid, {bind, self(), Portal, Statement, Args}), 155 | result([], []). 156 | 157 | %%-------------------------------------------------------------------- 158 | %% @spec describe(Pid, Type::statement|portal, 159 | %% Name::statement()|portal()) -> result() 160 | %% @doc Describes a resultset from a statement or a portal. 161 | %% @end 162 | %%-------------------------------------------------------------------- 163 | describe(Pid, Type, Name) -> 164 | psql_logic:command(Pid, {describe, self(), Type, Name}), 165 | result([], []). 166 | 167 | %%-------------------------------------------------------------------- 168 | %% @spec execute(Pid::pid(), Portal::portal(), Size::integer()) -> result() 169 | %% @doc Execute a portal returns at most Size rows 170 | %% @end 171 | %%-------------------------------------------------------------------- 172 | execute(Pid, Portal, Size) -> 173 | psql_logic:command(Pid, {execute, self(), Portal, Size}), 174 | result([], []). 175 | 176 | %%-------------------------------------------------------------------- 177 | %% @spec execute(Pid::pid(), Portal::portal(), 178 | %% Size::integer(), Description::term()) -> 179 | %% result() 180 | %% @doc Execute a portal returns at most Size rows converted to erlang terms. 181 | %% @end 182 | %%-------------------------------------------------------------------- 183 | execute(Pid, Portal, Size, Desc) -> 184 | psql_logic:command(Pid, {execute, self(), Portal, Size}), 185 | result(Desc, []). 186 | 187 | %%-------------------------------------------------------------------- 188 | %% @spec close(Pid, Type::statement|portal, Name::portal()|statement()) -> 189 | %% result() 190 | %% @doc Closes a statement or portal 191 | %% @end 192 | %%-------------------------------------------------------------------- 193 | close(Pid, Type, Name) -> 194 | psql_logic:command(Pid, {close, self(), Type, Name}), 195 | result([], []). 196 | 197 | %%-------------------------------------------------------------------- 198 | %% @spec transaction(Pid::pid()) -> result() 199 | %% @doc Starts a transaction 200 | %% @end 201 | %%-------------------------------------------------------------------- 202 | transaction(Pid) -> 203 | sql_query(Pid, "BEGIN"). 204 | 205 | %%-------------------------------------------------------------------- 206 | %% @spec commit(Pid::pid()) -> result() 207 | %% @doc Commits a transaction 208 | %% @end 209 | %%-------------------------------------------------------------------- 210 | commit(Pid) -> 211 | sql_query(Pid, "COMMIT"). 212 | 213 | %%-------------------------------------------------------------------- 214 | %% @spec rollback(Pid::pid()) -> result() 215 | %% @doc Roll back a transaction 216 | %% @end 217 | %%-------------------------------------------------------------------- 218 | rollback(Pid) -> 219 | sql_query(Pid, "ROLLBACK"). 220 | 221 | %%==================================================================== 222 | %% Internal functions 223 | %%==================================================================== 224 | collect_result(Desc, Acc) -> 225 | handle_result(receive_loop(infinite), Desc, Acc). 226 | 227 | 228 | handle_result({row_description, Data}, _Desc, Acc) -> 229 | collect_result(psql_lib:row_description(Data), Acc); 230 | handle_result({command_complete, Command, []}, Desc, Acc) -> 231 | collect_result(Desc, [{Command, []}|Acc]); 232 | handle_result({command_complete, Command, Rows}, Desc, Acc) when Desc /= [] -> 233 | collect_result(Desc, [{Command, [psql_lib:row(Row, Desc) || Row <- Rows]}|Acc]); 234 | handle_result({command_complete, Command, Rows}, Desc, Acc) -> 235 | collect_result(Desc, [{Command, Rows}|Acc]); 236 | handle_result({sql_error, Error}, _Desc, _Acc) -> 237 | psql_lib:error(Error); 238 | handle_result(parse_complete, Desc, Acc) -> 239 | collect_result(Desc, Acc); 240 | handle_result(bind_complete, Desc, Acc) -> 241 | collect_result(Desc, Acc); 242 | handle_result(fetch_more, Desc, Acc) -> 243 | {Desc, Acc}; %% TODO: Handle this differently 244 | handle_result(ready_for_query, Desc, Acc) -> 245 | case receive_loop(5) of %% TODO: Clean this up 246 | timeout -> 247 | {Desc, Acc}; 248 | Msg -> 249 | handle_result(Msg, Desc, Acc) 250 | end. 251 | 252 | 253 | result(Desc, Acc) -> 254 | case collect_result(Desc, Acc) of 255 | {[], Result} -> 256 | Result; 257 | {Result, []} -> 258 | Result; 259 | Result -> 260 | Result 261 | end. 262 | 263 | receive_loop(infinite) -> 264 | receive 265 | {psql_server,Msg} -> Msg 266 | end; 267 | receive_loop(Timeout) -> 268 | receive 269 | {psql_server,Msg} -> Msg 270 | after 271 | Timeout -> timeout 272 | end. 273 | 274 | -------------------------------------------------------------------------------- /src/erlang-psql-driver/psql.hrl: -------------------------------------------------------------------------------- 1 | %%%------------------------------------------------------------------- 2 | %%% BASIC INFORMATION 3 | %%%------------------------------------------------------------------- 4 | %%% @copyright 2006 Erlang Training & Consulting Ltd 5 | %%% @author Martin Carlson 6 | %%% @version 0.0.1 7 | %%% @doc 8 | %%% @end 9 | %%%------------------------------------------------------------------- 10 | -record(field, {name, 11 | table_code, 12 | field_code, 13 | type, 14 | max_length, 15 | format}). 16 | 17 | -define(SQL_BOOLEAN, 16). 18 | -define(SQL_BINARY, 17). 19 | -define(SQL_CHAR, 18). 20 | -define(SQL_BIGINT, 20). 21 | -define(SQL_SMALLINT, 21). 22 | -define(SQL_INT, 23). 23 | -define(SQL_TEXT, 25). 24 | -define(SQL_OID, 26). 25 | -define(SQL_INET, 896). 26 | -define(SQL_INTARRAY, 1007). 27 | -define(SQL_CHARARRAY, 1014). 28 | -define(SQL_VARCHARARRAY, 1015). 29 | -define(SQL_VARCHAR, 1043). 30 | -define(SQL_DATE, 1082). 31 | -define(SQL_TIME, 1083). 32 | -define(SQL_DATETIME, 1114). 33 | -define(SQL_TIMESTAMP, 1184). 34 | -define(SQL_FLOAT, 1700). 35 | 36 | -------------------------------------------------------------------------------- /src/erlang-psql-driver/psql_app.erl: -------------------------------------------------------------------------------- 1 | %%%------------------------------------------------------------------- 2 | %%% BASIC INFORMATION 3 | %%%------------------------------------------------------------------- 4 | %%% @copyright 2006 Erlang Training & Consulting Ltd 5 | %%% @author Martin Carlson 6 | %%% @version 0.0.1 7 | %%% @doc 8 | %%% @end 9 | %%%------------------------------------------------------------------- 10 | -module(psql_app). 11 | 12 | -behaviour(application). 13 | 14 | %% Application callbacks 15 | -export([start/2, stop/1]). 16 | 17 | %%==================================================================== 18 | %% Application callbacks 19 | %%==================================================================== 20 | %%-------------------------------------------------------------------- 21 | %% Function: start(Type, StartArgs) -> {ok, Pid} | 22 | %% {ok, Pid, State} | 23 | %% {error, Reason} 24 | %% Description: This function is called whenever an application 25 | %% is started using application:start/1,2, and should start the processes 26 | %% of the application. If the application is structured according to the 27 | %% OTP design principles as a supervision tree, this means starting the 28 | %% top supervisor of the tree. 29 | %%-------------------------------------------------------------------- 30 | start(normal, []) -> 31 | psql_sup:start_link(). 32 | 33 | %%-------------------------------------------------------------------- 34 | %% Function: stop(State) -> void() 35 | %% Description: This function is called whenever an application 36 | %% has stopped. It is intended to be the opposite of Module:start/2 and 37 | %% should do any necessary cleaning up. The return value is ignored. 38 | %%-------------------------------------------------------------------- 39 | stop(_State) -> 40 | ok. 41 | 42 | %%==================================================================== 43 | %% Internal functions 44 | %%==================================================================== 45 | -------------------------------------------------------------------------------- /src/erlang-psql-driver/psql_con_sup.erl: -------------------------------------------------------------------------------- 1 | %%%------------------------------------------------------------------- 2 | %%% BASIC INFORMATION 3 | %%%------------------------------------------------------------------- 4 | %%% @copyright 2006 Erlang Training & Consulting Ltd 5 | %%% @author Martin Carlson 6 | %%% @version 0.0.1 7 | %%% @doc 8 | %%% @end 9 | %%%------------------------------------------------------------------- 10 | -module(psql_con_sup). 11 | 12 | -behaviour(supervisor). 13 | 14 | %% API 15 | -export([start_link/0, start_connection/0, start_connection/1]). 16 | 17 | %% Supervisor callbacks 18 | -export([init/1]). 19 | 20 | -define(SERVER, ?MODULE). 21 | 22 | %%==================================================================== 23 | %% API functions 24 | %%==================================================================== 25 | %%-------------------------------------------------------------------- 26 | %% Function: start_link() -> {ok,Pid} | ignore | {error,Error} 27 | %% Description: Starts the supervisor 28 | %%-------------------------------------------------------------------- 29 | start_link() -> 30 | supervisor:start_link({local, ?SERVER}, ?MODULE, []). 31 | 32 | start_connection() -> 33 | supervisor:start_child(?SERVER, []). 34 | 35 | start_connection(PoolSpec) -> 36 | supervisor:start_child(?SERVER, [PoolSpec]). 37 | 38 | 39 | %%==================================================================== 40 | %% Supervisor callbacks 41 | %%==================================================================== 42 | %%-------------------------------------------------------------------- 43 | %% Func: init(Args) -> {ok, {SupFlags, [ChildSpec]}} | 44 | %% ignore | 45 | %% {error, Reason} 46 | %% Description: Whenever a supervisor is started using 47 | %% supervisor:start_link/[2,3], this function is called by the new process 48 | %% to find out about restart strategy, maximum restart frequency and child 49 | %% specifications. 50 | %%-------------------------------------------------------------------- 51 | init([]) -> 52 | Logic = {psql_logic, {psql_logic, start_link, []}, 53 | permanent, 2000, worker, [psql_logic]}, 54 | {ok, {{simple_one_for_one, 10, 60}, [Logic]}}. 55 | 56 | %%==================================================================== 57 | %% Internal functions 58 | %%==================================================================== 59 | 60 | -------------------------------------------------------------------------------- /src/erlang-psql-driver/psql_connection.erl: -------------------------------------------------------------------------------- 1 | %%%------------------------------------------------------------------- 2 | %%% BASIC INFORMATION 3 | %%%------------------------------------------------------------------- 4 | %%% @copyright 2006 Erlang Training & Consulting Ltd 5 | %%% @author Martin Carlson 6 | %%% @version 0.0.1 7 | %%% @doc 8 | %%% @end 9 | %%%------------------------------------------------------------------- 10 | -module(psql_connection). 11 | 12 | %% API 13 | -export([start_link/1, command/2, sync/1]). 14 | 15 | %% Internal Import 16 | -export([init/2]). 17 | 18 | %% System exports 19 | -export([system_continue/3, 20 | system_terminate/4, 21 | system_code_change/4, 22 | print_event/3]). 23 | 24 | -record(state, {parent, 25 | debug, 26 | logic, 27 | host = undefined, 28 | port, 29 | socket = undefined, 30 | buffer = []}). 31 | 32 | -define(TCP_OPTIONS, [binary, {active, true}, {packet, 0}]). 33 | -define(RECONNECT_TIMEOUT, 1000). 34 | 35 | %%==================================================================== 36 | %% API 37 | %%==================================================================== 38 | start_link(Logic) -> 39 | proc_lib:start_link(?MODULE, init, [self(), Logic]). 40 | 41 | command(Pid, Data) -> 42 | Pid ! {logic, self(), Data}, 43 | ok. 44 | 45 | sync(Pid) -> 46 | Pid ! {logic, self(), {send, psql_protocol:sync()}}, 47 | ok. 48 | 49 | %%==================================================================== 50 | %% Server 51 | %%==================================================================== 52 | init(Parent, Logic) -> 53 | Debug = sys:debug_options([]), 54 | proc_lib:init_ack(Parent, {ok, self()}), 55 | loop(#state{parent = Parent, debug = Debug, logic = Logic}). 56 | 57 | %% 58 | %% This make sure we get into a reconnect loop if the connection goes down 59 | %% by setting the socket to 'undefined' 60 | %% 61 | loop(State) when State#state.socket == undefined, State#state.host /= undefined -> 62 | case gen_tcp:connect(State#state.host, State#state.port, ?TCP_OPTIONS) of 63 | {ok, Socket} -> 64 | psql_logic:connection_event(State#state.logic, 65 | {psql, connection_established, []}), 66 | loop(State#state{socket = Socket}); 67 | {error, Reason} -> 68 | error_logger:error_report({connection_failed, Reason}), 69 | receive 70 | Message -> 71 | handle_receive(Message, State) 72 | after 73 | ?RECONNECT_TIMEOUT -> 74 | loop(State) 75 | end 76 | end; 77 | loop(State) -> 78 | receive 79 | Message -> 80 | handle_receive(Message, State) 81 | end. 82 | 83 | %%==================================================================== 84 | %% Receive Handling 85 | %%==================================================================== 86 | handle_receive({system, From, Req}, State) -> 87 | sys:handle_system_msg(Req, From, State#state.parent, 88 | ?MODULE, State#state.debug, State); 89 | handle_receive({logic, From, Data}, State) when From == State#state.logic -> 90 | DState = handle_debug({logic, Data, State}, State), 91 | case handle_message(Data, DState) of 92 | {ok, NewState} -> 93 | loop(NewState); 94 | {stop, _State} -> 95 | ok 96 | end; 97 | handle_receive({tcp, Socket, Data}, State) when Socket == State#state.socket -> 98 | DState = handle_debug({socket, Data, State}, State), 99 | {ok, NewState} = handle_message(Data, DState), 100 | loop(NewState); 101 | handle_receive({tcp_closed, Socket}, State) when Socket == State#state.socket -> 102 | DState = handle_debug({tcp_closed, Socket, State}, State), 103 | psql_logic:connection_closed(State#state.logic), 104 | loop(DState#state{socket = undefined}); 105 | handle_receive(Message, State) -> 106 | loop(handle_debug({unknown_message, Message, State}, State)). 107 | 108 | %%==================================================================== 109 | %% Message Handling 110 | %%==================================================================== 111 | handle_message({connect, Host, Port}, State) -> 112 | {ok, State#state{host = Host, port = Port}}; 113 | handle_message(disconnect, State) -> 114 | gen_tcp:close(State#state.socket), 115 | {ok, State#state{socket = undefined, host = undefined, port = undefined}}; 116 | handle_message(shutdown, State) -> 117 | gen_tcp:close(State#state.socket), 118 | {stop, State}; 119 | handle_message({send, Message}, State) -> 120 | Data = psql_protocol:encode(Message), 121 | case gen_tcp:send(State#state.socket, Data) of 122 | ok -> 123 | {ok, State}; 124 | {error, Reason} -> 125 | psql_logic:connection_event(State#state.logic, {error, Reason}), 126 | gen_tcp:close(State#state.socket), 127 | {ok, State#state{socket = undefined}} 128 | end; 129 | handle_message({send, Type, Message}, State) -> 130 | Data = psql_protocol:encode(Type, Message), 131 | case gen_tcp:send(State#state.socket, Data) of 132 | ok -> 133 | {ok, State}; 134 | {error, Reason} -> 135 | psql_logic:connection_event(State#state.logic, {error, Reason}), 136 | gen_tcp:close(State#state.socket), 137 | {ok, State#state{socket = undefined}} 138 | end; 139 | handle_message(Fragment, State) -> 140 | if 141 | State#state.buffer == []; State#state.buffer == <<>> -> 142 | Msg = Fragment; 143 | true -> 144 | Msg = <<(State#state.buffer)/binary, Fragment/binary>> 145 | end, 146 | case dispatch_messages(State#state.logic, psql_protocol:decode(Msg)) of 147 | {fragment, Tail} -> 148 | {ok, State#state{buffer = Tail}}; 149 | done -> 150 | {ok, State#state{buffer = <<>>}} 151 | end. 152 | 153 | %%==================================================================== 154 | %% System Callbacks 155 | %%==================================================================== 156 | system_continue(Parent, Debug, State) -> 157 | loop(State#state{parent = Parent, debug = Debug}). 158 | 159 | system_terminate(Reason, _Parent, _Debug, _State) -> 160 | exit(Reason). 161 | 162 | system_code_change(State, _Module, _OldVsn, _Extra) -> 163 | {ok, State}. 164 | 165 | %%==================================================================== 166 | %% Debug Callbacks 167 | %%==================================================================== 168 | print_event(Dev, Event, []) -> 169 | io:format(Dev, "*DBG* ~p dbg ~p~n", [self(), Event]); 170 | print_event(Dev, Event, Name) -> 171 | io:format(Dev, "*DBG* ~p dbg ~p~n", [Name, Event]). 172 | 173 | 174 | 175 | %%==================================================================== 176 | %% Internal functions 177 | %%==================================================================== 178 | handle_debug(Data, State) -> 179 | Debug = sys:handle_debug(State#state.debug, 180 | {?MODULE, print_event}, [], 181 | Data), 182 | State#state{debug = Debug}. 183 | 184 | dispatch_messages(_Logic, {next, Fragment}) -> 185 | {fragment, Fragment}; 186 | dispatch_messages(Logic, {{Type, Data}, <<>>}) -> 187 | psql_logic:connection_event(Logic, {psql, Type, Data}), 188 | done; 189 | dispatch_messages(Logic, {{Type, Data}, Tail}) -> 190 | psql_logic:connection_event(Logic, {psql, Type, Data}), 191 | dispatch_messages(Logic, psql_protocol:decode(Tail)). 192 | 193 | -------------------------------------------------------------------------------- /src/erlang-psql-driver/psql_lib.erl: -------------------------------------------------------------------------------- 1 | %%%------------------------------------------------------------------- 2 | %%% BASIC INFORMATION 3 | %%%------------------------------------------------------------------- 4 | %%% @copyright 2006 Erlang Training & Consulting Ltd 5 | %%% @author Martin Carlson 6 | %%% @version 0.0.1 7 | %%% @doc 8 | %%% @end 9 | %%%------------------------------------------------------------------- 10 | -module(psql_lib). 11 | 12 | %% API 13 | -export([type_cast/2, row_description/1, row/2, error/1, command/1]). 14 | 15 | -include("psql.hrl"). 16 | 17 | %%==================================================================== 18 | %% API 19 | %%==================================================================== 20 | type_cast(SqlValue, Desc) when Desc#field.type == binary -> 21 | SqlValue; 22 | type_cast(SqlValue, Desc) when Desc#field.type == list -> 23 | binary_to_list(SqlValue); 24 | type_cast(SqlValue, Desc) when Desc#field.type == string -> 25 | binary_to_list(SqlValue); 26 | type_cast(SqlValue, Desc) when Desc#field.type == int -> 27 | List = binary_to_list(SqlValue), 28 | case catch list_to_integer(List) of 29 | {'EXIT', _Reason} -> list_to_float(List); 30 | Res -> Res 31 | end; 32 | type_cast(SqlValue, Desc) when Desc#field.type == float -> 33 | List = binary_to_list(SqlValue), 34 | case catch list_to_float(List) of 35 | {'EXIT', _Reason} ->list_to_integer(List); 36 | Res -> Res 37 | end; 38 | type_cast(SqlValue, Desc) when Desc#field.type == bool -> 39 | if 40 | SqlValue == <<"f">> -> false; 41 | true -> true 42 | end; 43 | type_cast(SqlValue, Desc) when Desc#field.type == date -> 44 | List = binary_to_list(SqlValue), 45 | [Yr,Mh,Dy] = string:tokens(List, "-"), 46 | {list_to_integer(Yr), 47 | list_to_integer(Mh), 48 | list_to_integer(Dy)}; 49 | type_cast(SqlValue, Desc) when Desc#field.type == time -> 50 | List = binary_to_list(SqlValue), 51 | [Hr,Mt,Sd] = string:tokens(List, "-: "), 52 | {list_to_integer(Hr), 53 | list_to_integer(Mt), 54 | case lists:member($., Sd) of 55 | false -> list_to_integer(Sd); 56 | true -> list_to_integer(hd(string:tokens(Sd, "."))) 57 | end}; 58 | type_cast(SqlValue, Desc) when Desc#field.type == datetime -> 59 | List = binary_to_list(SqlValue), 60 | [Yr,Mh,Dy,Hr,Mt,Sd] = string:tokens(List, "-: "), 61 | {{list_to_integer(Yr), 62 | list_to_integer(Mh), 63 | list_to_integer(Dy)}, 64 | {list_to_integer(Hr), 65 | list_to_integer(Mt), 66 | case lists:member($., Sd) of 67 | false -> list_to_integer(Sd); 68 | true -> list_to_integer(hd(string:tokens(Sd, "."))) 69 | end}}; 70 | type_cast(SqlValue, #field{type = T}) when T == char_array; T == varchar_array -> 71 | List = binary_to_list(SqlValue), 72 | Values = string:substr(List, 2, length(List) - 2), 73 | Tokens = string:tokens(Values, ","), 74 | F = fun([$"|Rest] = String) -> 75 | case lists:reverse(Rest) of 76 | [$"|RRest] -> 77 | lists:reverse(RRest); 78 | _Otherwise -> 79 | String 80 | end; 81 | (String) -> 82 | String 83 | end, 84 | list_to_tuple(lists:map(F, Tokens)); 85 | type_cast(SqlValue, Desc) when Desc#field.type == integer_array -> 86 | List = binary_to_list(SqlValue), 87 | {_, Tokens, _} = erl_scan:string(List ++ "."), 88 | {ok, Res} = erl_parse:parse_term(Tokens), 89 | Res; 90 | type_cast(SqlValue, Desc) -> 91 | Res = binary_to_list(SqlValue), 92 | io:format("SQL: Unknown code: ~p (~p)", [Desc#field.type, Res]), 93 | Res. 94 | 95 | %% 96 | %% Row description 97 | %% 98 | row_description(<<_:1/big-unit:16, Fields/binary>>) -> 99 | list_to_tuple(field_desc_parser(Fields, [])). 100 | 101 | field_desc_parser(<<>>, Acc) -> 102 | lists:reverse(Acc); 103 | field_desc_parser(Fields, Acc) -> 104 | {Name, <>} = field_name_parser(Fields, []), 111 | Field = #field{name = Name, 112 | table_code = Table, 113 | field_code = Col, 114 | type = psql_protocol:data_type(Type), 115 | max_length = Size, 116 | format = Format}, 117 | field_desc_parser(Tail, [Field|Acc]). 118 | 119 | field_name_parser(<<0, Tail/binary>>, Acc) -> 120 | {lists:reverse(Acc), Tail}; 121 | field_name_parser(<>, Acc) -> 122 | field_name_parser(Tail, [C|Acc]). 123 | 124 | 125 | %% 126 | %% Row Parser 127 | %% 128 | row(<<_:1/big-signed-unit:16, Cols/binary>>, Desc) -> 129 | col_parser(Cols, Desc, 1, []); 130 | row(_, no_result) -> 131 | no_result. 132 | 133 | col_parser(<<>>, _, _, Acc) -> 134 | list_to_tuple(lists:reverse(Acc)); 135 | col_parser(<>, Desc, N, Acc) -> 136 | if 137 | Length == -1 -> 138 | Value = [], 139 | Tail = Rest; 140 | Length > size(Rest) -> 141 | Value = [], 142 | Tail = Rest, 143 | erlang:error({badarg, Length, N, Rest}); 144 | true -> 145 | <> = Rest, 146 | Value = psql_lib:type_cast(SQLValue, element(N, Desc)) 147 | end, 148 | col_parser(Tail, Desc, N + 1, [Value|Acc]). 149 | 150 | %% 151 | %% Error parsing (This should be moved here) 152 | %% 153 | error(Error) -> 154 | psql_protocol:error(Error). 155 | 156 | %% 157 | %% Parse command 158 | %% 159 | command(Command) -> 160 | Command. 161 | 162 | %%==================================================================== 163 | %% Internal functions 164 | %%==================================================================== 165 | -------------------------------------------------------------------------------- /src/erlang-psql-driver/psql_logic.erl: -------------------------------------------------------------------------------- 1 | %%-------------------------------------------------------------------- 2 | %%% @copyright (C) 2006, Erlang Traingin & Consulting, Inc. 3 | %%% @version 0.2.0 4 | %%% @author 5 | %%% @doc 6 | %%% @end 7 | %%-------------------------------------------------------------------- 8 | -module(psql_logic). 9 | -author("support@erlang-consulting.com"). 10 | -copyright("2006 (C) Erlang Trining & Consulting Ltd."). 11 | -vsn("$Rev$"). 12 | 13 | %% API 14 | -export([start_link/0, start_link/1, command/2]). 15 | -export([connection_event/2, connection_closed/1]). 16 | -export([init/1, system_continue/3, system_terminate/4, system_code_change/4]). 17 | 18 | -record(state, {connection, 19 | host, 20 | port, 21 | user, 22 | password, 23 | database, 24 | connected = false, 25 | tx_level = 0}). 26 | 27 | -define(PROTOCOL_VERSION, 196608). 28 | 29 | %%==================================================================== 30 | %% API 31 | %%==================================================================== 32 | %%-------------------------------------------------------------------- 33 | %% @spec start_link() -> {ok, pid()} | {error, term()} 34 | %% @doc Start the special process 35 | %% @end 36 | %%-------------------------------------------------------------------- 37 | start_link() -> 38 | proc_lib:start_link(?MODULE, init, [self()]). 39 | 40 | %%-------------------------------------------------------------------- 41 | %% @spec start_link(Pool::atom()) -> {ok, pid()} | {error, term()} 42 | %% @doc Start the special process and connect to `Pool' 43 | %% @end 44 | %%-------------------------------------------------------------------- 45 | start_link({_PoolName, {Host, Port, Usr, Pwd, Db}}) -> 46 | {ok, Pid} = proc_lib:start_link(?MODULE, init, [self()]), 47 | command(Pid, {connect, self(), Host, Port, Usr, Pwd, Db}), 48 | receive 49 | {psql_server,ready_for_query} -> 50 | {ok, Pid} 51 | end. 52 | 53 | 54 | %%-------------------------------------------------------------------- 55 | %% @spec command(Logic::pid(), Command::term()) -> ok 56 | %% @doc send a command to the logic process 57 | %% @end 58 | %%-------------------------------------------------------------------- 59 | command(Logic, Command) -> 60 | Logic ! Command, 61 | ok. 62 | 63 | %%-------------------------------------------------------------------- 64 | %% @spec init(Parent) -> exit() 65 | %% @doc Start the special process 66 | %% @end 67 | %%-------------------------------------------------------------------- 68 | init(Parent) -> 69 | Debug = sys:debug_options([]), 70 | {ok, Connection} = psql_connection:start_link(self()), 71 | psql_pool:register(self()), 72 | proc_lib:init_ack(Parent, {ok, self()}), 73 | loop(Parent, Debug, #state{connection = Connection}). 74 | 75 | %%-------------------------------------------------------------------- 76 | %% @spec loop(Parent::term(), Debug::term(), State::#state{}) -> exit() 77 | %% @doc Server Loop 78 | %% @end 79 | %%-------------------------------------------------------------------- 80 | loop(Parent, Debug, State) -> 81 | receive 82 | {system, From, Req} -> 83 | sys:handle_system_msg(Req, From, Parent, ?MODULE, Debug, State); 84 | {get_modules, From} = Msg -> 85 | Debug2 = sys:handle_debug(Debug, fun write_debug/3, State, Msg), 86 | reply(From, {modules, [?MODULE]}), 87 | loop(Parent, Debug2, State); 88 | {'EXIT', Parent, Reason} -> 89 | exit(Reason); 90 | {psql, connection_closed, _} = Msg -> %% Connection drops 91 | Debug2 = sys:handle_debug(Debug, fun write_debug/3, State, Msg), 92 | loop(Parent, Debug2, State#state{connected = false}); 93 | {psql, connection_established, _} = Msg -> %% Reconnections 94 | Debug2 = sys:handle_debug(Debug, fun write_debug/3, State, Msg), 95 | State0 = authenticate(self(), State), 96 | loop(Parent, Debug2, State0); 97 | {connect, From, Host, Port, Usr, Pwd, DB} = Msg 98 | when State#state.connected == false -> 99 | Debug2 = sys:handle_debug(Debug, fun write_debug/3, State, Msg), 100 | State0 = connect(From, State#state{host = Host, 101 | port = Port, 102 | user = Usr, 103 | password = Pwd, 104 | database = DB}), 105 | loop(Parent, Debug2, State0); 106 | {parse, From, Statement, Query, Types} = Msg 107 | when State#state.connected == true -> 108 | Debug2 = sys:handle_debug(Debug, fun write_debug/3, State, Msg), 109 | State0 = parse(From, Statement, Query, Types, State), 110 | loop(Parent, Debug2, State0); 111 | {bind, From, Portal, Statement, Parameters} = Msg 112 | when State#state.connected == true -> 113 | Debug2 = sys:handle_debug(Debug, fun write_debug/3, State, Msg), 114 | State0 = bind(From, Portal, Statement, Parameters, State), 115 | loop(Parent, Debug2, State0); 116 | {describe, From, Type, Name} = Msg 117 | when State#state.connected == true -> 118 | Debug2 = sys:handle_debug(Debug, fun write_debug/3, State, Msg), 119 | State0 = describe(From, Type, Name, State), 120 | loop(Parent, Debug2, State0); 121 | {execute, From, Name, ResultSet} = Msg 122 | when State#state.connected == true -> 123 | Debug2 = sys:handle_debug(Debug, fun write_debug/3, State, Msg), 124 | State0 = execute(From, Name, ResultSet, State), 125 | loop(Parent, Debug2, State0); 126 | {close, From, Type, Name} = Msg 127 | when State#state.connected == true -> 128 | Debug2 = sys:handle_debug(Debug, fun write_debug/3, State, Msg), 129 | State0 = close(From, Name, Type, State), 130 | loop(Parent, Debug2, State0); 131 | {simple_query, From, Query} = Msg 132 | when State#state.connected == true -> 133 | Debug2 = sys:handle_debug(Debug, fun write_debug/3, State, Msg), 134 | State0 = simple_query(From, Query, State), 135 | loop(Parent, Debug2, State0); 136 | Msg -> 137 | Debug2 = sys:handle_debug(Debug, fun write_debug/3, State, Msg), 138 | loop(Parent, Debug2, State) 139 | end. 140 | 141 | %% =================================================================== 142 | %% States 143 | %% =================================================================== 144 | %% ------------------------------------------------------------------- 145 | %% Connect to the database server 146 | %% ------------------------------------------------------------------- 147 | connect(From, #state{host = Host, port = Port} = State) -> 148 | psql_connection:command(State#state.connection, {connect, Host, Port}), 149 | receive 150 | {psql, connection_established, _} -> 151 | authenticate(From, State); 152 | dissconnect -> 153 | psql_connection:command(State#state.connection, disconnect), 154 | State 155 | end. 156 | 157 | %% ------------------------------------------------------------------- 158 | %% Authenticate with the database server 159 | %% ------------------------------------------------------------------- 160 | authenticate(From, State) -> 161 | {Auth, Digest} = psql_protocol:authenticate(?PROTOCOL_VERSION, 162 | State#state.user, 163 | State#state.password, 164 | State#state.database), 165 | psql_connection:command(State#state.connection, {send, Auth}), 166 | receive 167 | {psql, authentication, <<0,0,0,5, Salt/binary>>} -> 168 | AuthDigest = psql_protocol:md5digest(Digest, Salt), 169 | psql_connection:command(State#state.connection, {send, AuthDigest}), 170 | receive 171 | {psql, authentication, <<0,0,0,0>>} -> 172 | setup(From, State); 173 | {psql, error, Error} -> 174 | reply(From, {sql_error, Error}), 175 | State 176 | end; 177 | {psql, connection_closed, _} -> 178 | reply(From, disconnected), 179 | State; 180 | {psql, error, Error} -> 181 | reply(From, {sql_error, Error}), 182 | State 183 | end. 184 | 185 | %% ------------------------------------------------------------------- 186 | %% Set parameters to match the servers 187 | %% ------------------------------------------------------------------- 188 | setup(From, State) -> 189 | receive 190 | {psql, ready_for_query, _} -> 191 | reply(From, ready_for_query), 192 | State#state{connected = true}; 193 | {psql, error, Error} -> 194 | reply(From, {sql_error, Error}), 195 | State; 196 | _Parameter -> 197 | setup(From, State) % TODO: Parse and set the parameter 198 | end. 199 | 200 | parse(From, Statement, Query, Types, State) -> 201 | QueryMsg = psql_protocol:parse(Statement, Query, Types), 202 | psql_connection:command(State#state.connection, {send, QueryMsg}), 203 | psql_connection:sync(State#state.connection), 204 | receive 205 | {psql, parse_complete, _} -> 206 | reply(From, parse_complete), 207 | receive 208 | {psql, ready_for_query, _} -> 209 | reply(From, ready_for_query), 210 | State 211 | end; 212 | {psql, error, Error} -> 213 | reply(From, {sql_error, Error}), 214 | State 215 | end. 216 | 217 | bind(From, Portal, Statement, Parameters, State) -> 218 | QueryMsg = psql_protocol:bind(Portal, Statement, Parameters), 219 | psql_connection:command(State#state.connection, {send, QueryMsg}), 220 | psql_connection:sync(State#state.connection), 221 | receive 222 | {psql, bind_complete, _} -> 223 | reply(From, bind_complete), 224 | receive 225 | {psql, ready_for_query, _} -> 226 | reply(From, ready_for_query), 227 | State 228 | end; 229 | {psql, error, Error} -> 230 | reply(From, {sql_error, Error}), 231 | State 232 | end. 233 | 234 | %% There be dragons here.... 235 | describe(From, Type, Name, State) -> 236 | QueryMsg = psql_protocol:describe(Name, Type), 237 | psql_connection:command(State#state.connection, {send, QueryMsg}), 238 | psql_connection:sync(State#state.connection), 239 | receive 240 | {psql, row_description, Data} -> 241 | reply(From, {row_description, Data}), 242 | reply(From, ready_for_query), %% Should really be fetch_result 243 | State; 244 | {psql, error, Error} -> 245 | reply(From, {sql_error, Error}), 246 | State 247 | after 248 | 1000 -> 249 | reply(From, disconnected), 250 | State 251 | end. 252 | 253 | execute(From, Name, ResultSet, State) -> 254 | QueryMsg = psql_protocol:execute(Name, ResultSet), 255 | psql_connection:command(State#state.connection, {send, QueryMsg}), 256 | psql_connection:sync(State#state.connection), 257 | fetch_result(From, [], State). 258 | 259 | close(From, Name, Type, State) -> 260 | QueryMsg = psql_protocol:close(Name, Type), 261 | psql_connection:command(State#state.connection, {send, QueryMsg}), 262 | psql_connection:sync(State#state.connection), 263 | fetch_result(From, [], State). 264 | 265 | %% modified by rsaccon to handle nested transactions 266 | %% 267 | simple_query(From, "BEGIN"=Query, State) -> 268 | case State#state.tx_level of 269 | 0 -> 270 | %% start parent transaction 271 | State2 = do_simple_query(From, Query, State), 272 | State2#state{tx_level = 1}; 273 | _ -> 274 | %% transform nested BEGIN into SAVEPONIT 275 | TxLevel = State#state.tx_level + 1, 276 | Query2 = "SAVEPOINT sp-" ++ integer_to_list(TxLevel), 277 | State2 = do_simple_query(From, Query2, State), 278 | State2#state{tx_level = TxLevel} 279 | end; 280 | 281 | %% modified by rsaccon to handle nested transactions 282 | %% 283 | simple_query(From, "COMMIT"=Query, State) -> 284 | case State#state.tx_level of 285 | 0 -> 286 | %% invalid query 287 | %% TODO: thorw error 288 | reply(From, ready_for_query), 289 | State; 290 | 1 -> 291 | %% COMMIT parent transaction 292 | State2 = do_simple_query(From, Query, State), 293 | State2#state{tx_level = 0}; 294 | _ -> 295 | %% transform nested COMMIT into RELEASE SAVEPOINT 296 | TxLevel = State#state.tx_level, 297 | Sql = "RELEASE SAVEPOINT sp-" ++ integer_to_list(TxLevel), 298 | State2 = do_simple_query(From, Sql, State), 299 | State2#state{tx_level = TxLevel-1} 300 | end; 301 | 302 | %% modified by rsaccon to handle nested transactions 303 | %% 304 | simple_query(From, "ROLLBACK"=Query, State) -> 305 | case State#state.tx_level of 306 | 0 -> 307 | %% invalid query 308 | %% TODO: throw error 309 | reply(From, ready_for_query), 310 | State; 311 | 1 -> 312 | %% ROLLBACK parent transaction 313 | State2 = do_simple_query(From, Query, State), 314 | State2#state{tx_level = 0}; 315 | _ -> 316 | %% transform nested ROLLBACK into ROLLBACK TO SAVEPOINT 317 | TxLevel = State#state.tx_level, 318 | Sql = "ROLLBACK TO SAVEPOINT sp-" ++ integer_to_list(TxLevel), 319 | State2 = do_simple_query(From, Sql, State), 320 | State2#state{tx_level = TxLevel-1} 321 | end; 322 | 323 | %% modified by rsaccon to handle nested transactions 324 | %% 325 | simple_query(From, Query, State) -> 326 | do_simple_query(From, Query, State). 327 | 328 | do_simple_query(From, Query, State) -> 329 | QueryMsg = psql_protocol:q(Query), 330 | psql_connection:command(State#state.connection, {send, QueryMsg}), 331 | psql_connection:sync(State#state.connection), 332 | fetch_result(From, [], State). 333 | 334 | fetch_result(From, Result, State) -> 335 | receive 336 | {psql, row_description, Data} -> 337 | reply(From, {row_description, Data}), 338 | fetch_result(From, [], State); 339 | {psql, data_row, Data} -> 340 | fetch_result(From, [Data|Result], State); 341 | {psql, no_data, _} -> 342 | fetch_result(From, no_data, State); 343 | {psql, command_complete, Command} -> 344 | reply(From, {command_complete, Command, Result}), 345 | fetch_result(From, [], State); 346 | {psql, error, Error} -> 347 | reply(From, {sql_error, Error}), 348 | fetch_result(From, Result, State); 349 | {psql, portal_suspended, _} -> 350 | reply(From, fetch_more), 351 | State; 352 | {psql, ready_for_query, _} -> 353 | reply(From, ready_for_query), 354 | State 355 | end. 356 | 357 | 358 | %% =================================================================== 359 | %% Connection Callbacks 360 | %% =================================================================== 361 | connection_event(Logic, Message) -> 362 | Logic ! Message, 363 | ok. 364 | 365 | connection_closed(Logic) -> 366 | Logic ! {psql, connection_closed, self()}. 367 | 368 | %% =================================================================== 369 | %% System Callbacks 370 | %% =================================================================== 371 | %%-------------------------------------------------------------------- 372 | %% @spec system_continue(Parent::pid(), 373 | %% Debug::list(), 374 | %% State::term()) -> exit() 375 | %% @doc Called by sys 376 | %% @end 377 | %% @see //sys. sys 378 | %%-------------------------------------------------------------------- 379 | system_continue(Parent, Debug, State) -> 380 | loop(Parent, Debug, State). 381 | 382 | %%-------------------------------------------------------------------- 383 | %% @spec system_terminate(Reason::atom(), Parent::pid(), 384 | %% Debug::list(), State::term()) -> exit() 385 | %% @doc Terminate the process called by sys 386 | %% @end 387 | %% @see //sys. sys 388 | %%-------------------------------------------------------------------- 389 | system_terminate(Reason, _Parent, _Debug, _State) -> 390 | psql_pool:unregister(self()), 391 | if 392 | Reason == normal; Reason == shutdown -> 393 | exit(Reason); 394 | true -> 395 | error_logger:error_report({unknown_reason, self(), Reason}), 396 | exit(Reason) 397 | end. 398 | 399 | %%-------------------------------------------------------------------- 400 | %% @spec (State::term(), Module::atom(), Vsn::term(), Extra::term()) -> 401 | %% {ok, term()} 402 | %% @doc Updates the process state called by sys 403 | %% @end 404 | %% @see //sys. sys 405 | %%-------------------------------------------------------------------- 406 | system_code_change(State, _Module, _OldVsn, _Extra) -> 407 | io:format("Updating code...~n"), 408 | {ok, State}. 409 | 410 | %%-------------------------------------------------------------------- 411 | %% @spec write_debug(Device::ref(), Event::term(), State::term()) -> ok 412 | %% @doc Write debug messages called by sys 413 | %% @end 414 | %% @see //sys. sys 415 | %%-------------------------------------------------------------------- 416 | write_debug(Device, Event, State) -> 417 | io:format(Device, "*DBG* ~p, ~w", [Event, State]). 418 | 419 | %%==================================================================== 420 | %% Internal functions 421 | %%==================================================================== 422 | reply(From, Message) -> 423 | From ! {psql_server,Message}, 424 | ok. 425 | -------------------------------------------------------------------------------- /src/erlang-psql-driver/psql_pool.erl: -------------------------------------------------------------------------------- 1 | %%%------------------------------------------------------------------- 2 | %%% @author Martin Carlson 3 | %%% @doc 4 | %%% @end 5 | %%% Revisions: 6 | %%%------------------------------------------------------------------- 7 | -module(psql_pool). 8 | -author('code@erlang-consulting.com'). 9 | -copyright('Erlang Training & Consulting Ltd.'). 10 | -vsn("$Rev$"). 11 | 12 | -behaviour(gen_server). 13 | 14 | %% API 15 | -export([start_link/0, 16 | register/1, 17 | unregister/1, 18 | alloc/1, 19 | free/1, 20 | ref/1]). 21 | 22 | %% gen_server callbacks 23 | -export([init/1, handle_call/3, handle_cast/2, handle_info/2, 24 | terminate/2, code_change/3]). 25 | 26 | -include_lib("stdlib/include/qlc.hrl"). 27 | 28 | -define(SERVER, ?MODULE). 29 | 30 | -record(state, {pool}). 31 | -record(pool, {pid, type, ref}). 32 | 33 | %%==================================================================== 34 | %% API 35 | %%==================================================================== 36 | %%-------------------------------------------------------------------- 37 | %% Function: start_link() -> {ok,Pid} | ignore | {error,Error} 38 | %% Description: Starts the server 39 | %%-------------------------------------------------------------------- 40 | start_link() -> 41 | gen_server:start_link({local, ?SERVER}, ?SERVER, [], []). 42 | 43 | %%-------------------------------------------------------------------- 44 | %% @spec register(Resource::pid()) -> ok 45 | %% @doc Register a resource 46 | %% @end 47 | %%-------------------------------------------------------------------- 48 | register(Resource) -> 49 | gen_server:call(?SERVER, {register, Resource}). 50 | 51 | %%-------------------------------------------------------------------- 52 | %% @spec unregister(Resource::pid()) -> ok 53 | %% @doc Unregisters a resource 54 | %% @end 55 | %%-------------------------------------------------------------------- 56 | unregister(Resource) -> 57 | gen_server:call(?SERVER, {unregister, Resource}). 58 | 59 | %%-------------------------------------------------------------------- 60 | %% @spec alloc(Pid::pid()) -> pid() 61 | %% @doc Allocates a resource 62 | %% @end 63 | %%-------------------------------------------------------------------- 64 | alloc(Pid) -> 65 | case ref(Pid) of 66 | nomatch -> 67 | gen_server:call(?SERVER, {alloc, Pid}); 68 | Res -> 69 | Res 70 | end. 71 | 72 | %%-------------------------------------------------------------------- 73 | %% @spec free(Pid::pid()) -> pid() 74 | %% @doc Frees a pid 75 | %% @end 76 | %%-------------------------------------------------------------------- 77 | free(Pid) -> 78 | case ref(Pid) of 79 | nomatch -> 80 | ok; 81 | _ -> 82 | gen_server:call(?SERVER, {free, Pid}) 83 | end. 84 | 85 | %%-------------------------------------------------------------------- 86 | %% @spec ref(Pid) -> pid() | nomatch 87 | %% @doc Get the resource bound to pid 88 | %% @end 89 | %%-------------------------------------------------------------------- 90 | ref(Pid) -> 91 | gen_server:call(?SERVER, {ref, Pid}). 92 | 93 | %%==================================================================== 94 | %% gen_server callbacks 95 | %%==================================================================== 96 | 97 | %%-------------------------------------------------------------------- 98 | %% Function: init(Args) -> {ok, State} | 99 | %% {ok, State, Timeout} | 100 | %% ignore | 101 | %% {stop, Reason} 102 | %% Description: Initiates the server 103 | %%-------------------------------------------------------------------- 104 | init([]) -> 105 | process_flag(trap_exit, true), 106 | {ok, #state{pool = ets:new(pool, [{keypos, 2}])}}. 107 | 108 | %%-------------------------------------------------------------------- 109 | %% Function: %% handle_call(Request, From, State) -> {reply, Reply, State} | 110 | %% {reply, Reply, State, Timeout} | 111 | %% {noreply, State} | 112 | %% {noreply, State, Timeout} | 113 | %% {stop, Reason, Reply, State} | 114 | %% {stop, Reason, State} 115 | %% Description: Handling call messages 116 | %%-------------------------------------------------------------------- 117 | handle_call({register, Res}, _From, #state{pool = P} = State) -> 118 | link(Res), 119 | ets:insert(P, #pool{type = free, pid = Res}), 120 | {reply, ok, State}; 121 | handle_call({unregister, Res}, _From, #state{pool = P} = State) -> 122 | unlink(Res), 123 | case find_pid(Res, P) of 124 | #pool{type = free} -> 125 | ets:delete(P, Res); 126 | #pool{type = alloc, pid = Client} -> 127 | exit(Client, {error, psql_resource_deregistered}), 128 | ets:delete(P, Client) 129 | end, 130 | {reply, ok, State}; 131 | handle_call({alloc, Pid}, From, #state{pool = P} = State) -> 132 | link(Pid), 133 | case first(free, ets:first(P), P) of 134 | nomatch -> 135 | ets:insert(P, #pool{type = queue, pid = Pid, ref = From}), 136 | {noreply, State}; 137 | #pool{pid = Res} -> 138 | ets:delete(P, Res), 139 | ets:insert(P, #pool{type = alloc, pid = Pid, ref = Res}), 140 | {reply, Res, State} 141 | end; 142 | handle_call({free, Pid}, _From, #state{pool = P} = State) -> 143 | unlink(Pid), 144 | [#pool{ref = Res}] = ets:lookup(P, Pid), 145 | ets:delete(P, Pid), 146 | case first(queue, ets:first(P), P) of 147 | nomatch -> 148 | ets:insert(P, #pool{type = free, pid = Res}); 149 | #pool{pid = QPid, ref = QFrom} -> 150 | ets:insert(P, #pool{type = alloc, pid = QPid, ref = Res}), 151 | gen_server:reply(QFrom, Res) 152 | end, 153 | {reply, ok, State}; 154 | handle_call({ref, Pid}, _From, #state{pool = P} = State) -> 155 | case find_pid(Pid, P) of 156 | #pool{type = alloc, ref = Res} -> 157 | {reply, Res, State}; 158 | _ -> 159 | {reply, nomatch, State} 160 | end. 161 | 162 | %%-------------------------------------------------------------------- 163 | %% Function: handle_cast(Msg, State) -> {noreply, State} | 164 | %% {noreply, State, Timeout} | 165 | %% {stop, Reason, State} 166 | %% Description: Handling cast messages 167 | %%-------------------------------------------------------------------- 168 | handle_cast(_Msg, State) -> 169 | {noreply, State}. 170 | 171 | %%-------------------------------------------------------------------- 172 | %% Function: handle_info(Info, State) -> {noreply, State} | 173 | %% {noreply, State, Timeout} | 174 | %% {stop, Reason, State} 175 | %% Description: Handling all non call/cast messages 176 | %%-------------------------------------------------------------------- 177 | handle_info({'EXIT', Pid, Reason}, #state{pool = P} = State) -> 178 | case find_pid(Pid, P) of 179 | #pool{type = free} -> 180 | ets:delete(P, Pid); 181 | #pool{type = queue} -> 182 | ets:delete(P, Pid); 183 | #pool{type = alloc, pid = Pid, ref = Res} -> 184 | ets:delete(P, Pid), 185 | unlink(Res), 186 | exit(Res, Reason); 187 | #pool{type = alloc, pid = Key} -> 188 | ets:delete(P, Key), 189 | unlink(Key), 190 | exit(Key, Reason) 191 | end, 192 | {noreply, State}. 193 | 194 | %%-------------------------------------------------------------------- 195 | %% Function: terminate(Reason, State) -> void() 196 | %% Description: This function is called by a gen_server when it is about to 197 | %% terminate. It should be the opposite of Module:init/1 and do any necessary 198 | %% cleaning up. When it returns, the gen_server terminates with Reason. 199 | %% The return value is ignored. 200 | %%-------------------------------------------------------------------- 201 | terminate(_Reason, _State) -> 202 | ok. 203 | 204 | %%-------------------------------------------------------------------- 205 | %% Func: code_change(OldVsn, State, Extra) -> {ok, NewState} 206 | %% Description: Convert process state when code is changed 207 | %%-------------------------------------------------------------------- 208 | code_change(_OldVsn, State, _Extra) -> 209 | {ok, State}. 210 | 211 | %%-------------------------------------------------------------------- 212 | %%% Internal functions 213 | %%-------------------------------------------------------------------- 214 | first(_, '$end_of_table', _) -> 215 | nomatch; 216 | first(Type, Key, TID) -> 217 | case ets:lookup(TID, Key) of 218 | [#pool{type = Type} = P] -> 219 | P; 220 | _ -> 221 | first(Type, ets:next(TID, Key), TID) 222 | end. 223 | 224 | find_pid(Pid, TID) -> 225 | QH = qlc:q([P || P <- ets:table(TID), 226 | (P#pool.pid == Pid) or (P#pool.ref == Pid)]), 227 | case qlc:e(QH) of 228 | [] -> 229 | nomatch; 230 | [Pool] -> 231 | Pool 232 | end. 233 | -------------------------------------------------------------------------------- /src/erlang-psql-driver/psql_protocol.erl: -------------------------------------------------------------------------------- 1 | %%%------------------------------------------------------------------- 2 | %%% BASIC INFORMATION 3 | %%%------------------------------------------------------------------- 4 | %%% @copyright 2006 Erlang Training & Consulting Ltd 5 | %%% @author Martin Carlson 6 | %%% @version 0.0.1 7 | %%% @doc 8 | %%% @end 9 | %%%------------------------------------------------------------------- 10 | -module(psql_protocol). 11 | 12 | %% API 13 | -export([decode_packet_header/1, 14 | decode/1, 15 | encode/1, 16 | encode/2, 17 | type/1, 18 | data_type/1, 19 | error/1, 20 | md5/1, 21 | to_int8/1, 22 | to_int16/1, 23 | to_int32/1, 24 | to_string/1]). 25 | 26 | -export([authenticate/4, 27 | md5digest/2, 28 | copy_done/0, 29 | q/1, 30 | parse/3, 31 | bind/3, 32 | describe/2, 33 | execute/2, 34 | close/2, 35 | sync/0]). 36 | 37 | %%==================================================================== 38 | %% Encode/Decode 39 | %%==================================================================== 40 | decode_packet_header(<>) -> 41 | {type(Type), Size}. 42 | 43 | decode(<>) when S - 4 =< size(R) -> 44 | MsgSize = S - 4, 45 | <> = R, 46 | {{type(Type), Message}, Tail}; 47 | decode(Acc) -> 48 | {next, Acc}. 49 | 50 | encode({Type, Message}) -> 51 | encode(Type, Message); 52 | encode(Message) when is_list(Message) -> 53 | encode(list_to_binary(Message)); 54 | encode(Message) when is_binary(Message) -> 55 | Size = to_int32(size(Message) + 4), 56 | [Size, Message]. 57 | encode(Type, Message) when is_list(Message) -> 58 | encode(Type, list_to_binary(Message)); 59 | encode(Type, Message) when is_binary(Message) -> 60 | Size = to_int32(size(Message) + 4), 61 | [type(Type), Size, Message]. 62 | 63 | %%==================================================================== 64 | %% Messages 65 | %%==================================================================== 66 | authenticate(VSN, Usr, Pwd, Db) -> 67 | Msg = [to_int32(VSN), 68 | to_string("user"), 69 | to_string(Usr), 70 | to_string("database"), 71 | to_string(Db), 72 | null()], 73 | Digest = psql_protocol:md5([Pwd, Usr]), 74 | {Msg, Digest}. 75 | 76 | md5digest(Digest, Salt) -> 77 | Auth = md5([Digest, Salt]), 78 | {password_message, <<"md5", Auth/binary, 0:8>>}. 79 | 80 | copy_done() -> 81 | {'copy_done', []}. 82 | 83 | q(Query) -> 84 | {'query', to_string(Query)}. 85 | 86 | parse(Name, Query, Types) -> 87 | {'parse', list_to_binary([to_string(Name), 88 | to_string(Query), 89 | to_int16(length(Types)), 90 | [to_int32(T) || T <- Types]])}. 91 | 92 | bind(Portal, Statement, Parameters) -> 93 | {bind, list_to_binary([to_string(Portal), 94 | to_string(Statement), 95 | to_int16(0), % Denotes that all prameters are in text 96 | to_int16(length(Parameters)), 97 | map_parameters(Parameters, []), 98 | to_int16(0)])}. % Denotes that all prameters are in text 99 | 100 | describe(Name, Type) -> 101 | if 102 | Type == statement -> 103 | T = to_int8($S); 104 | true -> 105 | T = to_int8($P) 106 | end, 107 | {describe, [T, to_string(Name)]}. 108 | 109 | execute(Portal, ResultSetSize) -> 110 | {execute, list_to_binary([to_string(Portal), to_int32(ResultSetSize)])}. 111 | 112 | close(Name, Type) -> 113 | if 114 | Type == statement -> 115 | T = to_int8($S); 116 | true -> 117 | T = to_int8($P) 118 | end, 119 | {close, [T, to_string(Name)]}. 120 | 121 | sync() -> 122 | {sync, []}. 123 | 124 | %%==================================================================== 125 | %% Bind Parameter Map 126 | %%==================================================================== 127 | map_parameters([], Acc) -> 128 | lists:reverse(Acc); 129 | map_parameters([nil|T], Acc) -> 130 | map_parameters(T, [to_int32(-1)|Acc]); 131 | map_parameters([H|T], Acc) when is_list(H) -> 132 | map_parameters(T, [H, to_int32(length(H))|Acc]). 133 | 134 | %%==================================================================== 135 | %% Message Type Map 136 | %%==================================================================== 137 | type($R) -> authentication; 138 | type($K) -> backend_key_data; 139 | type($2) -> bind_complete; 140 | type($3) -> close_complete; 141 | type($C) -> command_complete; 142 | type($d) -> copy_data; 143 | type($c) -> copy_done; 144 | type($G) -> copy_in_response; 145 | type($H) -> copy_out_response; 146 | type($D) -> data_row; 147 | type($I) -> empty_query_response; 148 | type($E) -> error; 149 | type($V) -> function_call_response; 150 | type($n) -> no_data; 151 | type($N) -> notice_response; 152 | type($A) -> notification_response; 153 | type($t) -> parameter_description; 154 | type($S) -> parameter_status; 155 | type($1) -> parse_complete; 156 | type($s) -> portal_suspended; 157 | type($Z) -> ready_for_query; 158 | type($T) -> row_description; 159 | 160 | type(bind) -> $B; 161 | type(close) -> $C; 162 | type(copy_data) -> $d; 163 | type(copy_done) -> $c; 164 | type(copy_fail) -> $f; 165 | type(describe) -> $D; 166 | type(execute) -> $E; 167 | type(flush) -> $H; 168 | type(function_call) -> $F; 169 | type(parse) -> $P; 170 | type(password_message) -> $p; 171 | type('query') -> $Q; 172 | type(ssl_request) -> 8; 173 | type(sync) -> $S; 174 | type(terminate) -> $X. 175 | 176 | %%==================================================================== 177 | %% Datatype Map 178 | %%==================================================================== 179 | %% Datatypes are specified in pg_type 180 | data_type(16) -> bool; 181 | data_type(17) -> binary; 182 | data_type(18) -> string; 183 | data_type(19) -> string; 184 | data_type(20) -> int; 185 | data_type(21) -> int; 186 | data_type(23) -> int; 187 | data_type(24) -> string; 188 | data_type(25) -> string; 189 | data_type(26) -> binary; 190 | data_type(896) -> ip; 191 | data_type(1007) -> integer_array; 192 | data_type(1014) -> char_array; 193 | data_type(1015) -> varchar_array; 194 | data_type(1042) -> string; 195 | data_type(1043) -> string; 196 | data_type(1082) -> date; 197 | data_type(1083) -> time; 198 | data_type(1114) -> datetime; 199 | data_type(1184) -> datetime; 200 | data_type(1266) -> time; 201 | data_type(1700) -> float. 202 | 203 | %%==================================================================== 204 | %% Errors 205 | %%==================================================================== 206 | error(<<"SFATAL",0, "C28000", 0, Rest/binary>>) -> 207 | {authentication, Rest}; 208 | error(<<"SFATAL",0, "C57P01", 0, Rest/binary>>) -> 209 | {shutdown, Rest}; 210 | error(<<"SFATAL",0, "C57P02", 0, Rest/binary>>) -> 211 | {shutdown, Rest}; 212 | error(<<"SFATAL",0, "C57P03", 0, Rest/binary>>) -> 213 | {shutdown, Rest}; 214 | error(<<"SERROR", 0, $C, P, C, O, D, E, 0, Rest/binary>>) -> 215 | {_, Desc} = lists:foldl(fun(0, {Acc0, Acc}) -> 216 | {[], lists:reverse(Acc0) ++ [$ |Acc]}; 217 | (Chr, {Acc0, Acc}) -> 218 | {[Chr|Acc0], Acc} 219 | end, {[], []}, binary_to_list(Rest)), 220 | {sql_error, [P,C,O,D,E], string:strip(Desc)}. 221 | 222 | %%==================================================================== 223 | %% Utility functions 224 | %%==================================================================== 225 | to_int8(N) -> 226 | <>. 227 | 228 | to_int16(N) -> 229 | <>. 230 | 231 | to_int32(N) -> 232 | <>. 233 | 234 | to_string(Str) -> 235 | <<(list_to_binary(Str))/binary, 0:8>>. 236 | 237 | null() -> 238 | <<0:8>>. 239 | 240 | md5(Data) -> 241 | Digest = erlang:md5(Data), 242 | list_to_binary(to_hex(Digest)). 243 | 244 | to_hex(<>) -> 245 | [hex(H), hex(L) | to_hex(Rest)]; 246 | to_hex(<<>>) -> 247 | []. 248 | 249 | hex(Dec) when Dec < 10 -> 250 | $0 + Dec; 251 | hex(Dec) -> 252 | $a - 10 + Dec. 253 | -------------------------------------------------------------------------------- /src/erlang-psql-driver/psql_sup.erl: -------------------------------------------------------------------------------- 1 | %%%------------------------------------------------------------------- 2 | %%% BASIC INFORMATION 3 | %%%------------------------------------------------------------------- 4 | %%% @copyright 2006 Erlang Training & Consulting Ltd 5 | %%% @author Martin Carlson 6 | %%% @version 0.0.1 7 | %%% @doc 8 | %%% @end 9 | %%%------------------------------------------------------------------- 10 | -module(psql_sup). 11 | 12 | -behaviour(supervisor). 13 | 14 | %% API 15 | -export([start_link/0]). 16 | 17 | %% Supervisor callbacks 18 | -export([init/1]). 19 | 20 | -define(SERVER, ?MODULE). 21 | 22 | %%==================================================================== 23 | %% API functions 24 | %%==================================================================== 25 | %%-------------------------------------------------------------------- 26 | %% Function: start_link() -> {ok,Pid} | ignore | {error,Error} 27 | %% Description: Starts the supervisor 28 | %%-------------------------------------------------------------------- 29 | start_link() -> 30 | supervisor:start_link({local, ?SERVER}, ?MODULE, []). 31 | 32 | %%==================================================================== 33 | %% Supervisor callbacks 34 | %%==================================================================== 35 | %%-------------------------------------------------------------------- 36 | %% Func: init(Args) -> {ok, {SupFlags, [ChildSpec]}} | 37 | %% ignore | 38 | %% {error, Reason} 39 | %% Description: Whenever a supervisor is started using 40 | %% supervisor:start_link/[2,3], this function is called by the new process 41 | %% to find out about restart strategy, maximum restart frequency and child 42 | %% specifications. 43 | %%-------------------------------------------------------------------- 44 | init([]) -> 45 | ConSup = {psql_con_sup, {psql_con_sup, start_link, []}, 46 | permanent, 2000, supervisor, [psql_con_sup]}, 47 | Pool = {psql_pool, {psql_pool, start_link, []}, 48 | permanent, 2000, worker, [psql_pool]}, 49 | {ok, {{one_for_one, 10, 60}, [ConSup, Pool]}}. 50 | 51 | %%==================================================================== 52 | %% Internal functions 53 | %%==================================================================== 54 | 55 | -------------------------------------------------------------------------------- /src/erlydb/erlydb_field.erl: -------------------------------------------------------------------------------- 1 | %% @author Yariv Sadan [http://yarivsblog.com] 2 | %% @copyright Yariv Sadan 2006-2007 3 | %% 4 | %% @doc This module contains data structures and functions for 5 | %% exposing database fields' metadata. 6 | %% 7 | %% After calling {@link erlydb:codegen/3}, generated modules contain a few 8 | %% functions for getting database field metadata as well as transforming 9 | %% records to iolists and setting their field values from strings. Those 10 | %% functions use opaque erlydb_field structures, whose values can be 11 | %% retrieved using the functions in this module. For more information, 12 | %% refer to {@link erlydb_base}. 13 | 14 | %% @type erlydb_field(). An opaque structure holding database field 15 | %% metadata. 16 | 17 | %% For license information see license.txt 18 | 19 | -module(erlydb_field). 20 | -author("Yariv Sadan (yarivsblog@gmail.com, http://yarivsblog.com)"). 21 | 22 | -export( 23 | [ 24 | new/0, 25 | new/6, 26 | name/1, 27 | name_str/1, 28 | name_bin/1, 29 | type/1, 30 | maxlength/1, 31 | options/1, 32 | modifier/1, 33 | erl_type/1, 34 | html_input_type/1, 35 | null/1, 36 | key/1, 37 | default/1, 38 | extra/1, 39 | attributes/1, 40 | attributes/2, 41 | is_transient/1 42 | ]). 43 | 44 | -record(erlydb_field, 45 | {name, name_str, name_bin, type, modifier, erl_type, 46 | html_input_type, 47 | null, key, 48 | default, extra, attributes}). 49 | 50 | %% @doc Create a new erlydb_field record. 51 | %% 52 | %% @spec new() -> erlydb_field() 53 | new() -> 54 | #erlydb_field{}. 55 | 56 | %% @doc Create a new erlydb_field record initialized with the given values. 57 | %% 58 | %% 'Type' is the DBMS datatype, ('integer', 'varchar', etc.), represented 59 | %% as an atom. 60 | %% 61 | %% 'Modifier' is used to define the maximum length of the field, or the list 62 | %% of options for an enum field. This value is set to 'undefined' if it's not 63 | %% provided. 64 | %% 65 | %% 'Null' a boolean value indicating if the field is allowed to have a null 66 | %% value. 67 | %% 68 | %% 'Key' indicates if the field is used as a primary or a unique key. 69 | %% The possible values are 'primary', 'unique', 'multiple' and 'undefined'. 70 | %% 71 | %% 'Default' is the field's default value. 72 | %% 73 | %% 'Extra' is any additional information used to describe the field. 74 | %% Currently, the possible values are 'identity' and 'undefined' 75 | %% 76 | %% @spec new(Name::atom(), {Type::atom(), Modifier::term()}, 77 | %% Null::boolean(), Key::term(), Default::term(), Extra::term()) -> 78 | %% erlydb_field() 79 | new(Name, {Type, Modifier}, Null, Key, Default, Extra) -> 80 | NameStr = atom_to_list(Name), 81 | #erlydb_field{name = Name, 82 | name_str = NameStr, 83 | name_bin = list_to_binary(NameStr), 84 | type = Type, 85 | erl_type = get_erl_type(Type), 86 | html_input_type = get_html_input_type(Type), 87 | modifier = Modifier, 88 | null = Null, 89 | key = Key, 90 | default = Default, 91 | extra = Extra}; 92 | new(Name, Type, Null, Key, Default, Extra) -> 93 | new(Name, {Type, undefined}, Null, Key, Default, Extra). 94 | 95 | %% @doc Get the field's name. 96 | %% 97 | %% @spec name(Field::erlydb_field()) -> atom() 98 | name(Field) -> 99 | Field#erlydb_field.name. 100 | 101 | %% @doc Get the field's name as a string. 102 | %% 103 | %% @spec name_str(Field::erlydb_field()) -> string() 104 | name_str(Field) -> 105 | Field#erlydb_field.name_str. 106 | 107 | %% @doc Get the field's name as a binary. 108 | %% 109 | %% @spec name_bin(Field::erlydb_field()) -> binary() 110 | name_bin(Field) -> 111 | Field#erlydb_field.name_bin. 112 | 113 | %% @doc Get the field's type. 114 | %% 115 | %% @spec type(Field::erlydb_field()) -> term() 116 | type(Field) -> 117 | Field#erlydb_field.type. 118 | 119 | %% @doc Get the field's modifier. 120 | %% 121 | %% @spec modifier(Field::erlydb_field()) -> term() 122 | modifier(Field) -> 123 | Field#erlydb_field.modifier. 124 | 125 | %% @doc If this is a text field, get its max length. This is identical to 126 | %% modifier/1. 127 | %% 128 | %% @spec maxlength(Field::erlydb_field()) -> term() 129 | maxlength(Field) -> 130 | Field#erlydb_field.modifier. 131 | 132 | %% @doc If this is an enum field, get its list of options. This is identical to 133 | %% modifier/1. 134 | %% 135 | %% @spec options(Field::erlydb_field()) -> term() 136 | options(Field) -> 137 | Field#erlydb_field.modifier. 138 | 139 | %% @doc Get the field's corresponding Erlang type. Possible values are 140 | %% 'binary', 'integer', 'float', 'date', 'time', and 'datetime'. 141 | %% 142 | %% Date, time and datetime fields have the following forms: 143 | %% 144 | %% ``` 145 | %% {date, {Year, Month, Day}} 146 | %% {time, {Hour, Minute, Second}} 147 | %% {datetime, {{Year, Month, Day}, {Hour, Minute, Second}}} 148 | %% ''' 149 | %% 150 | %% @spec erl_type(Field::erlydb_field()) -> binary | integer | float | date | 151 | %% time | datetime 152 | erl_type(Field) -> 153 | Field#erlydb_field.erl_type. 154 | 155 | %% @doc Get the field's default HTML input field type. 156 | %% Possible values are 'text_field', 'text_area' and 'select'. 157 | %% 158 | %% @spec html_input_type(Field::erlydb_field()) -> text_field | 159 | %% text_area | select 160 | html_input_type(Field) -> 161 | Field#erlydb_field.html_input_type. 162 | 163 | %% @doc Get the field's 'null' status. 164 | %% 165 | %% @spec null(Field::erlydb_field()) -> boolean() 166 | null(Field) -> 167 | Field#erlydb_field.null. 168 | 169 | %% @doc Get the field's key definition. 170 | %% 171 | %% @spec key(Field::erlydb_field()) -> undefined | primary | unique | multiple 172 | key(Field) -> 173 | Field#erlydb_field.key. 174 | 175 | %% @doc Get the field's default value. 176 | %% 177 | %% @spec default(Field::erlydb_field()) -> undefined | term() 178 | default(Field) -> 179 | Field#erlydb_field.default. 180 | 181 | %% @doc Get the field's extra metadata. 182 | %% 183 | %% @spec extra(Field::erlydb_field()) -> undefined | identity 184 | extra(Field) -> 185 | Field#erlydb_field.extra. 186 | 187 | %% @doc Get the field's user-defined attributes. 188 | %% 189 | %% @spec attributes(Field::erlydb_field()) -> undefined | [term()] 190 | attributes(Field) -> 191 | Field#erlydb_field.attributes. 192 | 193 | %% @doc Set the field's user-defined attributes. 194 | %% 195 | %% @spec attributes(Field::erlydb_field(), Attributes::[term()]) -> 196 | %% erlydb_field() 197 | attributes(Field, Attributes) -> 198 | Field#erlydb_field{attributes = Attributes}. 199 | 200 | %% @doc Transient flag of field's user-defined attributes. 201 | %% 202 | %% @spec is_transient(Field::erlydb_field()) -> true | false 203 | is_transient(Field) -> 204 | lists:member(transient, Field#erlydb_field.attributes). 205 | 206 | get_erl_type({Type, _Len}) -> get_erl_type(Type); 207 | get_erl_type(Type) -> 208 | case Type of 209 | varchar -> binary; 210 | char -> binary; 211 | 'character varying' -> binary; 212 | binary -> binary; 213 | varbinary -> binary; 214 | blob -> binary; 215 | text -> binary; 216 | enum -> binary; 217 | set -> binary; 218 | tinyint -> integer; 219 | smallint -> integer; 220 | mediumint -> integer; 221 | int -> integer; 222 | bigint -> integer; 223 | bit -> integer; 224 | float -> float; 225 | double -> float; 226 | numeric -> float; 227 | datetime -> datetime; 228 | date -> date; 229 | timestamp -> datetime; 230 | 'timestamp without time zone' -> datetime; 231 | time -> time; 232 | year -> integer; 233 | Other -> Other 234 | end. 235 | 236 | get_html_input_type(Type) -> 237 | case get_erl_type(Type) of 238 | integer -> text_field; 239 | float -> text_field; 240 | date -> text_field; 241 | time -> text_field; 242 | datetime -> text_field; 243 | decimal -> text_field; 244 | binary -> get_html_binary_input_type(Type); 245 | _ -> text_field 246 | end. 247 | 248 | get_html_binary_input_type({Type, _Len}) -> 249 | get_html_binary_input_type(Type); 250 | 251 | get_html_binary_input_type(Type) -> 252 | case Type of 253 | varchar -> text_field; 254 | 'character varying' -> text_field; 255 | char -> text_field; 256 | binary -> text_field; 257 | varbinary -> text_field; 258 | blob -> text_area; 259 | text -> text_area; 260 | enum -> select; 261 | set -> select 262 | end. 263 | 264 | -------------------------------------------------------------------------------- /src/erlydb/erlydb_mysql.erl: -------------------------------------------------------------------------------- 1 | %% @author Yariv Sadan (yarivvv@gmail.com) (http://yarivsblog.com) 2 | %% @copyright Yariv Sadan 2006-2007 3 | %% 4 | %% @doc This module implements the MySQL driver for ErlyDB. 5 | %% 6 | %% This is an internal ErlyDB module that you normally shouldn't have to 7 | %% use directly. For most situations, all you have to know 8 | %% about this module is the options you can pass to {@link start/1}, which 9 | %% is called by {@link erlydb:start/2}. 10 | %% 11 | 12 | %% For license information see LICENSE.txt 13 | 14 | -module(erlydb_mysql). 15 | 16 | -author("Yariv Sadan (yarivsblog@gmail.com) (http://yarivsblog.com)"). 17 | 18 | -export([start/1, 19 | start_link/1, 20 | connect/5, 21 | connect/7, 22 | connect/8, 23 | connect/9, 24 | get_metadata/1, 25 | get_default_pool_id/0, 26 | q/1, 27 | q/2, 28 | q2/1, 29 | q2/2, 30 | transaction/2, 31 | select/2, 32 | select_as/3, 33 | update/2, 34 | get_last_insert_id/2, 35 | prepare/2, 36 | execute/2, 37 | execute/3, 38 | execute_select/2, 39 | execute_select/3, 40 | execute_update/2, 41 | execute_update/3]). 42 | 43 | 44 | %% Useful for debugging 45 | 46 | -define(L(Msg), io:format("~p:~b ~p ~n", [?MODULE, ?LINE, Msg])). 47 | -define(S(Obj), io:format("LOG ~w ~s\n", [?LINE, Obj])). 48 | 49 | -define(Epid, erlydb_mysql). 50 | 51 | %% @type esql() = {esql, term()}. An ErlSQL expression. 52 | %% @type statement() = esql() | binary() | string() 53 | %% @type options() = [option()] 54 | %% @type option() = {pool_id, atom()} | {allow_unsafe_statements, boolean()} 55 | 56 | %% @doc Start the MySQL dispatcher using the options property list. 57 | %% The available options are: 58 | %% 59 | %% `pool_id' (optional): an atom identifying the connection pool id. 60 | %% An 'undefined' value indicates that the default connection 61 | %% pool, i.e. 'erlydb_mysql', should be used. 62 | %% 63 | %% `hostname': a string indicating the database host name. 64 | %% 65 | %% `port' (optional): an integer indicating the database port 66 | %% ('undefined' indicates the default MySQL port, 3306). 67 | %% 68 | %% `username': a string indicating the username. 69 | %% 70 | %% `password': a string indicating the password. 71 | %% 72 | %% `database': a string indicating the database name. 73 | %% 74 | %% `allow_unsafe_statements': a boolean value indicating whether the driver 75 | %% should 76 | %% accept string and/or binary SQL queries and query fragments. If you 77 | %% set this value to 78 | %% 'true', ErlyDB lets you use string or binary Where and Extras expressions 79 | %% in generated functions. For more information, see {@link erlydb}. 80 | %% 81 | %% `encoding': the character encoding MySQL will use. 82 | %% 83 | %% `poolsize': the number of connections to start. 84 | %% 85 | %% This function calls mysql:start(), not mysql:start_link(). To 86 | %% link the MySQL dispatcher to the calling process, use {@link start_link/1}. 87 | %% 88 | %% @spec start(StartOptions::proplist()) -> ok | {error, Error} 89 | start(Options) -> 90 | start(Options, fun mysql:start/8, false). 91 | 92 | %% @doc This function is similar to {@link start/1}, only it calls 93 | %% mysql:start_link() instead of mysql:start(). 94 | %% 95 | %% @spec start_link(StartOptions::proplist()) -> ok | {error, Error} 96 | start_link(Options) -> 97 | start(Options, fun mysql:start_link/8, true). 98 | 99 | start(Options, Fun, LinkConnections) -> 100 | [PoolId, Hostname, Port, Username, Password, Database, LogFun, 101 | Encoding, PoolSize, Reconnect] = 102 | lists:foldl( 103 | fun(Key, Acc) -> 104 | [proplists:get_value(Key, Options) | Acc] 105 | end, [], 106 | lists:reverse([pool_id, hostname, port, username, 107 | password, database, logfun, encoding, poolsize, reconnect])), 108 | 109 | PoolId1 = if PoolId == undefined -> ?Epid; true -> PoolId end, 110 | PoolSize1 = if PoolSize == undefined -> 1; true -> PoolSize end, 111 | Fun(PoolId1, Hostname, Port, Username, Password, Database, LogFun, 112 | Encoding), 113 | Reconnect1 = if Reconnect == undefined -> true; true -> Reconnect end, 114 | make_connection(PoolSize1-1, PoolId, Database, Hostname, Port, 115 | Username, Password, Encoding, Reconnect1, LinkConnections). 116 | 117 | %% @doc Create a a number of database connections in the pool. 118 | make_connection(PoolSize, PoolId, Database, Hostname, Port, 119 | Username, Password, Encoding, Reconnect, LinkConnections) -> 120 | if PoolSize > 0 -> 121 | connect(PoolId, Hostname, Port, Username, Password, Database, 122 | Encoding, Reconnect, LinkConnections), 123 | make_connection(PoolSize-1, PoolId, Database, Hostname, Port, 124 | Username, Password, Encoding, Reconnect, 125 | LinkConnections); 126 | true -> 127 | ok 128 | end. 129 | 130 | %% @doc Call connect/7 with Port set to 3306 and Reconnect set to 'true'. 131 | %% If the connection is lost, reconnection is attempted. 132 | %% The connection process is linked to the calling process. 133 | %% 134 | %% @spec connect(PoolId::atom(), Hostname::string(), 135 | %% Username::string(), Password::string(), Database::string()) -> ok 136 | connect(PoolId, Hostname, Username, Password, Database) -> 137 | mysql:connect(PoolId, Hostname, 3306, Username, Password, Database, 138 | undefined, true). 139 | 140 | %% @doc Add a connection to the connection pool. If PoolId is 141 | %% 'undefined', the default pool, 'erlydb_mysql', is used. The connection 142 | %% process is linked to the calling process. 143 | %% 144 | %% @spec connect(PoolId::atom(), Hostname::string, Port::integer(), 145 | %% Username::string(), Password::string(), Database::string(), 146 | %% Reconnect::boolean()) -> ok 147 | connect(PoolId, Hostname, Port, Username, Password, Database, 148 | Reconnect) -> 149 | mysql:connect(PoolId, Hostname, Port, Username, Password, Database, 150 | Reconnect). 151 | 152 | %% @doc Add a connection to the connection pool, with encoding specified. 153 | %% The connection process is linked to the calling process. 154 | %% 155 | %% @spec connect(PoolId::atom(), Hostname::string, Port::integer(), 156 | %% Username::string(), Password::string(), Database::string(), 157 | %% Encoding, 158 | %% Reconnect::boolean()) -> ok 159 | connect(PoolId, Hostname, Port, Username, Password, Database, 160 | Encoding, Reconnect) -> 161 | mysql:connect(PoolId, Hostname, Port, Username, Password, Database, 162 | Encoding, Reconnect). 163 | 164 | %% @doc Add a connection to the connection pool, with encoding specified. 165 | %% If LinkConnection == false, the connection will not be linked to the 166 | %% current process. 167 | %% 168 | %% @spec connect(PoolId::atom(), Hostname::string, Port::integer(), 169 | %% Username::string(), Password::string(), Database::string(), 170 | %% Encoding::string(), 171 | %% Reconnect::boolean(), LinkConnection::bool()) -> ok 172 | connect(PoolId, Hostname, Port, Username, Password, Database, 173 | Encoding, Reconnect, LinkConnection) -> 174 | mysql:connect(PoolId, Hostname, Port, Username, Password, Database, 175 | Encoding, Reconnect, LinkConnection). 176 | 177 | %% @doc Get the table names and fields for the database. 178 | %% 179 | %% @spec get_metadata(Options::options()) -> gb_trees() 180 | get_metadata(Options) -> 181 | case q2(<<"show tables">>, Options) of 182 | {data, Res} -> 183 | Tables = mysql:get_result_rows(Res), 184 | lists:foldl( 185 | fun([Table | _], TableTree) -> 186 | case q2(<<"describe ", Table/binary>>, Options) of 187 | {data, FieldRes} -> 188 | Rows = mysql:get_result_rows(FieldRes), 189 | Fields = 190 | [new_field(FieldData) || 191 | FieldData <- Rows], 192 | gb_trees:enter(binary_to_atom(Table), Fields, 193 | TableTree); 194 | {error, Err} -> 195 | exit(Err) 196 | end 197 | end, gb_trees:empty(), Tables); 198 | {error, Err} -> 199 | exit(Err) 200 | end. 201 | 202 | %% @doc Get the default connection pool name for the driver. 203 | %% 204 | %% @spec get_default_pool_id() -> atom() 205 | get_default_pool_id() -> 206 | ?Epid. 207 | 208 | new_field([Name, Type, Null, Key, Default, Extra]) -> 209 | Type1 = parse_type(binary_to_list(Type)), 210 | Null1 = case Null of 211 | <<"YES">> -> true; 212 | _ -> false 213 | end, 214 | Key1 = case Key of 215 | <<"PRI">> -> primary; 216 | <<"UNI">> -> unique; 217 | <<"MUL">> -> multiple; 218 | _Other -> undefined 219 | end, 220 | Extra1 = case Extra of 221 | <<"auto_increment">> -> identity; 222 | _ -> undefined 223 | end, 224 | 225 | erlydb_field:new( 226 | binary_to_atom(Name), Type1, Null1, Key1, Default, Extra1). 227 | 228 | parse_type(TypeStr) -> 229 | case string:chr(TypeStr, 40) of %% 40 == '(' 230 | 0 -> 231 | {list_to_atom(TypeStr), undefined}; 232 | Idx -> 233 | {TypeStr1, [_| Vals]} = lists:split(Idx - 1, TypeStr), 234 | Extras = 235 | case TypeStr1 of 236 | "set" -> parse_list(Vals); 237 | "enum" -> parse_list(Vals); 238 | _Other -> 239 | {ok, [Len], _} = io_lib:fread("~d", Vals), 240 | Len 241 | end, 242 | {list_to_atom(TypeStr1), Extras} 243 | end. 244 | 245 | parse_list(Str) -> 246 | [_Last | Body] = lists:reverse(Str), 247 | Body1 = lists:reverse(Body), 248 | Toks = string:tokens(Body1, ","), 249 | [list_to_binary(string:strip(Tok, both, 39)) || Tok <- Toks]. 250 | 251 | 252 | %% @doc Execute a statement against the MySQL driver with the default options. 253 | %% The connection default pool name ('erlydb_mysql') is used. 254 | %% 255 | %% @spec q(Statement::statement()) -> mysql_result() 256 | q(Statement) -> 257 | q(Statement, undefined). 258 | 259 | %% @doc Execute a statement directly against the MySQL driver. If 260 | %% Options contains the value {allow_unsafe_statements, true}, binary 261 | %% and string queries as well as ErlSQL queries with binary and/or 262 | %% string expressions are accepted. Otherwise, this function exits. 263 | %% 264 | %% @spec q(Statement::statement(), Options::options()) -> 265 | %% mysql_result() | exit({unsafe_statement, Statement}) 266 | q({esql, Statement}, Options) -> 267 | case allow_unsafe_statements(Options) of 268 | true -> q2(erlsql:unsafe_sql(Statement), Options); 269 | _ -> 270 | case catch erlsql:sql(Statement) of 271 | {error, _} = Err -> exit(Err); 272 | Res -> q2(Res, Options) 273 | end 274 | end; 275 | q(Statement, Options) when is_binary(Statement); is_list(Statement) -> 276 | case allow_unsafe_statements(Options) of 277 | true -> q2(Statement, Options); 278 | _ -> exit({unsafe_statement, Statement}) 279 | end. 280 | 281 | %% @doc Execute a (binary or string) statement against the MySQL driver 282 | %% using the default options. 283 | %% ErlyDB doesn't use this function, but it's sometimes convenient for 284 | %% testing. 285 | %% 286 | %% @spec q2(Statement::string() | binary()) -> 287 | %% mysql_result() 288 | q2(Statement) -> 289 | q2(Statement, undefined). 290 | 291 | %% @doc Execute a (binary or string) statement against the MySQL driver. 292 | %% ErlyDB doesn't use this function, but it's sometimes convenient for testing. 293 | %% 294 | %% @spec q2(Statement::string() | binary(), Options::options()) -> 295 | %% mysql_result() 296 | q2(Statement, Options) -> 297 | mysql:fetch(get_pool_id(Options), Statement, get_timeout(Options)). 298 | 299 | %% @doc Execute a group of statements in a transaction. 300 | %% Fun is the function that implements the transaction. 301 | %% Fun can contain an arbitrary sequence of calls to 302 | %% the erlydb_mysql's query functions. If Fun crashes or returns 303 | %% or throws 'error' or {error, Err}, the transaction is automatically 304 | %% rolled back. 305 | %% 306 | %% @spec transaction(Fun::function(), Options::options()) -> 307 | %% {atomic, Result} | {aborted, Reason} 308 | transaction(Fun, Options) -> 309 | mysql:transaction(get_pool_id(Options), Fun, get_timeout(Options)). 310 | 311 | 312 | %% @doc Execute a raw SELECT statement. 313 | %% 314 | %% @spec select(Statement::statement(), Options::options()) -> 315 | %% {ok, Rows::list()} | {error, Error} 316 | select(Statement, Options) -> 317 | select2(Statement, Options, []). 318 | 319 | %% @doc Execute a SELECT statements for records belonging to the given module, 320 | %% returning all rows with additional data to support 321 | %% higher-level ErlyDB features. 322 | %% 323 | %% @spec select_as(Module::atom(), Statement::statement(), 324 | %% Options::options()) -> {ok, Rows} | {error, Error} 325 | select_as(Module, Statement, Options) -> 326 | select2(Statement, Options, [Module, false]). 327 | 328 | select2(Statement, Options, FixedVals) -> 329 | get_select_result(q(Statement, Options), FixedVals). 330 | 331 | get_select_result(MySQLRes) -> 332 | get_select_result(MySQLRes, undefined). 333 | 334 | get_select_result({data, Data}, undefined) -> 335 | {ok, mysql:get_result_rows(Data)}; 336 | get_select_result({data, Data}, FixedVals)-> 337 | Rows = mysql:get_result_rows(Data), 338 | Result = 339 | lists:foldl( 340 | fun(Fields, Acc) -> 341 | Row = FixedVals ++ Fields, 342 | [list_to_tuple(Row) | Acc] 343 | end, [], Rows), 344 | {ok, lists:reverse(Result)}; 345 | 346 | get_select_result(Other, _) -> Other. 347 | 348 | %% @doc Execute a DELETE or UPDATE statement. 349 | %% 350 | %% @spec update(Statement::statement(), Options::options()) -> 351 | %% {ok, NumAffected} | {error, Err} 352 | update(Statement, Options) -> 353 | R = q(Statement, Options), 354 | get_update_result(R). 355 | 356 | 357 | get_update_result({updated, MySQLRes}) -> 358 | {ok, mysql:get_result_affected_rows(MySQLRes)}; 359 | get_update_result(Other) -> Other. 360 | 361 | 362 | %% @doc Get the id of the last inserted record. 363 | %% 364 | %% @spec get_last_insert_id(undefined, Options::options()) -> term() 365 | get_last_insert_id(_Table, Options) -> 366 | case q2(<<"SELECT last_insert_id()">>, Options) of 367 | {data, Result} -> 368 | [[Val]] = mysql:get_result_rows(Result), 369 | {ok, Val}; 370 | Err -> 371 | Err 372 | end. 373 | 374 | 375 | %% @doc Register a prepared statement with the MySQL dispatcher. 376 | %% If the dispatcher has a prepared statement with the same name, 377 | %% the old statement is overwritten and the statement's version 378 | %% is incremented. 379 | %% 380 | %% @spec prepare(Name::atom(), Stmt::iolist()) -> ok | {error, Err} 381 | prepare(Name, Stmt) -> 382 | mysql:prepare(Name, Stmt). 383 | 384 | %% @doc Execute a statement that was previously prepared with 385 | %% prepare/2. 386 | %% 387 | %% @spec execute(Name::atom(), Options::options()) -> mysql_result() 388 | execute(Name, Options) -> 389 | mysql:execute(get_pool_id(Options), Name). 390 | 391 | %% @doc Execute a prepared statement with the list of parameters. 392 | %% 393 | %% @spec execute(Name::atom(), Params::[term()], Options::options()) -> 394 | %% mysql_result() 395 | execute(Name, Params, Options) -> 396 | mysql:execute(get_pool_id(Options), Name, Params). 397 | 398 | %% @doc Execute a prepared statement and return the result as the select() 399 | %% function. 400 | %% 401 | %% @spec execute_select(Name::atom(), Options::options()) -> 402 | %% {ok, [row]} | {error, Err} 403 | execute_select(Name, Options) -> 404 | get_select_result(execute(Name, Options)). 405 | 406 | %% @doc Execute a prepared statement with the list of parameters 407 | %% and return the result as the select() function. 408 | %% 409 | %% @spec execute_select(Name::atom(), Params::[term()], Options::options()) -> 410 | %% {ok, [Row::tuple()]} | {error, Err} 411 | execute_select(Name, Params, Options) -> 412 | get_select_result(execute(Name, Params, Options)). 413 | 414 | %% @doc Execute a prepared statement and return the result as the the 415 | %% update() function. 416 | %% 417 | %% @spec execute_update(Name::atom(), Options::options()) -> 418 | %% {ok, NumUpdated::integer()} | {error, Err} 419 | execute_update(Name, Options) -> 420 | get_update_result(execute(Name, Options)). 421 | 422 | %% @doc Execute a prepared statement with the list of parameters and 423 | %% and return the result as the the update() function. 424 | %% 425 | %% @spec execute_update(Name::atom(), Params::[term()], Options::options()) -> 426 | %% {ok, NumUpdated::integer()} | {error, Err} 427 | execute_update(Name, Params, Options) -> 428 | get_update_result(execute(Name, Params, Options)). 429 | 430 | 431 | 432 | binary_to_atom(Bin) -> 433 | list_to_atom(binary_to_list(Bin)). 434 | 435 | 436 | allow_unsafe_statements(undefined) -> false; 437 | allow_unsafe_statements(Options) -> 438 | proplists:get_value(allow_unsafe_statements, Options). 439 | 440 | get_pool_id(undefined) -> erlydb_mysql; 441 | get_pool_id(Options) -> 442 | case proplists:get_value(pool_id, Options) of 443 | undefined -> 444 | get_default_pool_id(); 445 | Other -> 446 | Other 447 | end. 448 | 449 | get_timeout(undefined) -> 5000; 450 | get_timeout(Options) -> 451 | case proplists:get_value(erlydb_timeout, Options) of 452 | undefined -> 453 | 5000; 454 | Timeout -> 455 | Timeout 456 | end. 457 | -------------------------------------------------------------------------------- /src/erlydb/erlydb_psql.erl: -------------------------------------------------------------------------------- 1 | %% @author Roberto Saccon (rsaccon@gmail.com) 2 | %% @copyright Roberto Saccon 2007 3 | %% 4 | %% @doc This module implements the Postgresql driver for ErlyDB. 5 | %% 6 | %% Based on code initially developed by Brian Olson, see 7 | %% (http://groups.google.com/group/erlyweb/browse_frm/thread/e1585240f790c87c) 8 | %% 9 | %% This is an internal ErlyDB module that you normally shouldn't have to 10 | %% use directly. 11 | %% 12 | %% Postgresql driver is an OTP application. 13 | %% Define database details and authetication credentials for the driver pool 14 | %% in psql.app.src and run 'make app' to crate an OTP-ish ebin/psql.app 15 | %% 16 | %% For license information see LICENSE.txt 17 | 18 | -module(erlydb_psql). 19 | 20 | -author("Roberto Saccon (rsaccon@gmail.com)"). 21 | 22 | -export([start/0, 23 | stop/0, 24 | get_metadata/1, 25 | q/1, 26 | q/2, 27 | q2/1, 28 | q2/2, 29 | transaction/2, 30 | select/2, 31 | select_as/3, 32 | update/2, 33 | get_last_insert_id/2]). 34 | 35 | 36 | %% Useful for debugging 37 | -define(L(Msg), io:format("~p:~b ~p ~n", [?MODULE, ?LINE, Msg])). 38 | -define(S(Obj), io:format("LOG ~w ~s\n", [?LINE, Obj])). 39 | 40 | 41 | %% @doc Starts the psql and sql applications up if they are not 42 | %% already started. Any errors that are returned are ignored. 43 | %% 44 | %% @todo catch when a connection is not possible: 45 | %% for example, it returns {connection_failed, econnrefused} 46 | start() -> 47 | application:load(psql), 48 | application:start(psql). 49 | 50 | 51 | %% @doc Stops the psql and sql applications. 52 | stop() -> 53 | application:stop(psql). 54 | 55 | 56 | table_names_sql(SchemaName) -> 57 | "select tablename from pg_tables where schemaname = '" ++ 58 | SchemaName ++ "'". 59 | 60 | column_attributes_sql(TableName) -> 61 | "SELECT a.attname, format_type(a.atttypid, a.atttypmod), d.adsrc, " 62 | "a.attnotnull" 63 | " FROM pg_attribute a LEFT JOIN pg_attrdef d" 64 | " ON a.attrelid = d.adrelid AND a.attnum = d.adnum" 65 | " WHERE a.attrelid = '" ++ TableName ++ "'::regclass" 66 | " AND a.attnum > 0 AND NOT a.attisdropped" 67 | " ORDER BY a.attnum". 68 | 69 | constraints_sql(TableName, SchemaName) -> 70 | "SELECT column_name, constraint_name FROM" 71 | " information_schema.constraint_column_usage where" 72 | " table_name = '" ++ TableName ++ "' AND table_schema = '" ++ 73 | SchemaName ++ "'". 74 | 75 | %% @doc Get the table names and fields for the database. 76 | get_metadata(_Options) -> 77 | Pid = psql:allocate(), 78 | Schema = "public", 79 | TableNames = q3(Pid, table_names_sql(Schema)), 80 | ConstraintInfo = 81 | lists:flatten( 82 | [q3(Pid, constraints_sql(element(1, Name), Schema)) || 83 | Name <- TableNames]), 84 | Result = case catch lists:foldl( 85 | fun(Table, TablesTree) -> 86 | get_metadata(Pid, Table, ConstraintInfo, 87 | TablesTree) 88 | end, 89 | gb_trees:empty(), TableNames) of 90 | {error, Err} -> exit(Err); 91 | Tree -> Tree 92 | end, 93 | psql:free(), 94 | Result. 95 | 96 | get_metadata(Pid, Table, ConstraintInfo, TablesTree) -> 97 | Columns = q3(Pid, column_attributes_sql(element(1, Table))), 98 | Fields = [new_field(Column, element(1, Table), ConstraintInfo) || 99 | Column <- Columns], 100 | TableName = list_to_atom(element(1, Table)), 101 | gb_trees:enter(TableName, lists:reverse(Fields), TablesTree). 102 | 103 | new_field(FieldInfo, TableName, ConstraintInfo) -> 104 | Name = element(1, FieldInfo), 105 | Type = parse_type(element(2, FieldInfo)), 106 | {Default, Extra} = parse_default(element(3, FieldInfo)), 107 | Null = case element(4, FieldInfo) of 108 | true -> false; 109 | false -> true 110 | end, 111 | Keys = lists:map(fun(Elem) -> 112 | CName = TableName ++ "_pkey", 113 | case element(2, Elem) of 114 | CName -> element(1, Elem); 115 | _ -> none 116 | end 117 | end, 118 | ConstraintInfo), 119 | Key = case lists:member(Name, Keys) of 120 | true -> primary; 121 | _ -> undefined 122 | end, 123 | erlydb_field:new(list_to_atom(Name), Type, Null, Key, Default, Extra). 124 | 125 | 126 | parse_type(TypeStr) -> 127 | case string:chr(TypeStr, 40) of %% 40 == '(' 128 | 0 -> 129 | {list_to_atom(TypeStr), undefined}; 130 | Idx -> 131 | {TypeStr1, [_| Vals]} = lists:split(Idx - 1, TypeStr), 132 | {ok, [Len], _} = io_lib:fread("~d", Vals), 133 | {list_to_atom(TypeStr1), Len} 134 | end. 135 | 136 | 137 | parse_default([]) -> 138 | {undefined, undefined}; 139 | 140 | parse_default(DefaultStr) -> 141 | case string:str(DefaultStr, "nextval") of 142 | 0 -> 143 | Default = hd(string:tokens(DefaultStr, "::")), 144 | {Default, undefined}; 145 | _ -> 146 | {undefined, identity} 147 | end. 148 | 149 | %% @doc Execute a statement directly against the PostgreSQL driver. If 150 | %% Options contains the value {allow_unsafe_sql, true}, binary and string 151 | %% queries as well as ErlSQL queries with binary and/or string expressions are 152 | %% accepted. Otherwise the function crashes. 153 | q(Statement) -> 154 | q(Statement, undefined). 155 | 156 | 157 | q({esql, Statement}, Options) -> 158 | case allow_unsafe_statements(Options) of 159 | true -> 160 | {ok, q2(erlsql:unsafe_sql(Statement), Options)}; 161 | _ -> 162 | case catch erlsql:sql(Statement) of 163 | {error, _} = Err -> 164 | exit(Err); 165 | Sql -> 166 | {ok, q2(Sql, Options)} 167 | %% TODO: catch errors 168 | end 169 | end. 170 | 171 | 172 | %% @doc Execute a (binary or string) statement against the Postgresql driver 173 | %% using the default options. 174 | %% 175 | %% @spec q2(Statement::string() | binary()) -> 176 | %% psql_result() 177 | q2(Statement) -> 178 | q2(Statement, undefined). 179 | 180 | 181 | %% @doc Execute a (binary or string) statement against the MySQL driver. 182 | %% 183 | %% @spec q2(Statement::string() | binary(), Options::proplist()) -> 184 | %% psql_result() 185 | q2(Statement, _Options) -> 186 | Pid = psql:allocate(), 187 | Result = q3(Pid, Statement), 188 | psql:free(), 189 | Result. 190 | 191 | 192 | q3(Pid, Sql) -> 193 | case psql:sql_query(Pid, Sql) of 194 | {_FieldInfo,[{_Status, Rows}]} -> 195 | Rows; 196 | [{Status, _Rows}] -> 197 | Status; 198 | Other -> 199 | Other 200 | end. 201 | 202 | 203 | allow_unsafe_statements(undefined) -> 204 | false; 205 | allow_unsafe_statements(Options) -> 206 | proplists:get_value(allow_unsafe_statements, Options). 207 | 208 | 209 | %% get_pool_id(undefined) -> 210 | %% erlydb_psql; 211 | %% get_pool_id(Options) -> 212 | %% case proplists:get_value(pool_name, Options) of 213 | %% undefined -> erlydb_psql; 214 | %% Other -> Other 215 | %% end. 216 | 217 | 218 | %% @doc Models a transaction. If an error occurs in the function provided, then 219 | %% the transaction will rollback. Otherwise it will commit. 220 | transaction(Fun, _Options) -> 221 | Pid = psql:allocate(), 222 | psql:transaction(Pid), 223 | case catch Fun() of 224 | {'EXIT', Reason} -> 225 | psql:rollback(Pid), 226 | psql:free(), 227 | {aborted, Reason}; 228 | Val -> 229 | psql:commit(Pid), 230 | psql:free(), 231 | {atomic, Val} 232 | end. 233 | 234 | 235 | %% @doc Execute a raw SELECT statement. 236 | %% 237 | %% @spec select(PoolId::atom(), Statement::statement()) -> 238 | %% {ok, Rows::list()} | {error, Error} 239 | select(Statement, Options) -> 240 | select2(Statement, Options, []). 241 | 242 | 243 | %% @doc Execute a SELECT statements for records belonging to the given module, 244 | %% returning all rows with additional data to support 245 | %% higher-level ErlyDB features. 246 | %% 247 | %% @spec select_as(Module::atom(), Statement::statement(), 248 | %% FixedCols::tuple()) -> {ok, Rows} | {error, Error} 249 | select_as(Module, Statement, Options) -> 250 | select2(Statement, Options, [Module, false]). 251 | 252 | select2(Statement, Options, FixedVals) -> 253 | get_select_result(q(Statement, Options), FixedVals). 254 | 255 | get_select_result({ok, _Rows}=Result, undefined) -> 256 | Result; 257 | get_select_result({ok, Rows}, FixedVals)-> 258 | Result = lists:foldl( 259 | fun(Fields, Acc) -> 260 | Row = FixedVals ++ 261 | lists_to_binaries(tuple_to_list(Fields)), 262 | [list_to_tuple(Row) | Acc] 263 | end, [], Rows), 264 | {ok, Result}; 265 | get_select_result(Other, _) -> 266 | Other. 267 | 268 | lists_to_binaries(Row) -> 269 | [to_binary(Field) || Field <- Row]. 270 | 271 | to_binary(Field) when is_list(Field) -> 272 | list_to_binary(Field); 273 | to_binary(Row) -> Row. 274 | 275 | 276 | %% @doc Execute a INSERT, DELETE or UPDATE statement. 277 | %% 278 | %% @spec update(Statement::statement(), Options::options()) -> 279 | %% {ok, NumAffected} | {error, Err} 280 | %% 281 | update(Statement, Options) -> 282 | R = q(Statement, Options), 283 | get_update_result(R). 284 | 285 | get_update_result({ok, <<"INSERT", Rest/binary>>}) -> 286 | {ok, get_update_element(2, Rest)}; 287 | get_update_result({ok, <<"DELETE", Rest/binary>>}) -> 288 | {ok, get_update_element(1, Rest)}; 289 | get_update_result({ok, <<"UPDATE", Rest/binary>>}) -> 290 | {ok, get_update_element(1, Rest)}; 291 | 292 | get_update_result(Other) -> 293 | Other. 294 | 295 | get_update_element(N, Bin) -> 296 | {S, <<0>>} = split_binary(Bin, size(Bin)-1), 297 | R = lists:nth(N, string:tokens(binary_to_list(S), " ")), 298 | {AffectedRows, _} = string:to_integer(R), 299 | AffectedRows. 300 | 301 | 302 | %% @doc Get the id of the last inserted record. 303 | %% 304 | %% @spec get_last_insert_id(TableName::atom(), Options::proplist()) -> term() 305 | get_last_insert_id(Table, Options) -> 306 | TableName = atom_to_list(Table), 307 | Sql = "SELECT currval('" ++ TableName ++ "_id_seq');", 308 | case q2(Sql, Options) of 309 | [{N}] -> {ok, N}; 310 | Err -> exit(Err) 311 | end. 312 | 313 | -------------------------------------------------------------------------------- /src/erlyweb/erlyweb_compile.erl: -------------------------------------------------------------------------------- 1 | %% @author Yariv Sadan [http://yarivsblog.com] 2 | %% @copyright Yariv Sadan 2006-2007 3 | %% @hidden 4 | %% @doc This file containes the compilation logic for ErlyWeb. 5 | 6 | %% For license information see LICENSE.txt 7 | -module(erlyweb_compile). 8 | -export([compile/2, get_app_data_module/1, compile_file/5, compile_file/6]). 9 | 10 | -include_lib("kernel/include/file.hrl"). 11 | 12 | -import(erlyweb_util, [log/5]). 13 | 14 | -define(Debug(Msg, Params), log(?MODULE, ?LINE, debug, Msg, Params)). 15 | -define(Info(Msg, Params), log(?MODULE, ?LINE, info, Msg, Params)). 16 | -define(Error(Msg, Params), log(?MODULE, ?LINE, error, Msg, Params)). 17 | 18 | -define(L(Msg), io:format("~b ~p~n", [?LINE, Msg])). 19 | 20 | 21 | compile(AppDir, Options) -> 22 | AppDir1 = case lists:reverse(AppDir) of 23 | [$/ | _] -> AppDir; 24 | Other -> lists:reverse([$/ | Other]) 25 | end, 26 | 27 | Macros = 28 | lists:foldl( 29 | fun({d, M}, Acc) -> [{M, true} | Acc]; 30 | ({d, M, V}, Acc) -> [{M, V} | Acc]; 31 | (_, Acc) -> Acc 32 | end, [], Options), 33 | 34 | IncludePaths = 35 | lists:foldl( 36 | fun({i, [$/ | _] = Path}, Acc) -> 37 | [Path | Acc]; 38 | ({i, Path}, Acc) -> 39 | [AppDir1 ++ "src/" ++ Path | Acc]; 40 | (_Opt, Acc) -> 41 | Acc 42 | end, [AppDir1 ++ "src"], Options), 43 | 44 | Options1 = 45 | lists:foldl( 46 | fun({Opt, NoOpt}, Acc) -> 47 | set_default_option(Opt, NoOpt, Acc) 48 | end, Options, 49 | [{return_errors, no_return_errors}, 50 | {report_warnings, suppress_warnings}, 51 | {report_errors, suppress_errors}, 52 | {debug_info, no_debug_info}]), 53 | 54 | {Options2, OutDir} = 55 | get_option(outdir, AppDir1 ++ "ebin", Options1), 56 | 57 | file:make_dir(OutDir), 58 | 59 | AppName = filename:basename(AppDir), 60 | AppData = get_app_data_module(AppName), 61 | InitialAcc = 62 | case catch AppData:components() of 63 | {'EXIT', {undef, _}} -> {gb_trees:empty(), []}; 64 | LastControllers -> {LastControllers, []} 65 | end, 66 | 67 | {Options3, LastCompileTime} = 68 | get_option(last_compile_time,undefined, Options2), 69 | LastCompileTimeInSeconds = case LastCompileTime of % let's be liberal about the styles of Time that we accept 70 | Atom when is_atom(Atom) -> 71 | %% undefined, force, auto, etc; 72 | %% special values for 73 | %% should_compile 74 | Atom; 75 | GregorianSeconds when is_integer(GregorianSeconds) -> 76 | GregorianSeconds; 77 | {_,_,_} = NowTime -> 78 | calendar:datetime_to_gregorian_seconds( 79 | calendar:now_to_datetime(NowTime)); 80 | {{_,_,_},{_,_,_}} = DateTime -> 81 | %% any other time (including 82 | %% the default) should come in 83 | %% as a DateTime tuple 84 | calendar:datetime_to_gregorian_seconds(DateTime) 85 | end, 86 | 87 | AppControllerStr = AppName ++ "_app_controller", 88 | AppControllerFile = AppControllerStr ++ ".erl", 89 | AppControllerFilePath = AppDir1 ++ "src/" ++ AppControllerFile, 90 | case compile_file(AppControllerFilePath, 91 | AppControllerStr, ".erl", undefined, 92 | LastCompileTimeInSeconds, Options3, IncludePaths, Macros) of 93 | {ok, _} -> ok; 94 | {ok, _, _, _} -> ok; 95 | ok -> ok; 96 | Err -> ?Error("Error compiling app controller", []), 97 | exit(Err) 98 | end, 99 | 100 | AppController = list_to_atom(AppControllerStr), 101 | try_func(AppController, before_compile, [LastCompileTime], ok), 102 | 103 | ComponentsDir = http_util:to_lower(AppDir1 ++ "src/components"), 104 | {ComponentTree1, Models} = 105 | filelib:fold_files( 106 | AppDir1 ++ "src", "\.(erl|et)$", true, 107 | fun(FileName, Acc) -> 108 | if FileName =/= AppControllerFilePath -> 109 | compile_component_file( 110 | ComponentsDir, http_util:to_lower(FileName), 111 | LastCompileTimeInSeconds, Options3, IncludePaths, Macros, 112 | Acc); 113 | true -> 114 | Acc 115 | end 116 | end, InitialAcc), 117 | 118 | ErlyDBResult = 119 | case Models of 120 | [] -> ok; 121 | _ -> ?Debug("Generating ErlyDB code for models: ~p", 122 | [lists:flatten( 123 | [[filename:basename(Model), " "] || 124 | Model <- Models])]), 125 | case lists:keysearch(erlydb_driver, 1, Options3) of 126 | {value, {erlydb_driver, Drivers}} -> 127 | erlydb:code_gen(lists:reverse(Models), 128 | Drivers, 129 | Options3, IncludePaths, Macros); 130 | false -> {error, missing_erlydb_driver_option} 131 | end 132 | end, 133 | 134 | Result = 135 | if ErlyDBResult == ok -> 136 | AppDataModule = make_app_data_module( 137 | AppDir1, 138 | AppData, AppName, 139 | ComponentTree1, 140 | Options3), 141 | smerl:compile(AppDataModule, Options3); 142 | true -> ErlyDBResult 143 | end, 144 | 145 | if Result == ok -> 146 | try_func(AppController, after_compile, [LastCompileTime], 147 | ok), 148 | {ok, calendar:local_time()}; 149 | true -> Result 150 | end. 151 | 152 | set_default_option(Option, Override, Options) -> 153 | case lists:member(Override, Options) of 154 | true -> Options; 155 | false -> [Option | lists:delete(Option, 156 | Options)] 157 | end. 158 | 159 | get_option(Name, Default, Options) -> 160 | case lists:keysearch(Name, 1, Options) of 161 | {value, {_Name, Val}} -> {Options, Val}; 162 | false -> {[{Name, Default} | Options], Default} 163 | end. 164 | 165 | make_app_data_module(AppDir, AppData, AppName, 166 | ComponentTree, Options) -> 167 | M1 = smerl:new(AppData), 168 | {ok, M2} = 169 | smerl:add_func( 170 | M1, 171 | {function,1,components,0, 172 | [{clause,1,[],[], 173 | [erl_parse:abstract(ComponentTree)]}]}), 174 | 175 | {ok, M4} = smerl:add_func( 176 | M2, "get_view() -> " ++ AppName ++ "_app_view."), 177 | {ok, M5} = smerl:add_func( 178 | M4, "get_controller() -> " ++ 179 | AppName ++ "_app_controller."), 180 | 181 | AbsFunc = 182 | make_get_component_function(ComponentTree), 183 | 184 | {ok, M6} = smerl:add_func( 185 | M5, AbsFunc), 186 | 187 | {_Options1, AutoCompile} = 188 | get_option(auto_compile, false, Options), 189 | 190 | LastCompileTimeOpt = {last_compile_time, calendar:local_time()}, 191 | 192 | AutoCompileVal = 193 | case AutoCompile of 194 | false -> false; 195 | true -> 196 | Options1 = lists:keydelete(last_compile_time, 1, Options), 197 | Options2 = [LastCompileTimeOpt | Options1], 198 | {true, Options2} 199 | end, 200 | 201 | {ok, M7} = 202 | smerl:add_func( 203 | M6, {function,1,auto_compile,0, 204 | [{clause,1,[],[], 205 | [erl_parse:abstract(AutoCompileVal)]}]}), 206 | 207 | {ok, M8} = 208 | smerl:add_func( 209 | M7, "get_app_dir() -> \"" ++ AppDir ++ "\"."), 210 | 211 | M8. 212 | 213 | %% This function generates the abstract form for the 214 | %% AppData:get_component/3 function. 215 | %% 216 | %% This function's signature is: 217 | %% get_component(ComponentName::string() | atom(), FuncName::string() | atom(), 218 | %% Params::list()) -> 219 | %% {ok, {component, Controller::atom(), View::atom(), Params::list()}} | 220 | %% {error, no_such_component} | 221 | %% {error, no_such_function} 222 | make_get_component_function(ComponentTree) -> 223 | Clauses1 = 224 | lists:foldl( 225 | fun(ComponentStr, Acc) -> 226 | Exports = gb_trees:get(ComponentStr, ComponentTree), 227 | Clauses = make_clauses_for_component(ComponentStr, Exports), 228 | Clauses ++ Acc 229 | end, [], gb_trees:keys(ComponentTree)), 230 | Clauses2 = [{clause,1, 231 | [{var,1,'_'}, 232 | {var,1,'_'}, 233 | {var,1,'_'}], 234 | [], 235 | [{tuple,1, 236 | [{atom,1,error}, 237 | {atom,1,no_such_component}]}]} | Clauses1], 238 | %exit(lists:reverse(Clauses2)), 239 | {function,1,get_component,3,lists:reverse(Clauses2)}. 240 | 241 | 242 | %% This function generates the abstract form for the 243 | %% AppData:get_component/3 function clauses that apply to a the given 244 | %% component. 245 | make_clauses_for_component(ComponentStr, Exports) -> 246 | Clauses = 247 | lists:foldl( 248 | fun({Func, Arity}, Acc) -> 249 | Guards = 250 | [[{op,1,'==', 251 | {call,1,{atom,1,length}, 252 | [{var,1,'Params'}]}, 253 | {integer,1,Arity}}]], 254 | Body = get_body_for_func(ComponentStr, Func, 255 | {var,1,'Params'}), 256 | Clause1 = 257 | {clause,1, 258 | [{string,1,ComponentStr}, 259 | {string,1,atom_to_list(Func)}, 260 | {var,1,'Params'}], 261 | Guards, Body}, 262 | Clause2 = 263 | {clause,1, 264 | [{atom,1,list_to_atom(ComponentStr)}, 265 | {atom,1,Func}, 266 | {var,1,'Params'}], 267 | Guards, Body}, 268 | [Clause1, Clause2 | Acc] 269 | end, [], lists:keydelete(catch_all, 1, Exports)), 270 | addFinalClauses(Clauses, ComponentStr, Exports). 271 | 272 | get_body_for_func(ComponentStr, Func, Params) -> 273 | [{tuple,1, 274 | [{atom,1,ok}, 275 | {tuple,1, 276 | [{atom,1,ewc}, 277 | {atom,1, 278 | list_to_atom(ComponentStr ++ 279 | "_controller")}, 280 | {atom,1, 281 | list_to_atom(ComponentStr ++ "_view")}, 282 | {atom,1, Func}, 283 | Params]}]}]. 284 | 285 | 286 | addFinalClauses(Clauses, ComponentStr, Exports) -> 287 | {LastBody, FuncParam, ParamsParam} = 288 | case lists:member({catch_all,2}, Exports) of 289 | false -> 290 | {[{tuple,1, 291 | [{atom,1,error}, 292 | {atom,1,no_such_function}]}], 293 | '_Func', 294 | '_Params'}; 295 | true -> 296 | {get_body_for_func(ComponentStr, catch_all, 297 | {cons,1, 298 | {call,1,{atom,1,hd},[{var,1,'Params'}]}, 299 | {cons,1, 300 | {cons,1, 301 | {var,1,'Func'}, 302 | {call,1,{atom,1,tl},[{var,1,'Params'}]}}, 303 | {nil,1}}}), 304 | 'Func', 305 | 'Params'} 306 | 307 | end, 308 | LastClauses = 309 | [{clause,1, 310 | [{string,1,ComponentStr}, 311 | {var,1,FuncParam}, 312 | {var,1,ParamsParam}], 313 | [], 314 | LastBody}, 315 | {clause,1, 316 | [{atom,1,list_to_atom(ComponentStr)}, 317 | {var,1,FuncParam}, 318 | {var,1,ParamsParam}], 319 | [], 320 | LastBody}], 321 | LastClauses ++ Clauses. 322 | 323 | 324 | compile_component_file(ComponentsDir, FileName, LastCompileTimeInSeconds, 325 | Options, IncludePaths, Macros, {ComponentTree, Models} = Acc) -> 326 | BaseName = filename:rootname(filename:basename(FileName)), 327 | Extension = filename:extension(FileName), 328 | BaseNameTokens = string:tokens(BaseName, "_"), 329 | 330 | Type = case lists:prefix(ComponentsDir, 331 | FileName) of 332 | true -> 333 | case lists:last(BaseNameTokens) of 334 | "controller" -> controller; 335 | "view" -> view; 336 | _ -> model 337 | end; 338 | false -> 339 | other 340 | end, 341 | case {compile_file(FileName, BaseName, Extension, Type, 342 | LastCompileTimeInSeconds, Options, IncludePaths, Macros), 343 | Type} of 344 | {{ok, Module}, controller} -> 345 | [{exports, Exports} | _] = 346 | Module:module_info(), 347 | Exports1 = 348 | lists:foldl( 349 | fun({Name, _}, Acc1) 350 | when Name == before_return; 351 | Name == before_call; 352 | Name == module_info -> 353 | Acc1; 354 | ({_, 0}, Acc1) -> 355 | Acc1; 356 | ({Name, Arity}, Acc1) -> 357 | [{Name, Arity} | Acc1] 358 | end, [], Exports), 359 | {ActionName, _} = lists:split(length(BaseName) - 11, 360 | BaseName), 361 | {gb_trees:enter( 362 | ActionName, Exports1, ComponentTree), 363 | Models}; 364 | {{ok, _Module}, model} -> 365 | {ComponentTree, [FileName | Models]}; 366 | {{ok, _Module}, _} -> Acc; 367 | {ok, _} -> Acc; 368 | {Err, _} -> exit(Err) 369 | end. 370 | 371 | compile_file(_FileName, [$. | _] = BaseName, _Extension, _Type, 372 | _LastCompileTimeInSeconds, _Options, _IncludePaths, _Macros) -> 373 | ?Debug("Ignoring file ~p", [BaseName]), 374 | {ok, ignore}; 375 | compile_file(FileName, BaseName, Extension, Type, 376 | LastCompileTimeInSeconds, Options, IncludePaths, Macros) -> 377 | case should_compile(FileName,BaseName,LastCompileTimeInSeconds) of 378 | true -> 379 | case Extension of 380 | ".et" -> 381 | ?Debug("Compiling ErlTL file ~p", [BaseName]), 382 | erltl:compile(FileName, 383 | Options ++ [nowarn_unused_vars] ++ 384 | [{i, P} || P <- IncludePaths]); 385 | ".erl" -> 386 | ?Debug("Compiling Erlang file ~p", [BaseName]), 387 | compile_file(FileName, BaseName, Type, Options, 388 | IncludePaths, Macros) 389 | end; 390 | false -> 391 | ok; 392 | {error, _} = Err1 -> 393 | Err1 394 | end. 395 | 396 | compile_file(FileName, BaseName, Type, Options, IncludePaths) -> 397 | compile_file(FileName, BaseName, Type, Options, IncludePaths, []). 398 | 399 | compile_file(FileName, BaseName, Type, Options, IncludePaths, Macros) -> 400 | case smerl:for_file(FileName, IncludePaths, Macros) of 401 | {ok, M1} -> 402 | M2 = add_forms(Type, BaseName, M1), 403 | case smerl:compile(M2, Options) of 404 | ok -> 405 | {ok, smerl:get_module(M2)}; 406 | Err -> 407 | Err 408 | end; 409 | Err -> 410 | Err 411 | end. 412 | 413 | %%% Determine whether a given file should be compiled based on the 414 | %%% last time it was compiled. In the event of 415 | %%% {last_compile_time,auto}, we'll try some dirty tricks to see 416 | %%% whether we should do it. 417 | should_compile(_FileName,_BaseName,force) -> true; 418 | should_compile(_FileName,_BaseName,undefined) -> true; 419 | should_compile(FileName, _BaseName,LastCompileTimeInSeconds) when is_integer(LastCompileTimeInSeconds) -> 420 | case file:read_file_info(FileName) of 421 | {ok,FileInfo} -> 422 | Mtime = calendar:datetime_to_gregorian_seconds(FileInfo#file_info.mtime), 423 | 424 | Mtime >= LastCompileTimeInSeconds; 425 | {error,_} = Error -> 426 | Error 427 | end; 428 | should_compile(FileName,BaseName,auto) -> 429 | case file:read_file_info(FileName) of 430 | {ok,FileInfo} -> 431 | Mtime = calendar:datetime_to_gregorian_seconds(FileInfo#file_info.mtime), 432 | 433 | %% Here are our dirty tricks for determining whether to 434 | %% re-compile. In general, since these are dirty hacks, if 435 | %% they fail we should just fall back to say "Yes, compile 436 | %% the damn thing". Our goal is basically to locate the 437 | %% module, see if it's compiled, then ask its BEAM header 438 | %% when it was built. 439 | 440 | %% try to locate the atom of the BaseName, which should be 441 | %% the module name. 442 | case catch(list_to_existing_atom(BaseName)) of 443 | ModuleAtom when is_atom(ModuleAtom) -> 444 | %% and try to locate the actual module, then 445 | %% extract the last compile time 446 | case catch( 447 | lists:keysearch( 448 | time,1, 449 | ModuleAtom:module_info(compile))) of 450 | {value, 451 | {time, 452 | {Year,Month,Day,Hour,Minute,Second}}} -> 453 | %% now take that time, compare it to the 454 | %% last modified time, and return the 455 | %% result of the comparison 456 | 457 | %% compile-time is in universal time, but 458 | %% mtime is in local time 459 | CompileTime = 460 | calendar:universal_time_to_local_time( 461 | {{Year,Month,Day}, 462 | {Hour,Minute,Second}}), 463 | Mtime >= calendar:datetime_to_gregorian_seconds(CompileTime); 464 | _ -> 465 | %% some part of finding the last 466 | %% compile-time failed 467 | should_compile(FileName,BaseName,undefined) 468 | end; 469 | _ -> 470 | %% since the atom wasn't found, the module is not 471 | %% loaded, and hence not queriable 472 | should_compile(FileName,BaseName,undefined) 473 | end; 474 | {error,_} = Error -> 475 | Error 476 | end. 477 | 478 | add_forms(controller, BaseName, MetaMod) -> 479 | M2 = case smerl:get_attribute(MetaMod, erlyweb_magic) of 480 | {ok, Val} -> 481 | Base = case Val of 482 | on -> erlyweb_controller; 483 | Other -> Other 484 | end, 485 | {ModelNameStr, _} = lists:split(length(BaseName) - 11, 486 | BaseName), 487 | ModelName = list_to_atom(ModelNameStr), 488 | M1 = smerl:extend(Base, MetaMod, 1), 489 | smerl:embed_all(M1, [{'Model', ModelName}]); 490 | _ -> MetaMod 491 | end, 492 | M3 = add_func(M2, private, 0, "private() -> false."), 493 | M4 = add_func(M3, before_call, 2, 494 | "before_call(FuncName, Params) -> " 495 | "{FuncName, Params}."), 496 | M5 = add_func(M4, before_return, 3, 497 | "before_return(_FuncName, _Params, Response) -> " 498 | "Response."), 499 | add_func(M5, after_render, 3, 500 | "after_render(_FuncName, _Params, _Response) -> ok."); 501 | add_forms(view, BaseName, MetaMod) -> 502 | add_forms1(erlyweb_view, BaseName, MetaMod); 503 | add_forms(_, BaseName, MetaMod) -> 504 | add_forms1(undefined, BaseName, MetaMod). 505 | 506 | add_forms1(SubstitutionMod, BaseName, MetaMod) -> 507 | case smerl:get_attribute(MetaMod, erlyweb_magic) of 508 | {ok, Val} -> 509 | Base = case Val of 510 | on -> if SubstitutionMod == undefined -> 511 | exit({invalid_erlyweb_magic_declaration, 512 | {in_module, BaseName}, 513 | "only controllers and views may " 514 | "declare '-erlyweb_magic(on).'"}); 515 | true -> 516 | SubstitutionMod 517 | end; 518 | Other -> Other 519 | end, 520 | smerl:extend(Base, MetaMod); 521 | _ -> MetaMod 522 | end. 523 | 524 | 525 | add_func(MetaMod, Name, Arity, Str) -> 526 | case smerl:get_func(MetaMod, Name, Arity) of 527 | {ok, _} -> 528 | MetaMod; 529 | {error, _} -> 530 | {ok, M1} = smerl:add_func( 531 | MetaMod, Str), 532 | M1 533 | end. 534 | 535 | get_app_data_module(AppName) when is_atom(AppName) -> 536 | get_app_data_module(atom_to_list(AppName)); 537 | get_app_data_module(AppName) when is_list(AppName) -> 538 | list_to_atom(AppName ++ "_erlyweb_data"). 539 | 540 | try_func(Module, FuncName, Params, Default) -> 541 | case catch apply(Module, FuncName, Params) of 542 | {'EXIT', {undef, [{Module, FuncName, _} | _]}} -> Default; 543 | {'EXIT', Err} -> exit(Err); 544 | Val -> Val 545 | end. 546 | 547 | -------------------------------------------------------------------------------- /src/erlyweb/erlyweb_controller.erl: -------------------------------------------------------------------------------- 1 | %% @author Yariv Sadan (yarivsblog@gmail.com, http://yarivsblog.com) 2 | %% 3 | %% @hidden 4 | %% @doc This file contains basic CRUD controller logic. It's intended 5 | %% for demonstration purposes, but not for production use. 6 | 7 | %% For license information see LICENSE.txt 8 | 9 | -module(erlyweb_controller). 10 | -author("Yariv Sadan (yarivsblog@gmail.com, http://yarivsblog.com)"). 11 | 12 | -export([ 13 | index/2, 14 | list/2, 15 | list/3, 16 | new/2, 17 | edit/3, 18 | delete/3 19 | ]). 20 | 21 | -define(RECORDS_PER_PAGE, 10). 22 | 23 | index(_A, Model) -> 24 | {ewr, Model, list, [1]}. 25 | 26 | list(A, Model) -> 27 | list(A, Model, 1). 28 | 29 | list(A, Model, Page) when is_list(Page) -> 30 | list(A, Model, list_to_integer(Page)); 31 | 32 | list(A, Model, Page) when is_integer(Page) -> 33 | Records = Model:find_range((Page - 1) * ?RECORDS_PER_PAGE, 34 | ?RECORDS_PER_PAGE), 35 | 36 | %% this function makes the 'edit' links in the record ids 37 | ToIoListFun = 38 | fun(Val, Field) -> 39 | case erlydb_field:name(Field) of 40 | id -> 41 | Id = Model:field_to_iolist(Val), 42 | erlyweb_html:a( 43 | [case erlyweb:get_app_root(A) of 44 | "/" -> ""; 45 | Root -> Root 46 | end, 47 | atom_to_list(Model), 48 | <<"edit">>, Id], Id); 49 | _ -> 50 | default 51 | end 52 | end, 53 | {data, {erlyweb:get_app_root(A), 54 | atom_to_list(Model), 55 | Model:db_field_names_bin(), 56 | Model:to_iolist(Records, ToIoListFun)}}. 57 | 58 | new(A, Model) -> 59 | Rec = Model:new(), 60 | new_or_edit(A, Model, Rec). 61 | 62 | edit(A, Model, Id) -> 63 | Rec = Model:find_id(Id), 64 | new_or_edit(A, Model, Rec). 65 | 66 | new_or_edit(A, Model, Record) -> 67 | Fields = tl(Model:db_fields()), 68 | Vals = tl(Model:to_iolist(Record)), 69 | Combined = lists:zip(Fields, Vals), 70 | IdStr = case Model:id(Record) of 71 | undefined -> []; 72 | Id -> integer_to_list(Id) 73 | end, 74 | case yaws_arg:method(A) of 75 | 'GET' -> 76 | FieldData = [{erlydb_field:name_bin(Field), 77 | erlydb_field:html_input_type(Field), 78 | erlydb_field:modifier(Field), 79 | Val} || {Field, Val} <- Combined], 80 | {data, {erlyweb:get_app_root(A), 81 | atom_to_list(Model), 82 | IdStr, 83 | yaws_arg:server_path(A), 84 | FieldData}}; 85 | 'POST' -> 86 | NewVals = yaws_api:parse_post(A), 87 | Record1 = Model:set_fields_from_strs(Record, NewVals), 88 | Model:save(Record1), 89 | {ewr, Model, list} 90 | end. 91 | 92 | delete(A, Model, Id) -> 93 | case yaws_arg:method(A) of 94 | 'GET' -> 95 | Record = Model:find_id(Id), 96 | Fields = [erlydb_field:name_bin(Field) || 97 | Field <- Model:db_fields()], 98 | Vals = Model:to_iolist(Record), 99 | Combined = 100 | lists:zipwith( 101 | fun(Field, Val) -> [Field, Val] end, 102 | Fields, Vals), 103 | 104 | {data, {erlyweb:get_app_root(A), 105 | atom_to_list(Model), Id, 106 | Combined}}; 107 | 'POST' -> 108 | Model:delete_id(Id), 109 | {ewr, Model, list} 110 | end. 111 | 112 | -------------------------------------------------------------------------------- /src/erlyweb/erlyweb_forms.erl: -------------------------------------------------------------------------------- 1 | %% 2 | %% @doc This module contains a few functions useful when working with 3 | %% HTML forms in ErlyWeb. 4 | %% 5 | %% @author Yariv Sadan [http://yarivsblog.com)] 6 | %% @copyright Yariv Sadan 2006-2007 7 | 8 | 9 | %% For license information see LICENSE.txt 10 | -module(erlyweb_forms). 11 | -export([to_recs/2, validate/3, validate1/3, validate_rec/2]). 12 | 13 | %% @doc to_recs/2 helps process POST requests containing fields that 14 | %% belong to multiple records from one or more ErlyDB models. 15 | %% 16 | %% This function is useful when {@link erlydb_base:new_fields_from_strs/3} 17 | %% isn't sufficient because the latter is only designed to map POST 18 | %% parameters to the fields of a single record. 19 | %% 20 | %% This function expects each form field to be mapped to its corresponding 21 | %% record by being named with a unique prefix identifying 22 | %% the record to which the form field belongs. 23 | %% 24 | %% For example, suppose you have to process an HTML form whose fields 25 | %% represent a house and 2 cars. The house's fields have the 26 | %% prefix "house_" and the cars' fields have the prefixes "car1_" and 27 | %% "car2_". The arg's POST parameters are 28 | %% `[{"house_rooms", "3"}, {"car1_year", "2007"}, {"car2_year", "2006"}]'. 29 | %% With such a setup, calling `to_recs(A, [{"house_", house}, {"car1_", car}, 30 | %% {"car2_", car}])' 31 | %% returns the list `[House, Car1, Car2]', where `house:rooms(House) == "3"', 32 | %% `car:year(Car1) == "2007"' and `car:year(Car2) == "2006"'. All other 33 | %% fields are `undefined'. 34 | %% 35 | %% @spec to_recs(A::arg() | [{ParamName::string(), ParamVal::term()}], 36 | %% [{Prefix::string(), Model::atom()}]) -> [Record::tuple()] 37 | to_recs(A, ModelDescs) when is_tuple(A), element(1, A) == arg -> 38 | to_recs(yaws_api:parse_post(A), ModelDescs); 39 | to_recs(Params, ModelDescs) -> 40 | Models = 41 | [{Prefix, Model, Model:new()} || {Prefix, Model} <- ModelDescs], 42 | Models1 = 43 | lists:foldl( 44 | fun({Name, Val}, Acc) -> 45 | case lists:splitwith( 46 | fun({Prefix2, _Module2, _Rec2}) -> 47 | not lists:prefix(Prefix2, Name) 48 | end, Acc) of 49 | {_, []} -> 50 | Acc; 51 | {First, [{Prefix1, Model1, Rec} | Rest]} -> 52 | {_, FieldName} = lists:split(length(Prefix1), Name), 53 | Field = erlydb_field:name(Model1:db_field(FieldName)), 54 | Val1 = case Val of 55 | undefined -> ""; 56 | _ -> Val 57 | end, 58 | First ++ [{Prefix1, Model1, 59 | Model1:Field(Rec, Val1)} | Rest] 60 | end 61 | end, Models, Params), 62 | [element(3, Model3) || Model3 <- Models1]. 63 | 64 | %% @doc validate/3 helps validate the inputs of arbitary forms. 65 | %% It accepts a Yaws arg 66 | %% (or the arg's POST data in the form of a name-value property list), a 67 | %% list of parameter names to validate, and a validation function, and returns 68 | %% a tuple of the form {Values, Errors}. 69 | %% 'Values' contains the list of values for the checked parameters 70 | %% and 'Errors' is a list of errors returned from the validation function. 71 | %% If no validation errors occured, this list is empty. 72 | %% 73 | %% If the name of a field is missing from the arg's POST data, this function 74 | %% calls exit({missing_param, Name}). 75 | %% 76 | %% The validation function takes two parameters: the parameter name and 77 | %% its value, and it may return one of the following values: 78 | %% 79 | %% - `ok' means the parameter's value is valid 80 | %% 81 | %% - `{ok, Val}' means the parameter's value is valid, and it also lets you 82 | %% set the value inserted into 'Values' for this parameter. 83 | %% 84 | %% - `{error, Err}' indicates the parameter didn't validate. Err is inserted 85 | %% into 'Errors'. 86 | %% 87 | %% - `{error, Err, Val}' indicates the parameter didn't validate. Err is 88 | %% inserted into 'Errors' and Val is inserted into 'Values' instead of 89 | %% the parameter's original value. 90 | %% 91 | %% For forms that modify or create ErlyDB records, it's generally more 92 | %% convenient to use {@link to_recs/2}. 93 | %% 94 | %% @spec validate(A::arg() | proplist(), Fields::[string()], 95 | %% Fun::function()) -> {Values::[term()], Errors::[term()]} | 96 | %% exit({missing_param, Field}) 97 | validate(A, Fields, Fun) when is_tuple(A), element(1, A) == arg -> 98 | validate(yaws_api:parse_post(A), Fields, Fun); 99 | validate(Params, Fields, Fun) -> 100 | lists:foldr( 101 | fun(Field, Acc) -> 102 | case proplists:lookup(Field, Params) of 103 | none -> exit({missing_param, Field}); 104 | {_, Val} -> 105 | check_val(Field, Val, Fun,Acc) 106 | end 107 | end, {[], []}, Fields). 108 | 109 | %% @doc validate1/3 is similar to validate/3, but it expects the parameter 110 | %% list to match the field list both in the number of elements and in their 111 | %% order. validate1/3 is more efficient and is also stricter than validate/3. 112 | %% @see validate/3 113 | %% 114 | %% @spec validate1(Params::proplist() | arg(), Fields::[string()], 115 | %% Fun::function()) -> {Vals, Errs} | exit({missing_params, [string()]}) | 116 | %% exit({unexpected_params, proplist()}) | exit({unexpected_param, string()}) 117 | validate1(A, Fields, Fun) when is_tuple(A), element(1, A) == arg -> 118 | validate1(yaws_api:parse_post(A), Fields, Fun); 119 | validate1(Params, Fields, Fun) -> 120 | validate1_1(Params, Fields, Fun, {[], []}). 121 | 122 | validate1_1([], [], _Fun, {Vals, Errs}) -> 123 | {lists:reverse(Vals), lists:reverse(Errs)}; 124 | validate1_1([], Fields, _Fun, _Acc) -> exit({missing_params, Fields}); 125 | validate1_1(Params, [], _Fun, _Acc) -> exit({unexpected_params, Params}); 126 | validate1_1([{Field, Val} | Params], [Field | Fields], Fun, Acc) -> 127 | Acc1 = check_val(Field, Val, Fun, Acc), 128 | validate1_1(Params, Fields, Fun, Acc1); 129 | validate1_1([{Param, _} | _Params], [Field | _], _Fun, _Acc) -> 130 | exit({unexpected_param, Field, Param}). 131 | 132 | check_val(Field, Val, Fun, {Vals, Errs}) -> 133 | Val1 = case Val of undefined -> ""; _ -> Val end, 134 | case Fun(Field, Val1) of 135 | ok -> 136 | {[Val1 | Vals], Errs}; 137 | {ok, Val2} -> 138 | {[Val2 | Vals], Errs}; 139 | {error, Err, Val2} -> 140 | {[Val2 | Vals], [Err | Errs]}; 141 | {error, Err} -> 142 | {[Val1 | Vals], [Err | Errs]} 143 | end. 144 | 145 | 146 | %% @doc When a form has fields that correspond to the fields of an ErlyDB 147 | %% record, validate_rec/2 helps validate the values of the record's fields. 148 | %% 149 | %% validate_rec/2 accepts an ErlyDB record and a validation function. 150 | %% It folds over all the fields of the record (obtained by calling 151 | %% {@link erlydb_base:db_field_names/0}), calling the validation function 152 | %% with each field's existing value. The validation function's 153 | %% return value indicates if the field's value is valid, 154 | %% and it may also define the record field's final value. 155 | %% 156 | %% The result of validate_rec/2 is a tuple of the form `{Rec1, Errs}', where 157 | %% the first element is the modified record and the second element is 158 | %% a list of errors accumulated by the calls to the validation function. 159 | %% 160 | %% The validation function takes 3 parameters: the field name (an atom), 161 | %% the current value (this can be any term, but it's usually a string, 162 | %% especially if the record came from {@link to_recs/2}), and the record 163 | %% after folding over all the previous fields. It returns 164 | %% `ok', `{ok, NewVal}', `{error, Err}', or `{error, Err, NewVal}'. 165 | %% 166 | %% validate_rec/2 is especially useful in conjunction with {@link to_recs/2}. 167 | %% A common pattern is to create the records for the submitted form using 168 | %% to_recs/2 and then validate their fields using validate_rec/2. 169 | %% 170 | %% @spec validate_rec(Rec::erlydb_record(), Fun::function()) -> 171 | %% {Rec1::erlydb_record(), Errs::[term()]} 172 | validate_rec(Rec, Fun) -> 173 | Module = element(1, Rec), 174 | {Rec1, Errs} = 175 | lists:foldl( 176 | fun(Field, {Rec1, Errs1} = Acc) -> 177 | case Fun(Field, 178 | Module:Field(Rec1), Rec1) of 179 | ok -> 180 | Acc; 181 | {ok, NewVal} -> 182 | {Module:Field(Rec1, NewVal), 183 | Errs1}; 184 | {error, Err} -> 185 | {Rec1, [Err | Errs1]}; 186 | {error, Err, NewVal} -> 187 | {Module:Field(Rec1, NewVal), 188 | [Err | Errs1]} 189 | end 190 | end, {Rec, []}, Module:db_field_names()), 191 | {Rec1, lists:reverse(Errs)}. 192 | -------------------------------------------------------------------------------- /src/erlyweb/erlyweb_html.et: -------------------------------------------------------------------------------- 1 | <%~ 2 | 3 | %% @title erlyweb_html.et 4 | %% @doc This file contains functions for generating common HTML elements. 5 | %% You can import them into your templates or use them directly. 6 | %% 7 | %% @license for license information see LICENSE.txt 8 | 9 | -author("Yariv Sadan (yarivsblog@gmail.com, http://yarivsblog.com"). 10 | 11 | %% A helper function 12 | join(Args) -> 13 | join(Args, []). 14 | 15 | join([], Acc) -> []; 16 | join([Last], Acc) -> 17 | lists:reverse([Last | Acc]); 18 | join([First | Rest], Acc) -> 19 | join(Rest, [[First, $/] | Acc]). 20 | %> 21 | 22 | <%@ a(PathElems, Text) %><% Text %><%@ a(PathElems, Text, Props) %>>,Value,<<"\"">>] || {Name, Value} <- Props] %>><% 24 | Text %><%@ table(Records) %> 25 | <% table(Records, undefined) %> 26 | 27 | <%@ table(Records, Headers) %> 28 | 29 | <% headers(Headers) %> 30 | <% [row(R) || R <- Records] %> 31 |
32 | 33 | <%@ headers(undefined) %> 34 | <%@ headers(Headers) %> 35 | <% [header(H) || H <- Headers] %> 36 | 37 | <%@ header(Data) %> 38 | <% Data %> 39 | <%@ row(Data) %> 40 | <% [cell(C) || C <- Data] %> 41 | <%@ cell(Data) %> 42 | <% Data %> 43 | 44 | <%@ form(Action, Function, Fields) %> 45 |
46 | 47 | <% [field(F) || F <- Fields] %> 48 | 49 | 50 | 51 |
52 |
53 | 54 | <%@ field({Name, Type, Modifier, Val} = Field) %> 55 | <% Name %><% input(Name, Type, Modifier, Val) %> 56 | 57 | <%@ input(Name) %><% input(Name, text_field, undefined, []) %> 58 | <%@ input(Name, text_area, _Modifier, Val) %> 59 | 60 | 61 | <%@ input(Name, text_field, undefined, Val) %> 62 | 63 | 64 | <%@ input(Name, text_field, MaxLength, Val) %> 65 | 66 | 67 | <%@ input(Name, select, Options, Val) %> 68 | 69 | 70 | <%@ option(Name, Name) %> 71 | 72 | 73 | <%@ option(Name, _Val) %> 74 | 75 | 76 | <%@ img(Src, Width, Height) %> 77 | -------------------------------------------------------------------------------- /src/erlyweb/erlyweb_util.erl: -------------------------------------------------------------------------------- 1 | %% 2 | %% @doc This module contains a few utility functions useful 3 | %% for ErlyWeb apps. 4 | %% 5 | %% @author Yariv Sadan [http://yarivsblog.com)] 6 | %% @copyright Yariv Sadan 2006-2007 7 | 8 | 9 | %% For license information see LICENSE.txt 10 | 11 | -module(erlyweb_util). 12 | -author("Yariv Sadan (yarivsblog@gmail.com, http://yarivsblog.com"). 13 | -export([log/5, create_app/2, create_component/3, 14 | get_url_prefix/1, 15 | get_cookie/2, indexify/2]). 16 | 17 | -define(Debug(Msg, Params), log(?MODULE, ?LINE, debug, Msg, Params)). 18 | -define(Info(Msg, Params), log(?MODULE, ?LINE, info, Msg, Params)). 19 | -define(Error(Msg, Params), log(?MODULE, ?LINE, error, Msg, Params)). 20 | 21 | %% @hidden 22 | log(Module, Line, Level, Msg, Params) -> 23 | io:format("~p:~p:~p: " ++ Msg, [Level, Module, Line] ++ Params), 24 | io:format("~n"). 25 | 26 | %% @hidden 27 | create_app(AppName, Dir) -> 28 | case filelib:is_dir(Dir) of 29 | true -> 30 | AppDir = Dir ++ "/" ++ AppName, 31 | Dirs = 32 | [SrcDir, ComponentsDir, WebDir, _EbinDir] 33 | = [AppDir ++ "/src", 34 | AppDir ++ "/src/components", 35 | AppDir ++ "/www", 36 | AppDir ++ "/ebin"], 37 | lists:foreach( 38 | fun(SubDir) -> 39 | ?Info("creating ~p", [SubDir]), 40 | case file:make_dir(SubDir) of 41 | ok -> 42 | ok; 43 | Err -> 44 | exit(Err) 45 | end 46 | end, [AppDir | Dirs]), 47 | 48 | Files = 49 | [{ComponentsDir ++ "/html_container_view.et", 50 | html_container_view(AppName)}, 51 | {ComponentsDir ++ "/html_container_controller.erl", 52 | html_container_controller()}, 53 | {SrcDir ++ "/" ++ AppName ++ "_app_controller.erl", 54 | app_controller(AppName)}, 55 | {WebDir ++ "/index.html", 56 | index(AppName)}, 57 | {WebDir ++ "/style.css", 58 | css()}], 59 | lists:foreach( 60 | fun({FileName, Bin}) -> 61 | create_file(FileName, Bin) 62 | end, Files), 63 | ok; 64 | false -> 65 | ?Error("~p isn't a directory", [Dir]), 66 | exit({invalid_directory, Dir}) 67 | end. 68 | 69 | create_file(FileName, Bin) -> 70 | ?Info("creating ~p", [FileName]), 71 | case file:open(FileName, [read]) of 72 | {ok, File} -> 73 | file:close(File), 74 | exit({already_exists, FileName}); 75 | _ -> 76 | case file:write_file(FileName, Bin) of 77 | ok -> 78 | ok; 79 | Err -> 80 | exit({Err, FileName}) 81 | end 82 | end. 83 | 84 | app_controller(AppName) -> 85 | Text = 86 | ["-module(", AppName, "_app_controller).\n" 87 | "-export([hook/1]).\n\n" 88 | "hook(A) ->\n" 89 | "\t{phased, {ewc, A},\n" 90 | "\t\tfun(_Ewc, Data, _PhasedVars) ->\n" 91 | "\t\t\t{ewc, html_container, index, [A, {data, Data}]}\n" 92 | "\t\tend}."], 93 | iolist_to_binary(Text). 94 | 95 | html_container_controller() -> 96 | Text = 97 | ["-module(html_container_controller).\n" 98 | "-export([private/0, index/2]).\n\n" 99 | "private() ->\n" 100 | "\ttrue.\n\n" 101 | "index(_A, Ewc) ->\n" 102 | "\tEwc."], 103 | iolist_to_binary(Text). 104 | 105 | html_container_view(AppName) -> 106 | Text = 107 | ["<%@ index(Data) %>\n" 108 | "\n" 109 | "\n" 110 | "", AppName, "\n" 111 | "\n" 113 | "\n" 114 | "\n" 115 | "\n" 116 | "
\n" 117 | "

", AppName, " app

\n" 118 | "<% Data %>\n" 119 | "
\n" 120 | "
\n" 121 | "powered by ErlyWeb" 122 | " / Yaws\n" 123 | "
\n" 124 | "
\n" 125 | "\n" 126 | "\n"], 127 | iolist_to_binary(Text). 128 | 129 | 130 | index(AppName) -> 131 | Text = 132 | ["\n" 133 | "\n" 134 | "\n" 135 | "", AppName, "\n\n", 136 | "\n" 137 | "
\n" 138 | "Welcome to '", AppName, "', your new " 139 | "ErlyWeb " 140 | "app.

\n" 141 | "Let the Erlang " 142 | "hacking begin!\n" 143 | "
\n", 144 | "\n"], 145 | iolist_to_binary(Text). 146 | 147 | css() -> 148 | Text = 149 | "body {\n" 150 | " font-family: arial, verdana, helvetica, sans-serif;\n" 151 | " color: #353535;\n" 152 | " margin:10px 0px; padding:0px;\n" 153 | " text-align:center;\n" 154 | "}\n\n" 155 | "#Content {\n" 156 | " width:80%;\n" 157 | " margin:0px auto;\n" 158 | " text-align:left;\n" 159 | " padding:15px;\n" 160 | "} \n" 161 | "H1 {font-size: 1.5em;}", 162 | iolist_to_binary(Text). 163 | 164 | magic_declaration("", _) -> 165 | ""; 166 | magic_declaration(MagicStr, controller) -> 167 | "-erlyweb_magic(" ++ MagicStr ++"_controller)."; 168 | magic_declaration(MagicStr, {erltl, off}) -> 169 | "-erlyweb_magic(" ++ MagicStr ++"_view)."; 170 | magic_declaration(MagicStr, {erltl, on}) -> 171 | "<%~ -erlyweb_magic(" ++ MagicStr ++ "_view). %>". 172 | 173 | view_declaration(ComponentName, {ertl, off}) -> 174 | "-module(" ++ ComponentName ++ "_view).\n"; 175 | view_declaration(_ComponentName, {ertl, on}) -> 176 | "". 177 | 178 | view_filename(ComponentName, {ertl, off}) -> 179 | ComponentName ++ "_view.erl"; 180 | view_filename(ComponentName, {ertl, on}) -> 181 | ComponentName ++ "_view.et". 182 | 183 | model_filename(_ComponentName, {model, off}) -> 184 | ""; 185 | model_filename(ComponentName, {model, on}) -> 186 | ComponentName ++ ".erl". 187 | 188 | %% @hidden 189 | create_component(ComponentName, AppDir, Options) -> 190 | {Magic, Model, Erltl} = {proplists:get_value(magic, Options, on), 191 | proplists:get_value(model, Options, on), 192 | proplists:get_value(erltl, Options, off)}, 193 | 194 | if (Magic == on) andalso (Model == off) -> 195 | exit({bad_options, "Can't have magic without a model."}); 196 | true -> 197 | void 198 | end, 199 | 200 | MagicStr = if Magic == on -> 201 | "erlyweb"; 202 | Magic == off -> 203 | ""; 204 | true -> 205 | if is_atom(Magic) -> 206 | atom_to_list(Magic); 207 | true -> 208 | Magic 209 | end 210 | end, 211 | 212 | %% Remove empty filenames from the list. 213 | Files = lists:filter(fun({"", _Bin}) -> false; 214 | (_) -> true end, 215 | [{model_filename(ComponentName, {model, Model}), 216 | "-module(" ++ ComponentName ++ ")."}, 217 | {ComponentName ++ "_controller.erl", 218 | "-module(" ++ ComponentName ++ "_controller).\n" ++ 219 | magic_declaration(MagicStr, controller)}, 220 | {view_filename(ComponentName, {ertl, Erltl}), 221 | view_declaration(ComponentName, {ertl, Erltl}) ++ 222 | magic_declaration(MagicStr, {erltl, Erltl})}]), 223 | 224 | lists:foreach( 225 | fun({FileName, Text}) -> 226 | create_file(AppDir ++ "/src/components/" ++ FileName, Text) 227 | end, Files). 228 | 229 | %% @doc Get the of the arg's appmoddata value up to the 230 | %% first '?' symbol. 231 | %% 232 | %% @spec get_url_prefix(A::arg()) -> string() 233 | get_url_prefix(A) -> 234 | lists:dropwhile( 235 | fun($?) -> true; 236 | (_) -> false 237 | end, yaws_arg:appmoddata(A)). 238 | 239 | 240 | %% @doc Get the cookie's value from the arg. 241 | %% @equiv yaws_api:find_cookie_val(Name, yaws_headers:cookie(A)) 242 | %% 243 | %% @spec get_cookie(Name::string(), A::arg()) -> string() 244 | get_cookie(Name, A) -> 245 | yaws_api:find_cookie_val( 246 | Name, yaws_headers:cookie(A)). 247 | 248 | %% @doc Translate requests such as '/foo/bar' to '/foo/index/bar' for the given 249 | %% list of components. This function is useful for rewriting the Arg in the 250 | %% app controller prior to handling incoming requests. 251 | %% 252 | %% @deprecated This function is deprecated. Implement catch_all/3 in your 253 | %% controllers instead. 254 | %% 255 | %% @spec indexify(A::arg(), ComponentNames::[string()]) -> arg() 256 | indexify(A, ComponentNames) -> 257 | Appmod = yaws_arg:appmoddata(A), 258 | Sp = yaws_arg:server_path(A), 259 | 260 | Appmod1 = indexify1(Appmod, ComponentNames), 261 | A1 = yaws_arg:appmoddata(A, Appmod1), 262 | 263 | {SpRoot, _} = lists:split(length(Sp) - length(Appmod), Sp), 264 | yaws_arg:server_path(A1, SpRoot ++ Appmod1). 265 | 266 | 267 | indexify1(S1, []) -> S1; 268 | indexify1(S1, [Prefix | Others]) -> 269 | case indexify2(S1, [$/ | Prefix]) of 270 | stop -> S1; 271 | {stop, Postfix} -> 272 | [$/ | Prefix] ++ "/index" ++ Postfix; 273 | next -> 274 | indexify1(S1, Others) 275 | end. 276 | 277 | indexify2([], []) -> stop; 278 | indexify2([$/ | _] = Postfix, []) -> {stop, Postfix}; 279 | indexify2([C1 | Rest1], [C1 | Rest2]) -> 280 | indexify2(Rest1, Rest2); 281 | indexify2(_, _) -> next. 282 | -------------------------------------------------------------------------------- /src/erlyweb/erlyweb_view.et: -------------------------------------------------------------------------------- 1 | <%~ 2 | %% @title erlyweb_view.et 3 | %% @doc This is a generic view template for making simple CRUD 4 | %% pages with ErlyWeb. It's intended for demonstration purposes, 5 | %% but not for production use. 6 | %% 7 | %% @license for license information see LICENSE.txt 8 | 9 | -author("Yariv Sadan (yarivsblog@gmail.com, http://yarivsblog.com)"). 10 | -import(erlyweb_html, [a/2, table/1, table/2, form/3]). 11 | %> 12 | 13 | <%@ list({AppRoot, Model, Fields, Records}) %> 14 | <% a([AppRoot, Model, <<"new">>], <<"create new">>) %>

15 | Records of '<% Model %>'
16 | <% table(Records, Fields) %> 17 | 18 | <%@ new({_AppRoot, Model, _Id, Action, FieldData}) %> 19 | Create a new <% Model %>:
20 | <% form(Action, <<"new">>, FieldData) %> 21 | 22 | <%@ edit({AppRoot, Model, Id, Action, FieldData}) %> 23 | <% a([AppRoot, Model, <<"delete">>, Id], <<"delete">>) %> 24 |

25 | <% form(Action, <<"edit">>, FieldData) %> 26 | 27 | <%@ delete({AppRoot, Model, Id, Combined}) %> 28 | Are you sure you want to delete this <% Model %>? 29 | <% table(Combined) %> 30 |
32 | 33 | 35 |
36 | -------------------------------------------------------------------------------- /src/erlyweb/yaws_arg.erl: -------------------------------------------------------------------------------- 1 | %% @author Yariv Sadan [http://yarivsblog.com] 2 | %% @copyright Yariv Sadan 2006-2007 3 | %% 4 | %% @doc 5 | %% This module provides functions for getting and setting 6 | %% values of a Yaws 'arg' record. You can use these functions 7 | %% instead of using the record access syntax, and without 8 | %% having to include yaws_api.hrl. 9 | %% 10 | %% Most functions have two forms: one for getting the value of a field and 11 | %% one for setting it. Getters accept the record as a parameter and return 12 | %% the value of its field. Setters take 13 | %% two parameters -- the record and the new value -- and return a new record 14 | %% with the modified value. 15 | %% 16 | %% @end 17 | 18 | %% For license information see LICENSE.txt 19 | 20 | -module(yaws_arg). 21 | -author("Yariv Sadan (yarivsblog@gmail.com)"). 22 | 23 | -export([new/0, 24 | add_to_opaque/2, add_all_to_opaque/2, get_opaque_val/2, 25 | clisock/1, clisock/2, client_ip_port/1, client_ip_port/2, 26 | headers/1, headers/2, req/1, req/2, 27 | method/1, clidata/1, clidata/2, server_path/1, server_path/2, 28 | querydata/1, querydata/2, appmoddata/1, appmoddata/2, docroot/1, 29 | docroot/2, fullpath/1, fullpath/2, cont/1, cont/2, state/1, 30 | state/2, pid/1, pid/2, opaque/1, opaque/2, appmod_prepath/1, 31 | appmod_prepath/2, pathinfo/1, pathinfo/2]). 32 | -include("yaws_api.hrl"). 33 | 34 | %% @doc Create a new 'arg' record. 35 | new() -> 36 | #arg{}. 37 | 38 | %% @equiv Arg#arg{opaque = [Val | A#arg.opaque]} 39 | add_to_opaque(Arg, Val) -> 40 | Arg#arg{opaque = [Val | Arg#arg.opaque]}. 41 | 42 | %% @doc applies add_to_opaque for all values in the list 43 | %% 44 | %% @spec add_all_to_opaque(A::arg(), Vals::[term()]) -> arg() 45 | add_all_to_opaque(A, Vals) -> 46 | lists:foldl( 47 | fun(Val, A1) -> 48 | add_to_opaque(A1, Val) 49 | end, A, Vals). 50 | 51 | %% @doc Return the value corrsponding to the Key in the opaque proplist. 52 | %% If the key isn't found, return 'undefined'. 53 | %% 54 | %% @spec get_opaque_val(A::arg(), Key::term()) -> term() | undefined 55 | get_opaque_val(A, Key) -> 56 | proplists:get_value(Key, yaws_arg:opaque(A)). 57 | 58 | clisock(Arg) -> 59 | Arg#arg.clisock. 60 | 61 | clisock(Arg, Val) -> 62 | Arg#arg{clisock = Val}. 63 | 64 | client_ip_port(Arg) -> 65 | Arg#arg.client_ip_port. 66 | 67 | client_ip_port(Arg, Val) -> 68 | Arg#arg{client_ip_port = Val}. 69 | 70 | headers(Arg) -> 71 | Arg#arg.headers. 72 | 73 | headers(Arg, Val) -> 74 | Arg#arg{headers = Val}. 75 | 76 | req(Arg) -> 77 | Arg#arg.req. 78 | 79 | req(Arg, Val) -> 80 | Arg#arg{req = Val}. 81 | 82 | method(Arg) -> 83 | (Arg#arg.req)#http_request.method. 84 | 85 | clidata(Arg) -> 86 | Arg#arg.clidata. 87 | 88 | clidata(Arg, Val) -> 89 | Arg#arg{clidata = Val}. 90 | 91 | server_path(Arg) -> 92 | Arg#arg.server_path. 93 | 94 | server_path(Arg, Val) -> 95 | Arg#arg{server_path = Val}. 96 | 97 | querydata(Arg) -> 98 | Arg#arg.querydata. 99 | 100 | querydata(Arg, Val) -> 101 | Arg#arg{querydata = Val}. 102 | 103 | appmoddata(Arg) -> 104 | Arg#arg.appmoddata. 105 | 106 | appmoddata(Arg, Val) -> 107 | Arg#arg{appmoddata = Val}. 108 | 109 | docroot(Arg) -> 110 | Arg#arg.docroot. 111 | 112 | docroot(Arg, Val) -> 113 | Arg#arg{docroot = Val}. 114 | 115 | fullpath(Arg) -> 116 | Arg#arg.fullpath. 117 | 118 | fullpath(Arg, Val) -> 119 | Arg#arg{fullpath = Val}. 120 | 121 | cont(Arg) -> 122 | Arg#arg.cont. 123 | 124 | cont(Arg, Val) -> 125 | Arg#arg{cont = Val}. 126 | 127 | state(Arg) -> 128 | Arg#arg.state. 129 | 130 | state(Arg, Val) -> 131 | Arg#arg{state = Val}. 132 | 133 | pid(Arg) -> 134 | Arg#arg.pid. 135 | 136 | pid(Arg, Val) -> 137 | Arg#arg{pid = Val}. 138 | 139 | opaque(Arg) -> 140 | Arg#arg.opaque. 141 | 142 | opaque(Arg, Val) -> 143 | Arg#arg{opaque = Val}. 144 | 145 | appmod_prepath(Arg) -> 146 | Arg#arg.appmod_prepath. 147 | 148 | appmod_prepath(Arg, Val) -> 149 | Arg#arg{appmod_prepath = Val}. 150 | 151 | pathinfo(Arg) -> 152 | Arg#arg.pathinfo. 153 | 154 | pathinfo(Arg, Val) -> 155 | Arg#arg{pathinfo = Val}. 156 | -------------------------------------------------------------------------------- /src/erlyweb/yaws_headers.erl: -------------------------------------------------------------------------------- 1 | %% @author Roberto Saccon 2 | %% 3 | %% @doc This module provides functions for getting and setting 4 | %% values of the Yaws 'headers' record. You can use these functions 5 | %% instead of using the record access syntax, and without 6 | %% having to include yaws_api.hrl. 7 | %% 8 | %% As with {@link yaws_arg}, most functions have 2 variations: if it takes 9 | %% 1 parameter, it returns the record's value for the field, and if it 10 | %% takes two parameters, it returns a new record with the field having the 11 | %% new value. 12 | 13 | %% For license information see LICENSE.txt 14 | 15 | -module(yaws_headers). 16 | -author("Roberto Saccon (rsaccon@gmail.com)"). 17 | 18 | -export([new/0, connection/1, connection/2, accept/1, accept/2, 19 | host/1, host/2, 20 | if_modified_since/1, if_modified_since/2, if_match/1, if_match/2, 21 | if_none_match/1, if_none_match/2, if_range/1, if_range/2, 22 | if_unmodified_since/1, if_unmodified_since/2, 23 | range/1, range/2, referer/1, referer/2, user_agent/1, user_agent/2, 24 | accept_ranges/1, accept_ranges/2, cookie/1, cookie/2, keep_alive/1, 25 | keep_alive/2, content_length/1, content_length/2, 26 | content_type/1, content_type/2, 27 | authorization/1, 28 | authorization/2, other/1, other/2]). 29 | 30 | 31 | -include("yaws_api.hrl"). 32 | 33 | %% @doc Create a new 'headers' record. 34 | new() -> 35 | #headers{}. 36 | 37 | connection(Arg) -> 38 | (Arg#arg.headers)#headers.connection. 39 | 40 | connection(Arg, Val) -> 41 | (Arg#arg.headers)#headers{connection = Val}. 42 | 43 | accept(Arg) -> 44 | (Arg#arg.headers)#headers.accept. 45 | 46 | accept(Arg, Val) -> 47 | (Arg#arg.headers)#headers{accept = Val}. 48 | 49 | host(Arg) -> 50 | (Arg#arg.headers)#headers.host. 51 | 52 | host(Arg, Val) -> 53 | (Arg#arg.headers)#headers{host=Val}. 54 | 55 | if_modified_since(Arg) -> 56 | (Arg#arg.headers)#headers.if_modified_since. 57 | 58 | if_modified_since(Arg, Val) -> 59 | (Arg#arg.headers)#headers{if_modified_since = Val}. 60 | 61 | if_match(Arg) -> 62 | (Arg#arg.headers)#headers.if_match. 63 | 64 | if_match(Arg, Val) -> 65 | (Arg#arg.headers)#headers{if_match = Val}. 66 | 67 | if_none_match(Arg) -> 68 | (Arg#arg.headers)#headers.if_none_match. 69 | 70 | if_none_match(Arg, Val) -> 71 | (Arg#arg.headers)#headers{if_none_match = Val}. 72 | 73 | if_range(Arg) -> 74 | (Arg#arg.headers)#headers.if_range. 75 | 76 | if_range(Arg, Val) -> 77 | (Arg#arg.headers)#headers{if_range = Val}. 78 | 79 | if_unmodified_since(Arg) -> 80 | (Arg#arg.headers)#headers.if_unmodified_since. 81 | 82 | if_unmodified_since(Arg, Val) -> 83 | (Arg#arg.headers)#headers{if_unmodified_since = Val}. 84 | 85 | range(Arg) -> 86 | (Arg#arg.headers)#headers.range. 87 | 88 | range(Arg, Val) -> 89 | (Arg#arg.headers)#headers{range = Val}. 90 | 91 | referer(Arg) -> 92 | (Arg#arg.headers)#headers.referer. 93 | 94 | referer(Arg, Val) -> 95 | (Arg#arg.headers)#headers{referer = Val}. 96 | 97 | user_agent(Arg) -> 98 | (Arg#arg.headers)#headers.user_agent. 99 | 100 | user_agent(Arg, Val) -> 101 | (Arg#arg.headers)#headers{user_agent = Val}. 102 | 103 | accept_ranges(Arg) -> 104 | (Arg#arg.headers)#headers.accept_ranges. 105 | 106 | accept_ranges(Arg, Val) -> 107 | (Arg#arg.headers)#headers{accept_ranges = Val}. 108 | 109 | cookie(Arg) -> 110 | (Arg#arg.headers)#headers.cookie. 111 | 112 | cookie(Arg, Val) -> 113 | (Arg#arg.headers)#headers{cookie = Val}. 114 | 115 | keep_alive(Arg) -> 116 | (Arg#arg.headers)#headers.keep_alive. 117 | 118 | keep_alive(Arg, Val) -> 119 | (Arg#arg.headers)#headers{keep_alive = Val}. 120 | 121 | content_length(Arg) -> 122 | (Arg#arg.headers)#headers.content_length. 123 | 124 | content_length(Arg, Val) -> 125 | (Arg#arg.headers)#headers{content_length = Val}. 126 | 127 | content_type(Arg) -> 128 | (Arg#arg.headers)#headers.content_type. 129 | 130 | content_type(Arg, Val) -> 131 | (Arg#arg.headers)#headers{content_type = Val}. 132 | 133 | authorization(Arg) -> 134 | (Arg#arg.headers)#headers.authorization. 135 | 136 | authorization(Arg, Val) -> 137 | (Arg#arg.headers)#headers{authorization = Val}. 138 | 139 | other(Arg) -> 140 | (Arg#arg.headers)#headers.other. 141 | 142 | other(Arg, Val) -> 143 | (Arg#arg.headers)#headers{other = Val}. 144 | -------------------------------------------------------------------------------- /src/lib/mochinum.erl: -------------------------------------------------------------------------------- 1 | %% @copyright 2007 Mochi Media, Inc. 2 | %% @author Bob Ippolito 3 | 4 | %% @doc Useful numeric algorithms for floats that cover some deficiencies 5 | %% in the math module. More interesting is digits/1, which implements 6 | %% the algorithm from: 7 | %% http://www.cs.indiana.edu/~burger/fp/index.html 8 | %% See also "Printing Floating-Point Numbers Quickly and Accurately" 9 | %% in Proceedings of the SIGPLAN '96 Conference on Programming Language 10 | %% Design and Implementation. 11 | 12 | -module(mochinum). 13 | -author("Bob Ippolito "). 14 | -export([digits/1, frexp/1, int_pow/2, int_ceil/1, test/0]). 15 | 16 | %% IEEE 754 Float exponent bias 17 | -define(FLOAT_BIAS, 1022). 18 | -define(MIN_EXP, -1074). 19 | -define(BIG_POW, 4503599627370496). 20 | 21 | %% External API 22 | 23 | %% @spec digits(number()) -> string() 24 | %% @doc Returns a string that accurately represents the given integer or float 25 | %% using a conservative amount of digits. Great for generating 26 | %% human-readable output, or compact ASCII serializations for floats. 27 | digits(N) when is_integer(N) -> 28 | integer_to_list(N); 29 | digits(0.0) -> 30 | "0.0"; 31 | digits(Float) -> 32 | {Frac, Exp} = frexp(Float), 33 | Exp1 = Exp - 53, 34 | Frac1 = trunc(abs(Frac) * (1 bsl 53)), 35 | [Place | Digits] = digits1(Float, Exp1, Frac1), 36 | R = insert_decimal(Place, [$0 + D || D <- Digits]), 37 | case Float < 0 of 38 | true -> 39 | [$- | R]; 40 | _ -> 41 | R 42 | end. 43 | 44 | %% @spec frexp(F::float()) -> {Frac::float(), Exp::float()} 45 | %% @doc Return the fractional and exponent part of an IEEE 754 double, 46 | %% equivalent to the libc function of the same name. 47 | %% F = Frac * pow(2, Exp). 48 | frexp(F) -> 49 | frexp1(unpack(F)). 50 | 51 | %% @spec int_pow(X::integer(), N::integer()) -> Y::integer() 52 | %% @doc Moderately efficient way to exponentiate integers. 53 | %% int_pow(10, 2) = 100. 54 | int_pow(_X, 0) -> 55 | 1; 56 | int_pow(X, N) when N > 0 -> 57 | int_pow(X, N, 1). 58 | 59 | %% @spec int_ceil(F::float()) -> integer() 60 | %% @doc Return the ceiling of F as an integer. The ceiling is defined as 61 | %% F when F == trunc(F); 62 | %% trunc(F) when F < 0; 63 | %% trunc(F) + 1 when F > 0. 64 | int_ceil(X) -> 65 | T = trunc(X), 66 | case (X - T) of 67 | Neg when Neg < 0 -> T; 68 | Pos when Pos > 0 -> T + 1; 69 | _ -> T 70 | end. 71 | 72 | 73 | %% Internal API 74 | 75 | int_pow(X, N, R) when N < 2 -> 76 | R * X; 77 | int_pow(X, N, R) -> 78 | int_pow(X * X, N bsr 1, case N band 1 of 1 -> R * X; 0 -> R end). 79 | 80 | insert_decimal(0, S) -> 81 | "0." ++ S; 82 | insert_decimal(Place, S) when Place > 0 -> 83 | L = length(S), 84 | case Place - L of 85 | 0 -> 86 | S ++ ".0"; 87 | N when N < 0 -> 88 | {S0, S1} = lists:split(L + N, S), 89 | S0 ++ "." ++ S1; 90 | N when N < 6 -> 91 | %% More places than digits 92 | S ++ lists:duplicate(N, $0) ++ ".0"; 93 | _ -> 94 | insert_decimal_exp(Place, S) 95 | end; 96 | insert_decimal(Place, S) when Place > -6 -> 97 | "0." ++ lists:duplicate(abs(Place), $0) ++ S; 98 | insert_decimal(Place, S) -> 99 | insert_decimal_exp(Place, S). 100 | 101 | insert_decimal_exp(Place, S) -> 102 | [C | S0] = S, 103 | S1 = case S0 of 104 | [] -> 105 | "0"; 106 | _ -> 107 | S0 108 | end, 109 | Exp = case Place < 0 of 110 | true -> 111 | "e-"; 112 | false -> 113 | "e+" 114 | end, 115 | [C] ++ "." ++ S1 ++ Exp ++ integer_to_list(abs(Place - 1)). 116 | 117 | 118 | digits1(Float, Exp, Frac) -> 119 | Round = ((Frac band 1) =:= 0), 120 | case Exp >= 0 of 121 | true -> 122 | BExp = 1 bsl Exp, 123 | case (Frac /= ?BIG_POW) of 124 | true -> 125 | scale((Frac * BExp * 2), 2, BExp, BExp, 126 | Round, Round, Float); 127 | false -> 128 | scale((Frac * BExp * 4), 4, (BExp * 2), BExp, 129 | Round, Round, Float) 130 | end; 131 | false -> 132 | case (Exp == ?MIN_EXP) orelse (Frac /= ?BIG_POW) of 133 | true -> 134 | scale((Frac * 2), 1 bsl (1 - Exp), 1, 1, 135 | Round, Round, Float); 136 | false -> 137 | scale((Frac * 4), 1 bsl (2 - Exp), 2, 1, 138 | Round, Round, Float) 139 | end 140 | end. 141 | 142 | scale(R, S, MPlus, MMinus, LowOk, HighOk, Float) -> 143 | Est = int_ceil(math:log10(abs(Float)) - 1.0e-10), 144 | %% Note that the scheme implementation uses a 326 element look-up table 145 | %% for int_pow(10, N) where we do not. 146 | case Est >= 0 of 147 | true -> 148 | fixup(R, S * int_pow(10, Est), MPlus, MMinus, Est, 149 | LowOk, HighOk); 150 | false -> 151 | Scale = int_pow(10, -Est), 152 | fixup(R * Scale, S, MPlus * Scale, MMinus * Scale, Est, 153 | LowOk, HighOk) 154 | end. 155 | 156 | fixup(R, S, MPlus, MMinus, K, LowOk, HighOk) -> 157 | TooLow = case HighOk of 158 | true -> 159 | (R + MPlus) >= S; 160 | false -> 161 | (R + MPlus) > S 162 | end, 163 | case TooLow of 164 | true -> 165 | [(K + 1) | generate(R, S, MPlus, MMinus, LowOk, HighOk)]; 166 | false -> 167 | [K | generate(R * 10, S, MPlus * 10, MMinus * 10, LowOk, HighOk)] 168 | end. 169 | 170 | generate(R0, S, MPlus, MMinus, LowOk, HighOk) -> 171 | D = R0 div S, 172 | R = R0 rem S, 173 | TC1 = case LowOk of 174 | true -> 175 | R =< MMinus; 176 | false -> 177 | R < MMinus 178 | end, 179 | TC2 = case HighOk of 180 | true -> 181 | (R + MPlus) >= S; 182 | false -> 183 | (R + MPlus) > S 184 | end, 185 | case TC1 of 186 | false -> 187 | case TC2 of 188 | false -> 189 | [D | generate(R * 10, S, MPlus * 10, MMinus * 10, 190 | LowOk, HighOk)]; 191 | true -> 192 | [D + 1] 193 | end; 194 | true -> 195 | case TC2 of 196 | false -> 197 | [D]; 198 | true -> 199 | case R * 2 < S of 200 | true -> 201 | [D]; 202 | false -> 203 | [D + 1] 204 | end 205 | end 206 | end. 207 | 208 | unpack(Float) -> 209 | <> = <>, 210 | {Sign, Exp, Frac}. 211 | 212 | frexp1({_Sign, 0, 0}) -> 213 | {0.0, 0}; 214 | frexp1({Sign, 0, Frac}) -> 215 | Exp = log2floor(Frac), 216 | <> = <>, 217 | {Frac1, -(?FLOAT_BIAS) - 52 + Exp}; 218 | frexp1({Sign, Exp, Frac}) -> 219 | <> = <>, 220 | {Frac1, Exp - ?FLOAT_BIAS}. 221 | 222 | log2floor(Int) -> 223 | log2floor(Int, 0). 224 | 225 | log2floor(0, N) -> 226 | N; 227 | log2floor(Int, N) -> 228 | log2floor(Int bsr 1, 1 + N). 229 | 230 | 231 | test() -> 232 | ok = test_frexp(), 233 | ok = test_int_ceil(), 234 | ok = test_int_pow(), 235 | ok = test_digits(), 236 | ok. 237 | 238 | test_int_ceil() -> 239 | 1 = int_ceil(0.0001), 240 | 0 = int_ceil(0.0), 241 | 1 = int_ceil(0.99), 242 | 1 = int_ceil(1.0), 243 | -1 = int_ceil(-1.5), 244 | -2 = int_ceil(-2.0), 245 | ok. 246 | 247 | test_int_pow() -> 248 | 1 = int_pow(1, 1), 249 | 1 = int_pow(1, 0), 250 | 1 = int_pow(10, 0), 251 | 10 = int_pow(10, 1), 252 | 100 = int_pow(10, 2), 253 | 1000 = int_pow(10, 3), 254 | ok. 255 | 256 | test_digits() -> 257 | "0" = digits(0), 258 | "0.0" = digits(0.0), 259 | "1.0" = digits(1.0), 260 | "-1.0" = digits(-1.0), 261 | "0.1" = digits(0.1), 262 | "0.01" = digits(0.01), 263 | "0.001" = digits(0.001), 264 | ok. 265 | 266 | test_frexp() -> 267 | %% zero 268 | {0.0, 0} = frexp(0.0), 269 | %% one 270 | {0.5, 1} = frexp(1.0), 271 | %% negative one 272 | {-0.5, 1} = frexp(-1.0), 273 | %% small denormalized number 274 | %% 4.94065645841246544177e-324 275 | <> = <<0,0,0,0,0,0,0,1>>, 276 | {0.5, -1073} = frexp(SmallDenorm), 277 | %% large denormalized number 278 | %% 2.22507385850720088902e-308 279 | <> = <<0,15,255,255,255,255,255,255>>, 280 | {0.99999999999999978, -1022} = frexp(BigDenorm), 281 | %% small normalized number 282 | %% 2.22507385850720138309e-308 283 | <> = <<0,16,0,0,0,0,0,0>>, 284 | {0.5, -1021} = frexp(SmallNorm), 285 | %% large normalized number 286 | %% 1.79769313486231570815e+308 287 | <> = <<127,239,255,255,255,255,255,255>>, 288 | {0.99999999999999989, 1024} = frexp(LargeNorm), 289 | ok. 290 | -------------------------------------------------------------------------------- /test/Emakefile: -------------------------------------------------------------------------------- 1 | {"erlyweb/*", [debug_info, {outdir, "../ebin"}]}. 2 | {"erlydb/*", [debug_info, {outdir, "../ebin"}]}. 3 | -------------------------------------------------------------------------------- /test/erltl/album.et: -------------------------------------------------------------------------------- 1 | <%~ 2 | %% date: 10/21/2006 3 | -author("Yariv Sadan"). 4 | -import(widgets, [foo/1, bar/2, baz/3]). 5 | %> 6 | <%! This is a sample ErlTL template that renders a list of albums %> 7 | 8 | 9 | <% [album(A) || A <- Data] %> 10 | 11 | 12 | 13 | <%@ album({Title, Artist, Songs}) %> 14 | Title: <% Title %>
15 | Artist: <% Artist %>
16 | Songs:
17 | 18 | <% [song(Number, Name) || {Number, Name} <- Songs] %> 19 |
20 | 21 | <%@ song(Number, Name) when size(Name) > 15 %> 22 | <%? <> = Name %> 23 | <% song(Number, [First, <<"...">>]) %> 24 | 25 | <%@ song(Number, Name) %> 26 | <%? 27 | Class = 28 | case Number rem 2 of 29 | 0 -> <<"even">>; 30 | 1 -> <<"odd">> 31 | end 32 | %> 33 | 34 | <% integer_to_list(Number) %> 35 | <% Name %> 36 | 37 | -------------------------------------------------------------------------------- /test/erltl/test_erltl.erl: -------------------------------------------------------------------------------- 1 | -module(test_erltl). 2 | -export([test/0, test/1]). 3 | 4 | test() -> 5 | test("album.et"). 6 | 7 | test(AlbumTemplate) -> 8 | erltl:compile(AlbumTemplate), 9 | album:render( 10 | [{<<"Abbey Road">>, <<"The Beatles">>, 11 | [{1, <<"Come Together">>}, 12 | {2, <<"Something">>}, 13 | {3, <<"Maxwell's Silver Hammer">>}, 14 | {4, <<"Oh! Darling">>}, 15 | {5, <<"Octopus's Garden">>}, 16 | {6, <<"I Want You (She's So Heavy)">>}]}]). 17 | -------------------------------------------------------------------------------- /test/erlydb/customer.erl: -------------------------------------------------------------------------------- 1 | -module(customer). 2 | -compile(export_all). 3 | 4 | relations() -> 5 | [{many_to_many, [customer]}]. 6 | -------------------------------------------------------------------------------- /test/erlydb/developer.erl: -------------------------------------------------------------------------------- 1 | -module(developer). 2 | -export([relations/0, 3 | % fields/0, 4 | fields/0, 5 | table/0, 6 | type_field/0, 7 | after_fetch/1, 8 | before_save/1, 9 | after_save/1, 10 | before_delete/1, 11 | after_delete/1]). 12 | 13 | relations() -> 14 | [{many_to_many, [project]}]. 15 | 16 | table() -> 17 | person. 18 | 19 | fields() -> 20 | [name, country]. 21 | 22 | type_field() -> 23 | type. 24 | 25 | %fields() -> 26 | % [name]. 27 | 28 | log(Msg, Rec) -> 29 | io:format(Msg, [Rec]), 30 | io:format("~n", []). 31 | 32 | after_fetch(Developer) -> 33 | log("after fetch: ~p", Developer), 34 | Developer. 35 | 36 | 37 | before_save(Developer) -> 38 | log("before save: ~p", Developer), 39 | Developer. 40 | 41 | after_save(Developer) -> 42 | log("after save: ~p", Developer), 43 | Developer. 44 | 45 | before_delete(Developer) -> 46 | log("before delete: ~p", Developer), 47 | Developer. 48 | 49 | after_delete(Developer) -> 50 | log("after delete: ~p", Developer), 51 | Developer. 52 | -------------------------------------------------------------------------------- /test/erlydb/employee.erl: -------------------------------------------------------------------------------- 1 | -module(employee). 2 | -export([table/0, fields/0, type_field/0]). 3 | 4 | table() -> 5 | person. 6 | fields() -> 7 | person:fields() ++ [office, department]. 8 | type_field() -> 9 | type. 10 | -------------------------------------------------------------------------------- /test/erlydb/erlydb.sql: -------------------------------------------------------------------------------- 1 | drop table if exists language; 2 | drop table if exists project; 3 | drop table if exists person; 4 | drop table if exists person_project; 5 | drop table if exists customer; 6 | drop table if exists store; 7 | drop table if exists item; 8 | drop table if exists customer_store; 9 | drop table if exists customer_customer; 10 | 11 | create table language ( 12 | id integer auto_increment primary key, 13 | name varchar(30), 14 | description text, 15 | paradigm varchar(30), 16 | creation_year integer) 17 | type=InnoDB; 18 | 19 | create table project ( 20 | id integer auto_increment primary key, 21 | name varchar(30), 22 | description text, 23 | language_id integer, 24 | index(language_id)) 25 | type=InnoDB; 26 | 27 | 28 | CREATE TABLE person ( 29 | id integer auto_increment primary key, 30 | type char(10), 31 | name varchar(30), 32 | age integer, 33 | country varchar(20), 34 | office integer, 35 | department varchar(30), 36 | genre varchar(30), 37 | instrument varchar(30), 38 | created_on timestamp, 39 | index(type) 40 | ) type =InnoDB; 41 | 42 | create table person_project( 43 | person_id integer, 44 | project_id integer, 45 | primary key(person_id, project_id)) 46 | type=InnoDB; 47 | 48 | 49 | create table store ( 50 | number integer, 51 | name char(20), 52 | primary key(number, name)) 53 | type = InnoDB; 54 | 55 | create table item ( 56 | size integer, 57 | name char(20), 58 | store_name char(20), 59 | store_number integer, 60 | primary key(size, name)) 61 | type = InnoDB; 62 | 63 | create table customer ( 64 | id integer auto_increment primary key, 65 | name char(20)) 66 | type = InnoDB; 67 | 68 | create table customer_store ( 69 | store_number integer, 70 | store_name char(20), 71 | customer_id integer, 72 | primary key(store_number, store_name, customer_id)) 73 | type = InnoDB; 74 | 75 | create table customer_customer ( 76 | customer_id1 integer, 77 | customer_id2 integer, 78 | primary key(customer_id1, customer_id2) 79 | ) type= InnoDB; 80 | 81 | -------------------------------------------------------------------------------- /test/erlydb/erlydb_mnesia_schema.erl: -------------------------------------------------------------------------------- 1 | -module(erlydb_mnesia_schema). 2 | 3 | %% 4 | %% Include files 5 | %% 6 | 7 | %% 8 | %% Exported Functions 9 | %% 10 | -export([start/0, up/0, down/0]). 11 | 12 | 13 | -record(language, { 14 | id, 15 | name, 16 | description, 17 | paradigm, 18 | creation_year}). 19 | 20 | 21 | -record(project, { 22 | id, 23 | name, 24 | description, 25 | language_id}). 26 | 27 | 28 | -record(person, { 29 | id, 30 | type, 31 | name, 32 | age, 33 | country, 34 | office, 35 | department, 36 | genre, 37 | instrument, 38 | created_on}). 39 | 40 | 41 | -record(person_project, { 42 | person_id, 43 | project_id}). 44 | 45 | 46 | -record(store, { 47 | number, 48 | name}). 49 | 50 | 51 | -record(item, { 52 | size, 53 | name, 54 | store_name, 55 | store_number}). 56 | 57 | 58 | -record(customer, { 59 | id, 60 | name}). 61 | 62 | 63 | -record(customer_store, { 64 | store_number, 65 | store_name, 66 | customer_id}). 67 | 68 | 69 | -record(customer_customer, { 70 | customer_id1, 71 | customer_id2}). 72 | 73 | 74 | %% 75 | %% API Functions 76 | %% 77 | start() -> 78 | case mnesia:system_info(is_running) of 79 | no -> mnesia:start(); 80 | _ -> ok 81 | % this could fail if system_info returns the atom stopping 82 | end. 83 | 84 | 85 | up() -> 86 | ok = start(), 87 | 88 | mnesia:create_table(counter, [{disc_copies, [node()]}, {attributes, [key, counter]}]), 89 | 90 | % User_properties for field is defined as: 91 | % {Field, {Type, Modifier}, Null, Key, Default, Extra, MnesiaType} 92 | % where Field is an atom, 93 | % Type through Extra is are as defined in erlydb_field:new/6 94 | % MnesiaType is the type to store the field as in mnesia. 95 | 96 | {atomic, ok} = mnesia:create_table(language, [ 97 | {disc_copies, [node()]}, 98 | {attributes, record_info(fields, language)}, 99 | {user_properties, [{creation_year, {integer, undefined}, true, undefined, undefined, undefined, integer}]}]), 100 | 101 | {atomic, ok} = mnesia:create_table(project, [ 102 | {disc_copies, [node()]}, 103 | {attributes, record_info(fields, project)}]), 104 | 105 | {atomic, ok} = mnesia:create_table(person, [ 106 | {disc_copies, [node()]}, 107 | {attributes, record_info(fields, person)}, 108 | {user_properties, [{age, {integer, undefined}, true, undefined, undefined, undefined, integer}]}]), 109 | 110 | {atomic, ok} = mnesia:create_table(person_project, [ 111 | {type, bag}, 112 | {disc_copies, [node()]}, 113 | {attributes, record_info(fields, person_project)}]), 114 | 115 | {atomic, ok} = mnesia:create_table(customer, [ 116 | {disc_copies, [node()]}, 117 | {attributes, record_info(fields, customer)}]), 118 | 119 | {atomic, ok} = mnesia:create_table(store, [ 120 | {type, bag}, 121 | {disc_copies, [node()]}, 122 | {attributes, record_info(fields, store)}, 123 | {user_properties, [{number, {integer, undefined}, false, primary, undefined, undefined, integer}]}]), 124 | 125 | {atomic, ok} = mnesia:create_table(item, [ 126 | {type, bag}, 127 | {disc_copies, [node()]}, 128 | {attributes, record_info(fields, item)}, 129 | {user_properties, [{size, {integer, undefined}, false, primary, undefined, undefined, integer}, 130 | {name, {varchar, undefined}, false, primary, undefined, undefined, binary}, 131 | {store_number, {integer, undefined}, true, undefined, undefined, undefined, integer}]}]), 132 | 133 | {atomic, ok} = mnesia:create_table(customer_store, [ 134 | {type, bag}, 135 | {disc_copies, [node()]}, 136 | {attributes, record_info(fields, customer_store)}]), 137 | 138 | {atomic, ok} = mnesia:create_table(customer_customer, [ 139 | {type, bag}, 140 | {disc_copies, [node()]}, 141 | {attributes, record_info(fields, customer_customer)}, 142 | {user_properties, [{customer_id1, {integer, undefined}, false, primary, undefined, undefined, integer}, 143 | {customer_id2, {integer, undefined}, false, primary, undefined, undefined, integer}]}]), 144 | ok. 145 | 146 | 147 | down() -> 148 | ok = start(), 149 | mnesia:delete_table(counter), 150 | 151 | mnesia:delete_table(language), 152 | mnesia:delete_table(project), 153 | mnesia:delete_table(person), 154 | mnesia:delete_table(person_project), 155 | mnesia:delete_table(customer), 156 | mnesia:delete_table(store), 157 | mnesia:delete_table(item), 158 | mnesia:delete_table(customer_store), 159 | mnesia:delete_table(customer_customer), 160 | ok. 161 | 162 | -------------------------------------------------------------------------------- /test/erlydb/erlydb_psql.sql: -------------------------------------------------------------------------------- 1 | DROP TABLE language; 2 | DROP TABLE project; 3 | DROP TABLE person; 4 | DROP TABLE person_project; 5 | DROP TABLE customer; 6 | DROP TABLE store; 7 | DROP TABLE item; 8 | DROP TABLE customer_store; 9 | DROP TABLE customer_customer; 10 | 11 | 12 | CREATE TABLE language ( 13 | id SERIAL PRIMARY KEY, 14 | name VARCHAR(30), 15 | description TEXT, 16 | paradigm VARCHAR(30), 17 | creation_year INTEGER 18 | ); 19 | 20 | CREATE TABLE project ( 21 | id SERIAL PRIMARY KEY, 22 | name VARCHAR(30), 23 | description TEXT, 24 | language_id INTEGER 25 | ); 26 | 27 | CREATE TABLE person ( 28 | id SERIAL PRIMARY KEY, 29 | type VARCHAR(10), 30 | name VARCHAR(30), 31 | age INTEGER, 32 | country VARCHAR(20), 33 | office INTEGER, 34 | department VARCHAR(30), 35 | genre VARCHAR(30), 36 | instrument VARCHAR(30), 37 | created_on TIMESTAMP 38 | ); 39 | 40 | CREATE TABLE person_project( 41 | person_id INTEGER, 42 | project_id INTEGER, 43 | PRIMARY KEY (person_id, project_id) 44 | ); 45 | 46 | 47 | CREATE TABLE store ( 48 | number INTEGER, 49 | name VARCHAR(20), 50 | PRIMARY KEY (number, name) 51 | ); 52 | 53 | 54 | CREATE TABLE item ( 55 | size INTEGER, 56 | name VARCHAR(20), 57 | store_name VARCHAR(20), 58 | store_number INTEGER, 59 | PRIMARY KEY(size, name) 60 | ); 61 | 62 | CREATE TABLE customer ( 63 | id SERIAL PRIMARY KEY, 64 | name VARCHAR(20) 65 | ); 66 | 67 | CREATE TABLE customer_store ( 68 | store_number INTEGER, 69 | store_name VARCHAR(20), 70 | customer_id INTEGER, 71 | PRIMARY KEY(store_number, store_name, customer_id) 72 | ); 73 | 74 | CREATE TABLE customer_customer ( 75 | customer_id1 INTEGER, 76 | customer_id2 INTEGER, 77 | PRIMARY KEY(customer_id1, customer_id2) 78 | ); -------------------------------------------------------------------------------- /test/erlydb/erlydb_test.erl: -------------------------------------------------------------------------------- 1 | %% @title Test code for ErlyDB 2 | %% 3 | %% @author Yariv Sadan (yarivvv@gmail.com, http://yarivsblog.com) 4 | 5 | -module(erlydb_test). 6 | -author("Yariv Sadan"). 7 | -export( 8 | [erlydb_mysql_init/0, 9 | erlydb_mnesia_init/0, 10 | erlydb_psql_init/0, 11 | test/0, 12 | test/1]). 13 | 14 | -define(L(Obj), io:format("LOG ~w ~p\n", [?LINE, Obj])). 15 | -define(S(Obj), io:format("LOG ~w ~s\n", [?LINE, Obj])). 16 | 17 | 18 | erlydb_mysql_init() -> 19 | %% connect to the database 20 | erlydb:start(mysql, 21 | [{hostname, "localhost"}, 22 | {username, "root"}, 23 | {password, "password"}, 24 | {database, "test"}]). 25 | 26 | erlydb_mnesia_init() -> 27 | erlydb:start(mnesia, []). 28 | 29 | erlydb_psql_init() -> 30 | erlydb_psql:start(). 31 | 32 | 33 | code_gen(Database) -> 34 | erlydb:code_gen(Database, [language, project, developer, musician, employee, 35 | person, customer, store, item], []). 36 | 37 | test() -> 38 | test(mysql). 39 | 40 | test(Database) -> 41 | Driver = list_to_atom("erlydb_" ++ atom_to_list(Database)), 42 | Init = list_to_atom(atom_to_list(Driver) ++ "_init"), 43 | erlydb_test:Init(), 44 | % generate the abstraction layer modules 45 | code_gen(Database), 46 | 47 | 48 | %% clean up old records 49 | Driver:q({esql, {delete, language}}), 50 | Driver:q({esql, {delete, project}}), 51 | Driver:q({esql, {delete, person}}), 52 | Driver:q({esql, {delete, person_project}}), 53 | 54 | %% Create some new records 55 | Languages = 56 | [language:new(<<"Erlang">>, 57 | <<"A functional language designed for building " 58 | "scalable, fault tolerant systems">>, 59 | <<"functional/dynamic/concurrent">>, 1981), 60 | language:new_with([{name, <<"Java">>}, 61 | {description, <<"An OO language from Sun">>}, 62 | {paradigm, <<"OO/static">>}, 63 | {creation_year, 1992}]), 64 | language:new(<<"Ruby">>, 65 | <<"An OO/functional language from Matz">>, 66 | <<"OO/script/dynamic">>, 1995)], 67 | 68 | %% Save the records in the database and collect the updated 69 | %% tuples. 70 | [Erlang, Java, Ruby] = 71 | lists:map( 72 | fun(Language) -> 73 | %% executes an INSERT statement 74 | language:save(Language) 75 | end, Languages), 76 | 77 | %% demonstrate getters 78 | <<"Erlang">> = language:name(Erlang), 79 | <<"functional/dynamic/concurrent">> = language:paradigm(Erlang), 80 | 1981 = language:creation_year(Erlang), 81 | 82 | %% demonstrate setter 83 | J1 = language:creation_year(Java, 1993), 84 | 85 | %% executes an UPDATE statement 86 | J2 = language:save(J1), 87 | 88 | 1993 = language:creation_year(J2), 89 | 90 | %% Let's run some queries 91 | E1 = language:find_id(language:id(Erlang)), 92 | true = E1 == Erlang, 93 | 94 | 95 | [E2] = language:find({name, '=', "Erlang"}), 96 | true = E2 == Erlang, 97 | 98 | E3 = language:find_first({paradigm, like, "functional%"}), 99 | true = E3 == Erlang, 100 | 101 | [E4, J4, R4] = language:find(undefined, {order_by, id}), 102 | true = 103 | E4 == Erlang andalso 104 | J4 == J1 andalso 105 | R4 == Ruby, 106 | 107 | %% Let's make some projects 108 | Yaws = project:new( 109 | <<"Yaws">>, <<"A web server written in Erlang">>, Erlang), 110 | Ejabberd = project:new( 111 | <<"ejabberd">>, <<"The best Jabber server">>, Ruby), 112 | OpenPoker = 113 | project:new(<<"OpenPoker">>, <<"A scalable poker server">>, 114 | Erlang), 115 | 116 | 117 | %% We call language:id just to demonstrate that constructors accept 118 | %% both related tuples or, alternatively, their id's. This example 119 | %% would behave identically if we used the Java variable directly. 120 | Tomact = 121 | project:new(<<"Tomcat">>, <<"A Java Server">>, 122 | language:id(Java)), 123 | 124 | JBoss = 125 | project:new(<<"JBoss">>, <<"A Java Application Server">>, 126 | Java), 127 | Spring = 128 | project:new(<<"Spring Framework">>, 129 | <<"A Java IoC Framework">>, Java), 130 | 131 | 132 | 133 | Mongrel = 134 | project:new(<<"Mongerl">>, <<"A web server">>, Ruby), 135 | Rails = 136 | project:new(<<"Ruby on Rails">>, 137 | <<"A integrated web development framework.">>, Ruby), 138 | Ferret = project:new(<<"Ferret">>, 139 | <<"A Ruby port of Apache Lucene.">>, Ruby), 140 | Gruff = project:new(<<"Gruff">>, 141 | <<"A Ruby library for easy graph generation. ">>, 142 | Ruby), 143 | 144 | Projects = [Yaws, Ejabberd, OpenPoker, Tomact, JBoss, Spring, 145 | Mongrel, Rails, Ferret, Gruff], 146 | 147 | %% Insert our projects into the database 148 | [Yaws1, Ejabberd1, OpenPoker1 | _Rest] = 149 | lists:map( 150 | fun(Project) -> 151 | project:save(Project) 152 | end, Projects), 153 | 154 | %% lets get the language associated with Yaws 155 | Erlang2 = project:language(Yaws1), 156 | 157 | Erlang2 = Erlang, 158 | 159 | %% now let's correct a grave error 160 | Ejabberd2 = project:save(project:language(Ejabberd1, Erlang)), 161 | true = language:id(Erlang) == project:language_id(Ejabberd2), 162 | 163 | %% let's get all the projects for a language 164 | [Yaws3, Ejabberd3, OpenPoker3] = language:projects_with(Erlang, {order_by, id}), 165 | 166 | true = 167 | Yaws3 == Yaws1 168 | andalso Ejabberd3 == Ejabberd2 169 | andalso OpenPoker3 == OpenPoker1, 170 | 171 | %% fancier project queries 172 | [Yaws4] = language:projects( 173 | Erlang, {name,'=',"Yaws"}), 174 | Yaws4 = Yaws1, 175 | 176 | Yaws5 = language:projects_first_with(Erlang, {order_by, id}), 177 | Yaws4 = Yaws5, 178 | 179 | Ejabberd4 = language:projects_first( 180 | Erlang, {name, like, "%e%"}, {order_by, id}), 181 | Ejabberd4 = Ejabberd3, 182 | 183 | 184 | %% Let's show some many-to-many features 185 | 186 | %% First, add some more projects 187 | [OTP, Mnesia] = 188 | lists:map( 189 | fun(Proj) -> 190 | project:save(Proj) 191 | end, 192 | [project:new(<<"OTP">>, <<"The Open Telephony Platform">>, Erlang), 193 | project:new(<<"Mnesia">>, <<"A distributed database " 194 | "engine written in Erlang">>, Erlang)]), 195 | 196 | %% Next, add some developers 197 | [Joe, Ulf, Klacke] = 198 | lists:map( 199 | fun(Developer) -> 200 | developer:save(Developer) 201 | end, 202 | [developer:new(<<"Joe Armstrong">>, <<"Sweden">>), 203 | developer:new(<<"Ulf Wiger">>, <<"Sweden">>), 204 | developer:new(<<"Claes (Klacke) Wikstrom">>, <<"Sweden">>)]), 205 | 206 | %% Add some developers to our projects 207 | ok = project:add_developer(OTP, Joe), 208 | ok = project:add_developer(OTP, Klacke), 209 | ok = project:add_developer(OTP, Ulf), 210 | 211 | %% Add some projects to our developers 212 | ok = developer:add_project(Klacke, Yaws1), 213 | ok = developer:add_project(Klacke, Mnesia), 214 | ok = developer:add_project(Ulf, Mnesia), 215 | 216 | %% basic SELECT query 217 | [Joe, Ulf, Klacke] = 218 | project:developers(OTP), 219 | 220 | %% fancier SELECT queries 221 | [Ulf, Klacke] = 222 | project:developers(Mnesia), 223 | Ulf = project:developers_first(Mnesia), 224 | [Klacke] = 225 | project:developers(Mnesia, {name, like, "Claes%"}), 226 | 227 | %% SELECT query, from the other direction 228 | [Yaws1, OTP, Mnesia] = 229 | developer:projects(Klacke), 230 | 231 | %% Klacke, nothing personal here :) 232 | 1 = developer:remove_project(Klacke, Yaws1), 233 | [OTP, Mnesia] = developer:projects(Klacke), 234 | 1 = developer:remove_project(Klacke, OTP), 235 | [Mnesia] = developer:projects(Klacke), 236 | 1 = developer:remove_project(Klacke, Mnesia), 237 | [] = developer:projects(Klacke), 238 | 0 = developer:remove_project(Klacke, Mnesia), 239 | 240 | 1 = language:delete(Java), 241 | 242 | [] = language:find({name, '=', "Java"}), 243 | 244 | 245 | test2(Driver), 246 | test3(Driver), 247 | ok. 248 | 249 | %% test some 0.7 features 250 | test2(_Driver) -> 251 | 3 = developer:count(), 252 | developer:transaction( 253 | fun() -> 254 | developer:delete_where({id, '>', 0}), 255 | exit(just_kidding) 256 | end), 257 | 3 = developer:count(), 258 | 259 | Musicians = 260 | [ 261 | musician:new(<<"Jimmy">>, 26, <<"USA">>, <<"Rock">>, <<"Guitar">>), 262 | musician:new(<<"Janis">>, 27, <<"USA">>, <<"Blues">>, <<"Vocals">>), 263 | musician:new(<<"Jim">>, 28, <<"Australia">>, <<"Rock">>, 264 | <<"Vocals">>)], 265 | 266 | lists:map(fun(M) -> 267 | musician:save(M) 268 | end, Musicians), 269 | 270 | 2 = musician:count('distinct country'), 271 | 27.0 = musician:avg(age), 272 | 265.0 = musician:avg(age, {country,'=',"USA"}) * 10, 273 | 274 | Otp = project:find_first({name,'=',"OTP"}), 275 | 276 | 2 = project:count_of_developers(Otp), 277 | 1 = project:count_of_developers(Otp, name, {name, like, "J%"}), 278 | 279 | 1 = project:count_of_developers(Otp, 'distinct country'), 280 | 281 | 3 = developer:delete_all(), 282 | 283 | 3 = musician:count(), 284 | 285 | 0 = project:count_of_developers(Otp), 286 | ok. 287 | 288 | 289 | %% test multi-field custom primary keys 290 | test3(Driver) -> 291 | Driver:q({esql, {delete, customer_customer}}), 292 | Driver:q({esql, {delete, customer_store}}), 293 | 294 | store:delete_all(), 295 | customer:delete_all(), 296 | item:delete_all(), 297 | 298 | S1 = store:new_with([{number, 1}, {name, <<"dunkin">>}]), 299 | S2 = store:save(S1), 300 | 301 | I1 = item:new_with([{size, 3}, {name, <<"coffee">>}, {store, S2}]), 302 | I2 = item:save(I1), 303 | I3 = item:new_with([{size, 5}, {name, <<"bagel">>}, {store, S2}]), 304 | I4 = item:save(I3), 305 | 306 | S2 = item:store(I2), 307 | S2 = item:store(I4), 308 | 309 | [I2, I4] = store:items(S2), 310 | I2 = store:items_first(S2), 311 | 2 = store:count_of_items(S2), 312 | 313 | C1 = customer:new(<<"bob">>), 314 | C2 = customer:save(C1), 315 | C3 = customer:new(<<"jane">>), 316 | C4 = customer:save(C3), 317 | 318 | ok = store:add_customer(S2, C2), 319 | ok = store:add_customer(S2, C4), 320 | 321 | C2 = store:customers_first(S2), 322 | [C2, C4] = store:customers(S2), 323 | 2 = store:count_of_customers(S2), 324 | <<"jane">> = store:max_of_customers(S2, name), 325 | 326 | 1 = store:remove_customer(S2, C2), 327 | 1 = store:count_of_customers(S2), 328 | C4 = store:customers_first(S2), 329 | 330 | 1 = store:remove_customer(S2, C4), 331 | 0 = store:count_of_customers(S2), 332 | undefined = store:customers_first(S2), 333 | 334 | 335 | C5 = customer:new(<<"adam">>), 336 | C6 = customer:save(C5), 337 | 338 | ok = customer:add_customer(C2, C4), 339 | 1 = customer:count_of_customers(C2), 340 | ok = customer:add_customer(C2, C6), 341 | 2 = customer:count_of_customers(C2), 342 | C4 = customer:customers_first(C2), 343 | [C4, C6] = customer:customers(C2), 344 | 345 | <<"jane">> = customer:max_of_customers(C2, name), 346 | <<"adam">> = customer:min_of_customers(C2, name), 347 | 348 | 1 = customer:remove_customer(C2, C4), 349 | 1 = customer:count_of_customers(C2), 350 | C6 = customer:customers_first(C2), 351 | 352 | 353 | 1 = customer:remove_customer(C2, C6), 354 | 0 = customer:count_of_customers(C2), 355 | undefined = customer:customers_first(C2), 356 | 357 | 0 = customer:remove_customer(C2, C6), 358 | 359 | ok. 360 | 361 | 362 | -------------------------------------------------------------------------------- /test/erlydb/item.erl: -------------------------------------------------------------------------------- 1 | -module(item). 2 | -compile(export_all). 3 | 4 | relations() -> 5 | [{many_to_one, [store]}]. 6 | 7 | -------------------------------------------------------------------------------- /test/erlydb/language.erl: -------------------------------------------------------------------------------- 1 | -module(language). 2 | 3 | -export([relations/0]). 4 | 5 | relations() -> 6 | [{one_to_many, [project]}]. 7 | -------------------------------------------------------------------------------- /test/erlydb/musician.erl: -------------------------------------------------------------------------------- 1 | -module(musician). 2 | -export([table/0, fields/0, type_field/0]). 3 | 4 | table() -> 5 | person. 6 | fields() -> 7 | person:fields() ++ [genre, instrument]. 8 | type_field() -> 9 | type. 10 | -------------------------------------------------------------------------------- /test/erlydb/person.erl: -------------------------------------------------------------------------------- 1 | -module(person). 2 | -export([fields/0, type_field/0]). 3 | 4 | fields() -> 5 | [name, age, country]. 6 | 7 | type_field() -> 8 | type. 9 | -------------------------------------------------------------------------------- /test/erlydb/project.erl: -------------------------------------------------------------------------------- 1 | -module(project). 2 | -export([relations/0]). 3 | 4 | relations() -> 5 | [{many_to_one, [language]}, 6 | {many_to_many, [developer]}]. 7 | -------------------------------------------------------------------------------- /test/erlydb/store.erl: -------------------------------------------------------------------------------- 1 | -module(store). 2 | -compile(export_all). 3 | 4 | relations() -> 5 | [{one_to_many, [item]}, {many_to_many, [customer]}]. 6 | -------------------------------------------------------------------------------- /test/erlyweb/music.sql: -------------------------------------------------------------------------------- 1 | CREATE TABLE musician ( 2 | id integer primary key auto_increment, 3 | name varchar(20), 4 | birth_date date, 5 | instrument enum("guitar", "piano", 6 | "drums", "vocals"), 7 | bio text 8 | ) type=INNODB; 9 | 10 | 11 | INSERT INTO musician(name, birth_date, 12 | instrument, bio) VALUES 13 | ("John Lennon", "1940/10/9", "vocals", 14 | "An iconic English 20th century 15 | rock and roll songwriter and singer..."), 16 | ("Paul McCartney", "1942/6/18", "piano", 17 | "Sir James Paul McCartney 18 | is a popular Grammy Award-winning 19 | English artist..."), 20 | ("George Harrison", "1943/2/24", "guitar", 21 | "George Harrison was a popular English 22 | musician best known as a member of The Beatles..."), 23 | ("Ringo Star", "1940/7/7", "drums", 24 | "Richard Starkey, known by his stage name 25 | Ringo Starr, is an English popular musician, 26 | singer, and actor, best known as the 27 | drummer for The Beatles..."); -------------------------------------------------------------------------------- /test/make_test.erl: -------------------------------------------------------------------------------- 1 | -module(make_test). 2 | -export([start/0]). 3 | 4 | start() -> 5 | make:all(), 6 | filelib:fold_files("erltl/", 7 | ".+\.et$", 8 | true, 9 | fun(F, _Acc) -> 10 | erltl:compile(F, 11 | [{outdir, "../ebin"}, 12 | debug_info, 13 | show_errors, 14 | show_warnings]) 15 | end, 16 | []). 17 | -------------------------------------------------------------------------------- /test/test.bat: -------------------------------------------------------------------------------- 1 | erlc make_test.erl 2 | mkdir mnesia 3 | erl -run make_test -pa ../ebin -mnesia dir '"./mnesia"' 4 | 5 | --------------------------------------------------------------------------------