File Coverage

blib/lib/Mojolicious/Plugin/DevexpressHelpers/Helpers.pm

Criterion	Covered	Total	%
statement	151	180	83.8
branch	39	64	60.9
condition	40	76	52.6
subroutine	22	28	78.5
pod	21	21	100.0
total	273	369	73.9

use utf8;
package Mojolicious::Plugin::DevexpressHelpers::Helpers;
$Mojolicious::Plugin::DevexpressHelpers::Helpers::VERSION = '0.163571';
#ABSTRACT: Helpers for Devexpress controls are defined here
use Modern::Perl;
use Mojo::ByteStream;
use MojoX::AlmostJSON qw(encode_json);
use constant DEBUG => 0;

#Not sure why C function have to decode from utf8,
#but it make my day!
our $OUT_DECODE = 'UTF-8';
our $INDENT_BINDING = 0;

my @generic_controls = qw(
		Accordion
		ActionSheet
		Autocomplete
		Box
		CheckBox
		Calendar
		ColorBox
		ContextMenu
		DateBox
		DeferRendering
		FileUploader
		Gallery
		List
		LoadIndicator
		Lookup
		Map
		MultiView
		NavBar
		NumberBox
		Panorama
		Pivot
		PivotGrid
		PivotGridFieldChooser
		Popover
		ProgressBar
		RadioGroup
		RangeSlider
		Resizable
		ResponsiveBox
		Scheduler
		ScrollView
		SelectBox
		Slider
		Switch
		TabPanel
		Tabs
		TagBox
		TextArea
		TextBox
		TitleView
		Toast
		Toolbar
		TreeView
	);

#Helper method to export without prepending a prefix
my @without_prefix = qw( dxbuild required_assets require_asset indent_binding append_js prepend_js );

#Helper method to export with prepending a prefix
my @with_prefix = (qw( Button DataGrid Form Popup Menu LoadPanel Lookup ),
				   @generic_controls);


sub out{
	my $tag = shift;
	my $bytes = Mojo::ByteStream->new($tag);
	return $bytes->decode($OUT_DECODE) if defined $OUT_DECODE;
	return $bytes;
}

sub new{
	my $class = shift;
	my $self = bless {
			next_id => 1,
			bindings => '',
			before_bindings => '',
			after_bindings => '',
		}, $class;
	return $self;
}

sub indent_binding{
	my $self = shift;
	$INDENT_BINDING = shift;
}

sub add_binding{
	my $self = shift;
	$self->{bindings} .= join "\n", @_;
}

sub next_id{
	my $self = shift;
	return "dxctl".($self->{next_id}++);
}

sub new_id{
	my ($c, $attrs) = @_;
	#should compute a new uniq id
	$c->stash('dxHelper')->next_id;
}

