/
Do.pm6
153 lines (134 loc) · 4.57 KB
/
Do.pm6
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
use Red::Database;
use Red::Driver;
use X::Red::Exceptions;
use Red::Class;
use Red::Event;
use Red::DB;
=head1 This module is experimental, to use it, do:
=head2 Red::Do
=begin code :lang<perl6>
use Red <red-do>;
=end code
unit module Red::Do;
#| Loads Red configuration (mostly the database connection)
#| from a json configuration json file. If the file isn't defined
#| try to get it on `./.red.json`
multi red-defaults-from-config() is export {
if "./.red.json".IO.f {
return red-defaults-from-config "./.red.json"
}
X::Red::Defaults::FromConfNotFound.new(:file<./.red.json>).throw
}
#| Loads Red configuration (mostly the database connection)
#| from a json configuration json file. If the file isn't defined
#| try to get it on `./.red.json`
multi red-defaults-from-config($file where .IO.f) is export {
require ::("Config");
my $conf = ::("Config").new;
my $defaults = $conf.read($file.IO.absolute).get;
my %defaults = $defaults.kv.map: -> $name, %data {
$name => [%data<red-driver>, :default(so %data<default>), |($_ with %data<positional>), |(.pairs with %data<named>)]
}
red-defaults |%defaults
}
#| Sets the default connection to be used
multi red-defaults(Str $driver, |c) is export {
%GLOBAL::RED-DEFULT-DRIVERS = default => database $driver, |c
}
#| Sets the default connections to be used.
#| The key is the name of the connection and the value the connection itself
multi red-defaults(*%drivers) is export {
my Bool $has-default = False;
%GLOBAL::RED-DEFULT-DRIVERS = %drivers.kv.map(-> $name, $_ {
when Capture|Positional {
my (Str $driver, Bool $default);
my \c = \();
:($driver, Bool :$default, |c) := $_;
if $default {
X::Red::Do::DriverDefinedMoreThanOnce.new.throw if $has-default;
$has-default = True;
}
my \db = do if $driver ~~ Red::Driver {
$driver
} else {
database $driver, |[|c];
}
|%(
$name => db,
|(default => db if $default)
)
}
when Red::Driver:D {
$name => $_
}
}).Hash;
}
sub red-emit(Str() $name, $data) is export {
get-RED-DB.emit: Red::Event.new: :$name, :$data
}
sub red-tap(Str() $name, &func, :$red-db = $*RED-DB) is export {
Red::Class.instance.events.grep({ $_ eq $name with .name }).tap: -> Red::Event $_ {
my $*RED-DB = $red-db;
func .data
}
}
sub run-red-do($*RED-DB, &block) {
# TODO: test if its connected and reconnect if it's not
block $*RED-DB
}
proto red-do(|) {
my %red-supplies := %*RED-SUPPLIES // {};
{
my %*RED-SUPPLIES := %red-supplies;
{*}
}
}
#| Receives a block and optionally a connection name.
#| Runs the block with the connection with that name
multi red-do(*@blocks where .all ~~ Callable, Str :$with = "default", :$async) is export {
X::Red::Do::DriverNotDefined.new(:driver($with)).throw unless %GLOBAL::RED-DEFULT-DRIVERS{$with}:exists;
my @ret = do for @blocks {
my Str $*RED-DO-WITH = $with;
red-do :with(%GLOBAL::RED-DEFULT-DRIVERS{$with}), $_, :$async
}
if $async {
return start await @ret
}
return @ret.head if @ret == 1;
@ret
}
#| Receives a block and optionally a connection name.
#| Runs the block with the connection with that name
#| synchronously
multi red-do(&block, Red::Driver:D :$with, :$async where not *) is export {
run-red-do $with, &block
}
#| Receives a block and optionally a connection name.
#| Runs the block with the connection with that name
#| asynchronously
multi red-do(&block, Red::Driver:D :$with = "default", :$async! where so *) is export {
start run-red-do $with, &block
}
#| Receives list of pairs with connection name and block
#| or blocks (assuming the default connection) or named
#| args where the name is the name of the connection
#| Runs each block with the connection with that name
multi red-do(*@blocks, Bool :$async, *%pars where *.none.key eq "with") is export {
my @ret = do for |@blocks , |%pars.pairs -> $block {
when $block ~~ Pair {
given $block.key -> $with {
when $with ~~ Positional {
red-do :$async, |$with.map: { Pair.new: $_, $block.value }
}
default {
red-do :$async, :$with, $block.value
}
}
}
when $block ~~ Callable {
red-do :$async, $block
}
}
return start await @ret if $async;
@ret
}