line
stmt
bran
cond
sub
pod
time
code
1
package Dash;
2
3
6
6
841534
use Moo;
6
55642
6
33
4
6
6
10306
use strictures 2;
6
9803
6
236
5
6
6
1205
use 5.020;
6
20
6
7
our $VERSION = '0.10'; # VERSION
8
9
# ABSTRACT: Analytical Web Apps in Perl (Port of Plotly's Dash to Perl)
10
11
# TODO Enable signatures?
12
13
6
6
3970
use JSON;
6
63964
6
44
14
6
6
882
use Scalar::Util;
6
13
6
225
15
6
6
2662
use Browser::Open;
6
11557
6
274
16
6
6
4722
use Path::Tiny;
6
65691
6
330
17
6
6
2581
use Dash::Renderer;
6
19
6
202
18
6
6
2321
use Dash::Config;
6
19
6
227
19
6
6
2883
use Dash::Exceptions::NoLayoutException;
6
17
6
209
20
6
6
2199
use Dash::Exceptions::PreventUpdate;
6
30
6
197
21
6
6
2501
use Dash::Backend::Mojolicious::App;
6
22
6
65
22
6
6
315
use namespace::clean;
6
15
6
47
23
24
# TODO Add ci badges
25
26
has app_name => ( is => 'ro',
27
default => __PACKAGE__ );
28
29
has external_stylesheets => ( is => 'rw',
30
default => sub { [] } );
31
32
has _layout => ( is => 'rw',
33
default => sub { {} } );
34
35
has _callbacks => ( is => 'rw',
36
default => sub { {} } );
37
38
has _rendered_scripts => ( is => 'rw',
39
default => "" );
40
41
has _rendered_external_stylesheets => ( is => 'rw',
42
default => "" );
43
44
has backend => ( is => 'rw',
45
default => sub { Dash::Backend::Mojolicious::App->new( dash_app => shift ) } );
46
47
has config => ( is => 'rw',
48
default => sub { Dash::Config->new() } );
49
50
sub layout {
51
13
13
1
3026
my $self = shift;
52
13
24
my $layout = shift;
53
13
100
39
if ( defined $layout ) {
54
11
25
my $type = ref $layout;
55
11
100
66
109
if ( $type eq 'CODE' || ( Scalar::Util::blessed($layout) && $layout->isa('Dash::BaseComponent') ) ) {
66
56
9
45
$self->_layout($layout);
57
} else {
58
2
17
Dash::Exceptions::NoLayoutException->throw(
59
'Layout must be a dash component or a function that returns a dash component');
60
}
61
} else {
62
2
12
$layout = $self->_layout;
63
}
64
11
46
return $layout;
65
}
66
67
sub callback {
68
8
8
1
156
my $self = shift;
69
8
24
my %callback = $self->_process_callback_arguments(@_);
70
71
# TODO check_callback
72
# TODO Callback map
73
8
19
my $output = $callback{Output};
74
8
23
my $callback_id = $self->_create_callback_id($output);
75
8
43
my $callbacks = $self->_callbacks;
76
8
20
$callbacks->{$callback_id} = \%callback;
77
8
21
return $self;
78
}
79
80
my $no_update;
81
my $internal_no_update = bless( \$no_update, 'Dash::Internal::NoUpdate' );
82
83
sub no_update {
84
0
0
0
0
return $internal_no_update;
85
}
86
87
sub _process_callback_arguments {
88
8
8
15
my $self = shift;
89
90
8
13
my %callback;
91
92
# 1. all refs: 1 blessed, 1 array, 1 code or 2 array, 1 code
93
# Hash with keys Output, Inputs, callback
94
# 2. Values content: hashref or arrayref[hashref], arrayref[hashref], coderef
95
# 3. Values content: blessed output or arrayref[blessed], arrayref[blessed], coderef
96
97
8
50
22
if ( scalar @_ < 5 ) { # Unamed arguments, put names
98
0
0
my ( $output_index, $input_index, $state_index, $callback_index );
99
100
0
0
my $index = 0;
101
0
0
for my $argument (@_) {
102
0
0
my $type = ref $argument;
103
0
0
0
if ( $type eq 'CODE' ) {
0
0
0
0
0
104
0
0
$callback_index = $index;
105
} elsif ( Scalar::Util::blessed $argument) {
106
0
0
0
if ( $argument->isa('Dash::Dependencies::Output') ) {
107
0
0
$output_index = $index;
108
}
109
} elsif ( $type eq 'ARRAY' ) {
110
0
0
0
if ( scalar @$argument > 0 ) {
111
0
0
my $first_element = $argument->[0];
112
0
0
0
if ( Scalar::Util::blessed $first_element) {
113
0
0
0
if ( $first_element->isa('Dash::Dependencies::Output') ) {
0
0
114
0
0
$output_index = $index;
115
} elsif ( $first_element->isa('Dash::Dependencies::Input') ) {
116
0
0
$input_index = $index;
117
} elsif ( $first_element->isa('Dash::Dependencies::State') ) {
118
0
0
$state_index = $index;
119
}
120
}
121
} else {
122
0
0
die "Can't use empty arrayrefs as arguments";
123
}
124
} elsif ( $type eq 'SCALAR' ) {
125
0
0
die
126
"Can't mix scalarref arguments with objects when not using named paremeters. Please use named parameters for all arguments or classes for all arguments";
127
} elsif ( $type eq 'HASH' ) {
128
0
0
die
129
"Can't mix hashref arguments with objects when not using named parameters. Please use named parameters for all arguments or classes for all arguments";
130
} elsif ( $type eq '' ) {
131
0
0
die
132
"Can't mix scalar arguments with objects when not using named parameters. Please use named parameters for all arguments or classes for all arguments";
133
}
134
0
0
$index++;
135
}
136
0
0
0
if ( !defined $output_index ) {
137
0
0
die "Can't find callback output";
138
}
139
0
0
0
if ( !defined $input_index ) {
140
0
0
die "Can't find callback inputs";
141
}
142
0
0
0
if ( !defined $callback_index ) {
143
0
0
die "Can't find callback function";
144
}
145
146
0
0
$callback{Output} = $_[$output_index];
147
0
0
$callback{Inputs} = $_[$input_index];
148
0
0
$callback{callback} = $_[$callback_index];
149
0
0
0
if ( defined $state_index ) {
150
0
0
$callback{State} = $_[$state_index];
151
}
152
} else { # Named arguments
153
# TODO check keys ¿Params::Validate or similar?
154
8
39
%callback = @_;
155
}
156
157
# Convert Output & input to hashrefs
158
8
28
for my $key ( keys %callback ) {
159
26
41
my $value = $callback{$key};
160
161
26
100
84
if ( ref $value eq 'ARRAY' ) {
50
162
12
18
my @hashes;
163
12
21
for my $dependency (@$value) {
164
14
50
33
if ( Scalar::Util::blessed $dependency) {
165
0
0
my %dependency_hash = %$dependency;
166
0
0
push @hashes, \%dependency_hash;
167
} else {
168
14
32
push @hashes, $dependency;
169
}
170
}
171
12
25
$callback{$key} = \@hashes;
172
} elsif ( Scalar::Util::blessed $value) {
173
0
0
my %dependency_hash = %$value;
174
0
0
$callback{$key} = \%dependency_hash;
175
}
176
}
177
178
8
39
return %callback;
179
}
180
181
sub _create_callback_id {
182
8
8
13
my $self = shift;
183
8
11
my $output = shift;
184
185
8
100
22
if ( ref $output eq 'ARRAY' ) {
186
2
6
return ".." . join( "...", map { $_->{component_id} . "." . $_->{component_property} } @$output ) . "..";
4
20
187
}
188
189
6
22
return $output->{component_id} . "." . $output->{component_property};
190
}
191
192
sub run_server {
193
0
0
0
0
my $self = shift;
194
195
0
0
$self->_render_and_cache_scripts();
196
0
0
$self->_render_and_cache_external_stylesheets();
197
198
# Opening the browser before starting the daemon works because
199
# open_browser returns inmediately
200
# TODO Open browser optional
201
0
0
0
if ( not caller(1) ) {
202
0
0
Browser::Open::open_browser('http://127.0.0.1:8080');
203
0
0
$self->backend->start( 'daemon', '-l', 'http://*:8080' );
204
}
205
0
0
return $self->backend;
206
}
207
208
sub _dependencies {
209
4
4
26
my $self = shift;
210
4
8
my $dependencies = [];
211
4
10
for my $callback ( values %{ $self->_callbacks } ) {
4
19
212
3
10
my $rendered_callback = { clientside_function => JSON::null };
213
3
14
my $states = [];
214
3
4
for my $state ( @{ $callback->{State} } ) {
3
10
215
my $rendered_state = { id => $state->{component_id},
216
property => $state->{component_property}
217
1
51
};
218
1
5
push @$states, $rendered_state;
219
}
220
3
7
$rendered_callback->{state} = $states;
221
3
5
my $inputs = [];
222
3
5
for my $input ( @{ $callback->{Inputs} } ) {
3
5
223
my $rendered_input = { id => $input->{component_id},
224
property => $input->{component_property}
225
3
10
};
226
3
6
push @$inputs, $rendered_input;
227
}
228
3
5
$rendered_callback->{inputs} = $inputs;
229
3
7
my $output_type = ref $callback->{Output};
230
3
100
9
if ( $output_type eq 'ARRAY' ) {
50
231
1
4
$rendered_callback->{'output'} .= '.';
232
1
2
for my $output ( @{ $callback->{'Output'} } ) {
1
3
233
$rendered_callback->{'output'} .=
234
2
7
'.' . join( '.', $output->{component_id}, $output->{component_property} ) . '..';
235
}
236
} elsif ( $output_type eq 'HASH' ) {
237
$rendered_callback->{'output'} =
238
2
11
join( '.', $callback->{'Output'}{component_id}, $callback->{'Output'}{component_property} );
239
} else {
240
0
0
die 'Dependecy type for callback not implemented';
241
}
242
3
7
push @$dependencies, $rendered_callback;
243
}
244
4
21
return $dependencies;
245
}
246
247
sub _update_component {
248
6
6
149
my $self = shift;
249
6
10
my $request = shift;
250
251
6
100
9
if ( scalar( values %{ $self->_callbacks } ) > 0 ) {
6
31
252
5
18
my $callbacks = $self->_search_callback( $request->{'output'} );
253
5
50
21
if ( scalar @$callbacks > 1 ) {
50
254
0
0
die 'Not implemented multiple callbacks';
255
} elsif ( scalar @$callbacks == 1 ) {
256
5
8
my $callback = $callbacks->[0];
257
5
8
my @callback_arguments = ();
258
5
10
my $callback_context = {};
259
5
7
for my $callback_input ( @{ $callback->{Inputs} } ) {
5
13
260
5
10
my ( $component_id, $component_property ) = @{$callback_input}{qw(component_id component_property)};
5
12
261
5
9
for my $change_input ( @{ $request->{inputs} } ) {
5
11
262
5
70
my ( $id, $property, $value ) = @{$change_input}{qw(id property value)};
5
18
263
5
50
33
33
if ( $component_id eq $id && $component_property eq $property ) {
264
5
12
push @callback_arguments, $value;
265
5
20
$callback_context->{inputs}{ $id . "." . $property } = $value;
266
5
17
last;
267
}
268
}
269
}
270
5
59
for my $callback_input ( @{ $callback->{State} } ) {
5
16
271
1
2
my ( $component_id, $component_property ) = @{$callback_input}{qw(component_id component_property)};
1
14
272
1
3
for my $change_input ( @{ $request->{state} } ) {
1
3
273
1
3
my ( $id, $property, $value ) = @{$change_input}{qw(id property value)};
1
4
274
1
50
33
7
if ( $component_id eq $id && $component_property eq $property ) {
275
1
3
push @callback_arguments, $value;
276
1
4
$callback_context->{states}{ $id . "." . $property } = $value;
277
1
3
last;
278
}
279
}
280
}
281
282
5
30
$callback_context->{triggered} = [];
283
5
8
for my $triggered_input ( @{ $request->{changedPropIds} } ) {
5
14
284
5
32
push @{ $callback_context->{triggered} },
285
{ prop_id => $triggered_input,
286
5
7
value => $callback_context->{inputs}{$triggered_input}
287
};
288
}
289
5
11
push @callback_arguments, $callback_context;
290
291
5
12
my $output_type = ref $callback->{Output};
292
5
100
20
if ( $output_type eq 'ARRAY' ) {
50
293
1
5
my @return_value = $callback->{callback}(@callback_arguments);
294
1
7
my $props_updated = {};
295
1
3
my $index_output = 0;
296
1
2
my $some_updated = 0;
297
1
2
for my $output ( @{ $callback->{'Output'} } ) {
1
3
298
2
4
my $output_value = $return_value[ $index_output++ ];
299
2
50
33
15
if ( !( Scalar::Util::blessed($output_value) && $output_value->isa('Dash::Internal::NoUpdate') ) ) {
300
$props_updated->{ $output->{component_id} } =
301
2
14
{ $output->{component_property} => $output_value };
302
2
5
$some_updated = 1;
303
}
304
}
305
1
50
3
if ($some_updated) {
306
1
10
return { response => $props_updated, multi => JSON::true };
307
} else {
308
0
0
Dash::Exceptions::PreventUpdate->throw;
309
}
310
} elsif ( $output_type eq 'HASH' ) {
311
4
12
my $updated_value = $callback->{callback}(@callback_arguments);
312
3
50
33
30
if ( Scalar::Util::blessed($updated_value) && $updated_value->isa('Dash::Internal::NoUpdate') ) {
313
0
0
Dash::Exceptions::PreventUpdate->throw;
314
}
315
3
12
my $updated_property = ( split( /\./, $request->{output} ) )[-1];
316
3
9
my $props_updated = { $updated_property => $updated_value };
317
3
29
return { response => { props => $props_updated } };
318
} else {
319
0
0
die 'Callback not supported';
320
}
321
} else {
322
0
0
return { response => "There is no matching callback" };
323
}
324
325
} else {
326
1
6
return { response => "There is no registered callbacks" };
327
}
328
0
0
return { response => "Internal error" };
329
}
330
331
sub _search_callback {
332
5
5
8
my $self = shift;
333
5
16
my $output = shift;
334
335
5
11
my $callbacks = $self->_callbacks;
336
5
14
my @matching_callbacks = ( $callbacks->{$output} );
337
5
12
return \@matching_callbacks;
338
}
339
340
sub _rendered_stylesheets {
341
1
1
11
return '';
342
}
343
344
sub _render_external_stylesheets {
345
0
0
0
my $self = shift;
346
0
0
my $stylesheets = $self->external_stylesheets;
347
0
0
my $rendered_external_stylesheets = "";
348
0
0
for my $stylesheet (@$stylesheets) {
349
0
0
$rendered_external_stylesheets .= '
350
}
351
0
0
return $rendered_external_stylesheets;
352
}
353
354
sub _render_and_cache_external_stylesheets {
355
0
0
0
my $self = shift;
356
0
0
my $stylesheets = $self->_render_external_stylesheets();
357
0
0
$self->_rendered_external_stylesheets($stylesheets);
358
}
359
360
sub _render_and_cache_scripts {
361
0
0
0
my $self = shift;
362
0
0
my $scripts = $self->_render_scripts();
363
0
0
$self->_rendered_scripts($scripts);
364
}
365
366
sub _render_dash_config {
367
0
0
0
my $self = shift;
368
0
0
my $json = JSON->new->utf8->allow_blessed->convert_blessed;
369
0
0
return '';
370
}
371
372
sub _dash_renderer_js_dependencies {
373
0
0
0
my $js_dist_dependencies = Dash::Renderer::_js_dist_dependencies();
374
0
0
my @js_deps = ();
375
0
0
for my $deps (@$js_dist_dependencies) {
376
0
0
my $external_url = $deps->{external_url};
377
0
0
my $relative_package_path = $deps->{relative_package_path};
378
0
0
my $namespace = $deps->{namespace};
379
0
0
my $dep_count = 0;
380
0
0
for my $dep ( @{ $relative_package_path->{prod} } ) {
0
0
381
my $js_dep = { namespace => $namespace,
382
relative_package_path => $dep,
383
dev_package_path => $relative_package_path->{dev}[$dep_count],
384
0
0
external_url => $external_url->{prod}[$dep_count]
385
};
386
0
0
push @js_deps, $js_dep;
387
0
0
$dep_count++;
388
}
389
}
390
0
0
\@js_deps;
391
}
392
393
sub _dash_renderer_js_deps {
394
0
0
0
return Dash::Renderer::_js_dist();
395
}
396
397
sub _render_dash_renderer_script {
398
0
0
0
return '';
399
}
400
401
sub _render_scripts {
402
0
0
0
my $self = shift;
403
404
# First dash_renderer dependencies
405
0
0
my $scripts_dependencies = $self->_dash_renderer_js_dependencies;
406
407
# Traverse layout and recover javascript dependencies
408
# TODO auto register dependencies on component creation to avoid traversing and filter too much dependencies
409
0
0
my $layout = $self->layout;
410
411
0
0
my $visitor;
412
0
0
my $stack_depth_limit = 1000;
413
$visitor = sub {
414
0
0
0
my $node = shift;
415
0
0
my $stack_depth = shift;
416
0
0
0
if ( $stack_depth++ >= $stack_depth_limit ) {
417
418
# TODO warn user that layout is too deep
419
0
0
return;
420
}
421
0
0
my $type = ref $node;
422
0
0
0
if ( $type eq 'HASH' ) {
0
0
423
0
0
for my $key ( keys %$node ) {
424
0
0
$visitor->( $node->{$key}, $stack_depth );
425
}
426
} elsif ( $type eq 'ARRAY' ) {
427
0
0
for my $element (@$node) {
428
0
0
$visitor->( $element, $stack_depth );
429
}
430
} elsif ( $type ne '' ) {
431
0
0
my $node_dependencies = $node->_js_dist();
432
0
0
0
push @$scripts_dependencies, @$node_dependencies if defined $node_dependencies;
433
0
0
0
if ( $node->can('children') ) {
434
0
0
$visitor->( $node->children, $stack_depth );
435
}
436
}
437
0
0
};
438
439
0
0
$visitor->( $layout, 0 );
440
441
0
0
my $rendered_scripts = "";
442
0
0
$rendered_scripts .= $self->_render_dash_config();
443
0
0
push @$scripts_dependencies, @{ $self->_dash_renderer_js_deps() };
0
0
444
0
0
my $filtered_resources = $self->_filter_resources($scripts_dependencies);
445
0
0
my %rendered = ();
446
0
0
for my $dep (@$filtered_resources) {
447
0
0
0
my $dynamic = $dep->{dynamic} // 0;
448
0
0
0
if ( !$dynamic ) {
449
0
0
my $resource_path_part = join( "/", $dep->{namespace}, $dep->{relative_package_path} );
450
0
0
0
if ( !$rendered{$resource_path_part} ) {
451
0
0
$rendered_scripts .=
452
'' . "\n";
453
0
0
$rendered{$resource_path_part} = 1;
454
}
455
}
456
}
457
0
0
$rendered_scripts .= $self->_render_dash_renderer_script();
458
459
0
0
return $rendered_scripts;
460
}
461
462
sub _filter_resources {
463
0
0
0
my $self = shift;
464
0
0
my $resources = shift;
465
0
0
my %params = @_;
466
0
0
0
my $dev_bundles = $params{dev_bundles} // 0;
467
0
0
0
my $eager_loading = $params{eager_loading} // 0;
468
0
0
0
my $serve_locally = $params{serve_locally} // 1;
469
470
0
0
my $filtered_resources = [];
471
0
0
for my $resource (@$resources) {
472
0
0
my $filtered_resource = {};
473
0
0
my $dynamic = $resource->{dynamic};
474
0
0
0
if ( defined $dynamic ) {
475
0
0
$filtered_resource->{dynamic} = $dynamic;
476
}
477
0
0
my $async = $resource->{async};
478
0
0
0
if ( defined $async ) {
479
0
0
0
if ( defined $dynamic ) {
480
0
0
die "A resource can't have both dynamic and async: " + to_json($resource);
481
}
482
0
0
my $dynamic = 1;
483
0
0
0
if ( $async eq 'lazy' ) {
484
0
0
$dynamic = 1;
485
} else {
486
0
0
0
0
if ( $async eq 'eager' && !$eager_loading ) {
487
0
0
$dynamic = 1;
488
} else {
489
0
0
0
0
if ( $async && !$eager_loading ) {
490
0
0
$dynamic = 1;
491
} else {
492
0
0
$dynamic = 0;
493
}
494
}
495
}
496
0
0
$filtered_resource->{dynamic} = $dynamic;
497
}
498
0
0
my $namespace = $resource->{namespace};
499
0
0
0
if ( defined $namespace ) {
500
0
0
$filtered_resource->{namespace} = $namespace;
501
}
502
0
0
my $external_url = $resource->{external_url};
503
0
0
0
0
if ( defined $external_url && !$serve_locally ) {
504
0
0
$filtered_resource->{external_url} = $external_url;
505
} else {
506
0
0
my $dev_package_path = $resource->{dev_package_path};
507
0
0
0
0
if ( defined $dev_package_path && $dev_bundles ) {
508
0
0
$filtered_resource->{relative_package_path} = $dev_package_path;
509
} else {
510
0
0
my $relative_package_path = $resource->{relative_package_path};
511
0
0
0
if ( defined $relative_package_path ) {
512
0
0
$filtered_resource->{relative_package_path} = $relative_package_path;
513
} else {
514
0
0
my $absolute_path = $resource->{absolute_path};
515
0
0
0
if ( defined $absolute_path ) {
516
0
0
$filtered_resource->{absolute_path} = $absolute_path;
517
} else {
518
0
0
my $asset_path = $resource->{asset_path};
519
0
0
0
if ( defined $asset_path ) {
520
0
0
my $stat_info = path( $resource->{filepath} )->stat;
521
0
0
$filtered_resource->{asset_path} = $asset_path;
522
0
0
$filtered_resource->{ts} = $stat_info->mtime;
523
} else {
524
0
0
0
if ($serve_locally) {
525
0
0
warn
526
'There is no local version of this resource. Please consider using external_scripts or external_stylesheets : '
527
+ to_json($resource);
528
0
0
next;
529
} else {
530
0
0
die
531
'There is no relative_package-path, absolute_path or external_url for this resource : '
532
+ to_json($resource);
533
}
534
}
535
}
536
}
537
}
538
}
539
540
0
0
push @$filtered_resources, $filtered_resource;
541
}
542
0
0
return $filtered_resources;
543
}
544
545
sub _filename_from_file_with_fingerprint {
546
1
1
22
my $self = shift;
547
1
3
my $file = shift;
548
1
17
my @path_parts = split( /\//, $file );
549
1
6
my @name_parts = split( /\./, $path_parts[-1] );
550
551
# Check if the resource has a fingerprint
552
1
50
33
10
if ( ( scalar @name_parts ) > 2 && $name_parts[1] =~ /^v[\w-]+m[0-9a-fA-F]+$/ ) {
553
0
0
my $original_name = join( ".", $name_parts[0], @name_parts[ 2 .. ( scalar @name_parts - 1 ) ] );
554
0
0
$file = join( "/", @path_parts[ 0 .. ( scalar @path_parts - 2 ) ], $original_name );
555
}
556
557
1
6
return $file;
558
}
559
560
1;
561
562
__END__