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