sub dxbind{
	my ($c, $control, $id, $attrs, $extensions, $befores, $afters) = @_;
	#should return html code to be associated to the control
	$befores //=[];
	$afters  //=[];
	#http://stackoverflow.com/questions/9930577/jquery-dot-in-id-selector
	my $jquery_id = $id;
	$jquery_id =~ s{\.}{\\\\.}g;
	my $prepend = ref $attrs eq 'HASH' && delete $attrs->{prependTo};
	my $append  = ref $attrs eq 'HASH' && delete $attrs->{appendTo};
	my $binding = '';
	if($prepend || $append){
		$binding = '$(\'\').'.$control.'(';
	}
	else{
		$binding = '$("#'.$jquery_id.'").'.$control.'(';
	}
    my @options;

	if (ref($attrs) eq 'HASH') {
		$binding .= '{';
		$binding .= "\n  " if $INDENT_BINDING;
		for my $k ( sort keys %$attrs){
			my $v = $attrs->{$k} // '';
			if(ref($v) eq 'SCALAR'){
				#unref protected scalar
				$v = $$v;
			}
			elsif ($v!~/^\s*(?:function\s*\()/) {
				$v =  encode_json $v;
			}
			push @options, "$k: $v";
		}
	}
	else{
		push @options, $attrs;
	}
    $binding .= join ",\n".($INDENT_BINDING?'  ':''), @options;
	$binding .= '}' if ref($attrs) eq 'HASH';
    $binding .= ')';
	$binding .= '.prependTo("'.$prepend.'")' if $prepend;
	$binding .= '.appendTo("'.$append.'")'   if $append;
	$binding .= ';' . ($INDENT_BINDING?"\n":"");
	#append some extensions (eg: dxdatagrid)
	$binding .= join ";\n".($INDENT_BINDING?'  ':''), @$extensions if defined $extensions;
	$c->stash('dxHelper')->add_binding($binding);
	my $html_code = "";
	if($prepend || $append){
		$html_code = '';
	}
	out join('',@$befores, $html_code ,@$afters);
}


sub parse_attributs{
	my $c = shift;
	my @implicit_args = @{shift()};
	my %attrs;
	IMPLICIT_ARGUMENT:
	while(@_ and @implicit_args){
		my $ref = ref($_[0]);
		my $implicit = shift @implicit_args || '';
		last unless $ref =~ /^(?:|SCALAR)$/
		or (substr($implicit,0,1) eq '@' and $ref eq 'ARRAY')
		or (substr($implicit,0,1) eq '%' and $ref eq 'HASH')
		or (substr($implicit,0,1) eq '\\' and $ref eq 'REF')
		or (substr($implicit,0,1) eq '*');
		$implicit =~ s/^[\\\*\%\@]//;
		$attrs{ $implicit } = shift @_;
	}
	if(my $args = shift){
		if(ref($args) eq 'HASH'){
			NAMED_ARGUMENT:
			while(my($k,$v)=each %$args){
				$attrs{$k} = $v;
			}
		}
	}
	return \%attrs;
}

sub dxmenu {
    my $c = shift;
	my $attrs = parse_attributs( $c, [qw(id @items onItemClick)], @_ );
	my $id = delete($attrs->{id}) // new_id( $c, $attrs );
	dxbind( $c, 'dxMenu' => $id => $attrs);
}


sub dxloadpanel {
    my $c = shift;
	my $attrs = parse_attributs( $c, [qw(id message)], @_ );
	my $id = delete($attrs->{id}) // new_id( $c, $attrs );
	dxbind( $c, 'dxLoadPanel' => $id => $attrs);
}


sub dxbutton {
    my $c = shift;
	my $attrs = parse_attributs( $c, [qw(id text onClick type)], @_ );
	my $id = delete($attrs->{id}) // new_id( $c, $attrs );
	dxbind( $c, 'dxButton' => $id => $attrs);
}


sub dxdatagrid{
	my $c = shift;
	my $attrs = parse_attributs( $c, [qw(id dataSource)], @_ );
	my $id = delete($attrs->{id}) // new_id( $c, $attrs );
	my @extensions;
	#dxbind( $c, 'dxDataGrid' => $id => $attrs, [ $dataSource ]);
	if ($attrs->{dataSource} && ref($attrs->{dataSource}) eq '') {
		my $dataSource = delete $attrs->{dataSource};
		#push @extensions, '$.getJSON("' . $dataSource . '",function(data){$("#'.$id.'").dxDataGrid({ dataSource: data });});';
		#$attrs->{dataSource} = \'[]';	#protect string to be "stringified" within dxbind

		#\"" is to protect string to be "stringified" within dxbind
		$attrs->{dataSource} = \"{store:{type:'odata',url:'$dataSource'}}";
	}
	if (exists $attrs->{options}) {
		$attrs = $attrs->{options};
	}

	dxbind( $c, 'dxDataGrid' => $id => $attrs, \@extensions);
}


sub dxform{
	my $c = shift;
	my $attrs = parse_attributs( $c, [qw(id %formData @items)], @_ );
	my $id = delete($attrs->{id}) // new_id( $c, $attrs );

	dxbind( $c, 'dxForm' => $id => $attrs );
}


sub dxpopup{
	my $c = shift;
	my $attrs = parse_attributs( $c, [qw(id title contentTemplate)], @_ );
	my $id = delete($attrs->{id}) // new_id( $c, $attrs );

	dxbind( $c, 'dxPopup' => $id => $attrs );
}



sub mk_dxcontrol{
	my $dxControl = shift;
	my $generic = sub{
		my $c = shift;
		my $attrs = parse_attributs( $c, [qw(id value label)], @_ );
		my $id = delete($attrs->{id});
		if (my $name = $id) {
			$attrs->{name}=$name;
		}

		$id //= new_id( $c, $attrs );

		my (@before, @after);
		if(my $label = delete($attrs->{label})){
			push @before, '';
			push @before, ''.$label.'';
			push @before, '';
			push @after, '';
			push @after, '';
		}

		dxbind( $c, $dxControl => $id => $attrs, undef, \@before, \@after );
	};

	{
		no strict 'refs';
		*{__PACKAGE__.'::'.lc $dxControl} = $generic;
	}
}


sub dxbuild {
	my $c    = shift;
	my %opts = @_;
	my $dxhelper = $c->stash('dxHelper') or return;
	if($dxhelper->{bindings}){
		out ''. </td>
</tr>

<tr>
<td  class="h" >
<a name="291">291</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> 			($opts{js_prefix}//'$(window).on("load",function(){') . </td>
</tr>

<tr>
<td  class="h" >
<a name="292">292</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> 			"\n". </td>
</tr>

<tr>
<td  class="h" >
<a name="293">293</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> 			join("\n", </td>
</tr>

<tr>
<td  class="h" >
<a name="294">294</a>
</td>

<td  class="c3" >

30

</td>

<td >

&nbsp;

</td>

<td  class="c0" >
 <a href="blib-lib-Mojolicious-Plugin-DevexpressHelpers-Helpers-pm--condition.html#294-1"> 
 50
 </a> 
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

110

</td>

<td class="s"> 				 grep{ ($_//'') ne ''} </td>
</tr>

<tr>
<td  class="h" >
<a name="295">295</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> 				 @$dxhelper{'before_bindings','bindings','after_bindings'} </td>
</tr>

<tr>
<td  class="h" >
<a name="296">296</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> 			). </td>
</tr>

<tr>
<td  class="h" >
<a name="297">297</a>
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td class="s"> 			"\n". </td>
</tr>

<tr>
<td  class="h" >
<a name="298">298</a>
</td>

<td  class="c3" >

10

</td>

<td >

&nbsp;

</td>

<td  class="c0" >
 <a href="blib-lib-Mojolicious-Plugin-DevexpressHelpers-Helpers-pm--condition.html#298-1"> 
 50
 </a> 
</td>

<td >

&nbsp;

</td>

<td >

&nbsp;

</td>

<td >

61

</td>

<td class="s"> 			($opts{js_sufix}//'});').'';
	}
}


sub require_asset{
	my $c = shift;
	my $dxhelper = $c->stash('dxHelper') or return;

	push @{ $dxhelper->{required_assets} }, $_ for @_;

	return $c;
}


sub required_assets{
	my $c = shift;
	my $dxhelper = $c->stash('dxHelper') or return;
	my $required_assets = $dxhelper->{required_assets} // [];
	my $results = Mojo::ByteStream->new();
	ASSET:
	for my $asset (@$required_assets){
		#not sure about how to simulate " %= asset 'resource' " that we can use in template rendering,
		#nor how to output multiple Mojo::ByteStream objets at a time (is returning required ?)
		$$results .= ${ $c->asset($asset) };
	}
	return $results;
}

sub prepend_js{
	my ($c, @js) = @_;
	my $dxhelper = $c->stash('dxHelper') or return;
	for(@js){
		$dxhelper->{before_bindings} .= "\n" if $INDENT_BINDING;
		$dxhelper->{before_bindings} .= $_;
	}
}


sub append_js{
	my ($c, @js) = @_;
	my $dxhelper = $c->stash('dxHelper') or return;
	for(@js){
		$dxhelper->{after_bindings} .= "\n" if $INDENT_BINDING;
		$dxhelper->{after_bindings} .= $_;
	}
}

sub register {
	my ( $self, $app, $args ) = @_;
	my $tp = $args->{tag_prefix};

	#build generic dx-controls
	mk_dxcontrol( "dx$_" ) for @generic_controls;

	SUB_NO_PREFIX:
	for my $subname ( @without_prefix ){
		my $lc_name = lc $subname;
		my $sub = __PACKAGE__->can( $lc_name );
		unless($sub){
			$app->log->debug(__PACKAGE__." helper '$lc_name' does not exists!");
			next SUB_NO_PREFIX;
		}
		$app->helper( $lc_name => $sub );
	}

	SUB_WITH_PREFIX:
	for my $subname ( @with_prefix ){
		my $lc_name = lc $subname;
		my $sub = __PACKAGE__->can( 'dx' . $lc_name );
		unless($sub){
			$app->log->debug(__PACKAGE__." helper 'dx$lc_name' does not exists!");
			next SUB_WITH_PREFIX;
		}
		say STDERR "## adding helper '$tp$lc_name'" if DEBUG;
		$app->helper( $tp . $lc_name => $sub );
		say STDERR "## adding helper '$tp$subname'" if DEBUG and $args->{tag_camelcase};
		$app->helper( $tp . $subname => $sub ) if $args->{tag_camelcase};
	}

}

1;

__END__