File Coverage

blib/lib/Rest/HtmlVis/Content.pm
Criterion Covered Total %
statement 23 226 10.1
branch 0 118 0.0
condition 0 82 0.0
subroutine 8 19 42.1
pod 6 6 100.0
total 37 451 8.2


line stmt bran cond sub pod time code
1             package Rest::HtmlVis::Content;
2              
3 1     1   664 use 5.006;
  1         8  
4 1     1   3 use strict;
  1         1  
  1         16  
5 1     1   3 use warnings FATAL => 'all';
  1         0  
  1         25  
6              
7 1     1   3 use parent qw( Rest::HtmlVis::Key );
  1         1  
  1         4  
8              
9 1     1   486 use Plack::Request;
  1         48726  
  1         25  
10 1     1   427 use YAML::Syck;
  1         1310  
  1         52  
11 1     1   418 use URI::Escape::XS qw/decodeURIComponent/;
  1         1736  
  1         58  
12 1     1   489 use Encode;
  1         6391  
  1         1800  
13              
14             $YAML::Syck::ImplicitUnicode = 1;
15              
16             =head1 NAME
17              
18             Rest::HtmlVis::Content - Return base block for keys links and form.
19              
20             =head1 VERSION
21              
22             Version 0.01
23              
24             =cut
25              
26             our $VERSION = '0.11';
27              
28              
29             =head1 SYNOPSIS
30              
31             Quick summary of what the module does.
32              
33             Perhaps a little code snippet.
34              
35             use Rest::HtmlVis::Content;
36              
37             my $foo = Rest::HtmlVis::Content->new();
38             ...
39              
40             =head1 KEYS
41              
42             =head2 link
43              
44             Convert default strcuture of links. Each link should consists of:
45              
46             =over 4
47              
48             =item * href
49              
50             URL of target.Can be absolute or relative.
51              
52             =item * title
53              
54             Name of the link.
55              
56             =item * rel
57              
58             Identifier of the link (type of the link)
59              
60             =back
61              
62             Example:
63              
64             link => [
65             {
66             href => '/api/test',
67             title => 'Test resource',
68             rel => 'api.test'
69             }
70             ]
71              
72             =head2 form
73              
74             Define elements of formular for html.
75              
76             =cut
77              
78             my @defualtMethods = ('get','post','put','delete');
79              
80             sub setStruct {
81 0     0 1   my ($self, $key, $struct, $env) = @_;
82 0           $self->{struct} = $struct;
83 0           $self->{env} = $env;
84              
85 0           return 1;
86             }
87              
88             sub getOrder {
89 0     0 1   return 9999;
90             }
91              
92             sub newRow {
93 0     0 1   return 1;
94             }
95              
96             sub head {
97 0     0 1   return <
98            
124             END
125             }
126              
127             sub onload {
128 0     0 1   'prettyPrint();'
129             }
130              
131             sub html {
132 0     0 1   my ($self) = @_;
133 0           my $struct = $self->getStruct;
134 0           my $env = $self->getEnv;
135              
136             ### Links
137 0           my $links = '';
138 0 0 0       if (ref $struct eq 'HASH' && exists $struct->{link} && ref $struct->{link} eq 'ARRAY'){
      0        
139 0           foreach my $link (@{$struct->{link}}) {
  0            
140 0           $links .= '
  • '.$link->{title}.'
  • ';
    141             }
    142 0           delete $struct->{link};
    143             }
    144              
    145             ### Remove form content
    146 0           my $formStruct; # Set undef
    147 0 0 0       $formStruct = delete $struct->{form} if (ref $struct eq 'HASH' && exists $struct->{form} && ref $struct->{form} eq 'HASH');
          0        
    148              
    149             ### Content
    150 0           my $content = '';
    151             {
    152 0           local $Data::Dumper::Indent=1;
      0            
    153 0           local $Data::Dumper::Quotekeys=0;
    154 0           local $Data::Dumper::Terse=1;
    155 0           local $Data::Dumper::Sortkeys=1;
    156              
    157 0           $content = Dump($struct);
    158             }
    159              
    160 0 0 0       if( !$formStruct && exists $env->{'REST.class'} && $env->{'REST.class'}->can('GET_FORM') ){
          0        
    161 0           my $req = Plack::Request->new($env);
    162 0           my $par = $req->parameters;
    163 0           $formStruct = $env->{'REST.class'}->GET_FORM($env, $content, $par);
    164             }
    165              
    166             ### Form
    167 0           my $form = {};
    168 0           my $extForm = {};
    169 0 0         if ($formStruct){
    170 0           $form = _formToHtml($env,$formStruct,@defualtMethods);
    171             }
    172 0 0         if($formStruct){
    173 0           $extForm = _extFormToHtml($env,$formStruct,(keys %{$formStruct}));
      0            
    174             }
    175 0           my $firstActive = 'get';
    176 0           foreach my $method (@defualtMethods){
    177 0 0         if ($form->{$method}){
    178 0           $firstActive=$method;
    179 0           last;
    180             }
    181             }
    182              
    183 0 0 0       if( exists $env->{'REST.class'} && $env->{'REST.class'}->can('GET') and !exists $form->{get}){
          0        
    184 0           $form->{get} = _formToHtml($env, {get => {}}, ('get') )->{get};
    185             }
    186              
    187 0           my $ret = "
    188            
    ";
    189              
    190 0 0         if( keys %{$extForm} ){
      0            
    191 0           $ret .= "
    192            
    193            
      ";
    194 0           my @extkey = sort(keys %{$extForm});
      0            
    195 0           my $firstActiveExt = $extkey[0];
    196 0           foreach my $method (@extkey){
    197 0 0         $ret .="
  • {$method}?'':" class=\"disabled\"")) . ">{$method}?" href=\"#$method\" data-toggle=\"tab\"":'') . ">" . uc($method) . "
  • ";
        0          
        0          
    198             }
    199 0           $ret .= "
    200            
    ";
    201 0           foreach my $method (@extkey){
    202 0           my $extForPar = $extForm->{$method}{params};
    203             $ret .= "
    204 0 0 0      
    {method} =~ /^(put|delete)$/i?"onSubmit=\""._getAjaxCall($self, uc($extForPar->{method}),$extForPar):"method=\"" . uc($extForPar->{method})) . "\"" . (exists $extForPar->{url}?'action="'.$extForPar->{url}:'') . "\">".($extForm->{$method}{html}||'
    Not allowed
    ')."
        0          
        0          
    205            
    206             ";
    207             }
    208 0           $ret .= "
    ";
    209             }
    210 0           $ret .= "
    211             $links
    212            
    213            
    214            
    215            
     
    216             $content
    217            
    218            
    219            
    220              
    221            
    222            
      ";
    223              
    224 0           foreach my $method (@defualtMethods){
    225 0 0         $ret .="
  • {$method}?'':" class=\"disabled\"")) . ">{$method}?" href=\"#$method\" data-toggle=\"tab\"":'') . ">" . uc($method) . "
  • ";
        0          
        0          
    226             }
    227 0           $ret .= "
    228            
    ";
    229 0           foreach my $method (@defualtMethods){
    230             $ret .= "
    231 0 0 0      
    ".($form->{$method}||'
    Not allowed
    ')."
        0          
    232            
    233             ";
    234             }
    235 0           $ret .= "
    236              
    237            
    238             ";
    239 0           return $ret;
    240             }
    241              
    242             sub _getAjaxCall {
    243 0     0     my ($self, $methodType, $params) = @_;
    244 0           my $jsvar = "\$(this).serialize()";
    245 0           my $url = $self->getEnv()->{REQUEST_URI};
    246 0 0         if (defined $params){
    247 0 0         $jsvar = $params->{jsvar} if exists $params->{jsvar};
    248 0 0         $url = $params->{url} if exists $params->{url};
    249             }
    250 0           return <
    251             sendPut('$methodType','$url',$jsvar);
    252             END
    253             }
    254              
    255              
    256             my $defaultForm = {
    257             get => "
    258            
    259            
    260            
    261            
    262            
    263            
    264             ",
    265            
    266             post => "
    267            
    268            
    269            
    270            
    271            
    272            
    273            
    274            
    275            
    276            
    277            
    278            
    279             ",
    280              
    281             put => "
    282            
    283            
    284            
    285            
    286            
    287             ",
    288              
    289             delete => "",
    290             };
    291              
    292              
    293             sub _decodeQuery {
    294 0   0 0     my $str = shift || return {};
    295 0           my %ret;
    296             map
    297             {
    298 0           my ($a,$b) = split '=', $_, 2;
      0            
    299 0 0         unless ($a =~ /^(?:format|enctype)$/i) {
    300 0           $b =~ s/\+/ /g;
    301 0           $b = Encode::decode_utf8(decodeURIComponent($b));
    302 0 0         if (exists $ret{$a}) {
    303 0           $ret{$a} .= "|$b";
    304             } else {
    305 0           $ret{$a} = $b;
    306             }
    307             }
    308             }
    309             split '&', $str;
    310 0           return {%ret}
    311             }
    312              
    313             sub _paramsToHtml {
    314 0     0     my ($env, $param, $paramValue) = @_;
    315 0           my $type = $paramValue->{type};
    316 0           my $name = $param;
    317 0 0 0       next unless $name and $type;
    318              
    319 0   0       my $description = $paramValue->{description}||'';
    320 0           my $html = '';
    321 0           my $query = _decodeQuery($env->{QUERY_STRING});
    322 0 0         if(exists $query->{$name}){
    323 0 0         $paramValue->{default} = $query->{$name} =~ /\|/?[split '\|',$query->{$name}]:$query->{$name};
    324             }
    325 0 0         if ($type eq 'text'){
        0          
        0          
        0          
        0          
        0          
    326 0   0       my $default = ($paramValue->{default}||'');
    327 0 0 0       if (ref $default eq 'HASH' || ref $default eq 'ARRAY'){
    328 0           $default = YAML::Syck::Dump($default);
    329             }
    330 0           $html .= '
    ';
    331 0 0         $html .= '' if ($description);
    332 0           $html .= '';
    333 0           $html .= '';
    334             }elsif ($type eq 'textarea'){
    335 0   0       my $rows = ($paramValue->{rows}||20);
    336 0   0       my $cols = ($paramValue->{cols}||3);
    337 0   0       my $default = ($paramValue->{default}||'');
    338 0 0 0       if (ref $default eq 'HASH' || ref $default eq 'ARRAY'){
    339 0           $default = YAML::Syck::Dump($default);
    340             }
    341 0           $html .= '
    ';
    342 0 0         $html .= '' if ($description);
    343 0           $html .= '';
    344 0           $html .= '';
    345             }elsif ($type eq 'checkbox'){
    346 0           $html .= '
    ';
    347 0 0         $html .= "' if ($description);
    348 0 0         $paramValue->{options} = [$paramValue->{options}] if ( ref $paramValue->{options} ne "ARRAY");
    349 0           foreach my $v (@{$paramValue->{options}}){
      0            
    350 0           my $optionName = ''; my $value = '';
      0            
    351 0 0         if (ref $v eq 'ARRAY'){
    352 0           ($optionName, $value) = @$v;
    353             }else{
    354 0           $optionName = $v; $value = $v;
      0            
    355             }
    356 0           my $checked='';
    357 0 0         if(exists $paramValue->{default}){
    358 0 0         if(ref $paramValue->{default} eq 'ARRAY'){
    359 0           foreach my $d (@{$paramValue->{default}}){
      0            
    360 0 0         $checked = 'checked="checked"'if ($d eq $value);
    361             }
    362             }else{
    363 0 0         $checked = 'checked="checked"'if ($paramValue->{default} eq $value);
    364             }
    365             }
    366 0           $html .= "
    ";
    367             }
    368 0           $html .= '';
    369             }elsif ($type eq 'radio'){
    370 0           $html .= '
    ';
    371 0 0         $html .= "' if ($description);
    372 0           foreach my $v (@{$paramValue->{options}}){
      0            
    373 0           my $optionName = ''; my $value = '';
      0            
    374 0 0         if (ref $v eq 'ARRAY'){
    375 0           ($optionName, $value) = @$v;
    376             }else{
    377 0           $optionName = $v; $value = $v;
      0            
    378             }
    379 0           my $checked='';
    380 0 0         if(exists $paramValue->{default}){
    381 0 0         if(ref $paramValue->{default} eq 'ARRAY'){
    382 0           foreach my $d (@{$paramValue->{default}}){
      0            
    383 0 0         $checked = 'checked="checked"'if ($d eq $value);
    384             }
    385             }else{
    386 0 0         $checked = 'checked="checked"'if ($paramValue->{default} eq $value);
    387             }
    388             }
    389 0           $html .= "
    ";
    390             }
    391 0           $html .= '';
    392             }elsif ($type eq 'select'){
    393 0           $html .= '
    ';
    394 0 0         $html .= '' if ($description);
    395 0           $html .= '
    396 0           foreach my $v (@{$paramValue->{options}}){
      0            
    397 0           my $name = ''; my $id = '';
      0            
    398 0 0         if (ref $v eq 'ARRAY'){
    399 0           ($id, $name) = @$v;
    400             }else{
    401 0           $name = $v; $id = $v;
      0            
    402             }
    403 0 0 0       my $default = (defined $paramValue->{default} && $id eq $paramValue->{default}) ? 'selected="selected"' : '';
    404 0           $html .= '';
    405             }
    406 0           $html .= '';
    407 0           $html .= '';
    408             }elsif ($type eq 'hidden'){
    409 0           $html .= " ";
    410            
    411             }
    412 0           return $html;
    413             }
    414              
    415             sub _extFormToHtml {
    416 0     0     my ($env, $struct, @methods) = @_;
    417 0           my $form = {};
    418 0           foreach my $defaultMethod (@methods) {
    419 0           my $method = delete $struct->{$defaultMethod};
    420 0 0 0       if (defined $method and exists $method->{params} && ref $method->{params} eq 'HASH'){
          0        
    421 0           my $html = '';
    422 0           delete $method->{params}{format};
    423             #delete $method->{params}{ENCTYPE};
    424 0   0       foreach my $param (sort {($method->{params}{$a}{description}||$a) cmp ($method->{params}{$b}{description}||$b) } keys %{$method->{params}}) {
      0   0        
      0            
    425 0           $html .= _paramsToHtml($env, $param, $method->{params}{$param});
    426             }
    427 0           $form->{$defaultMethod}{html} .= $html;
    428             }
    429 0 0 0       if(defined $method and exists $method->{default}){
    430 0           my $html = '';
    431 0           $html .= '';
    432 0           $form->{$defaultMethod}{html} .= $html;
    433             }
    434 0           delete $method->{params};
    435 0           $form->{$defaultMethod}{params} = $method;
    436 0 0         $form->{$defaultMethod}{html} .= $defaultForm->{lc ($method->{method}) } if exists $defaultForm->{ lc($method->{method}) };
    437             }
    438              
    439 0           return $form;
    440             }
    441              
    442             sub _formToHtml {
    443 0     0     my ($env,$struct, @methods) = @_;
    444 0           my $form = {};
    445 0           foreach my $defaultMethod (@methods) {
    446 0           my $method = delete $struct->{$defaultMethod};
    447 0 0 0       if (defined $method and exists $method->{params} && ref $method->{params} eq 'HASH'){
          0        
    448 0           my $html = '';
    449 0   0       foreach my $param (sort {($method->{params}{$a}{description}||$a) cmp ($method->{params}{$b}{description}||$b) } keys %{$method->{params}}) {
      0   0        
      0            
    450 0           $html .= _paramsToHtml($env, $param, $method->{params}{$param});
    451             }
    452 0           $form->{$defaultMethod} .= $html;
    453             }
    454 0 0 0       if(defined $method and exists $method->{default}){
    455 0           my $html = '';
    456 0           $html .= '';
    457 0           $form->{$defaultMethod} .= $html;
    458             }
    459            
    460 0 0         $form->{$defaultMethod} .= $defaultForm->{$defaultMethod} if defined $method;
    461             }
    462              
    463 0           return $form;
    464             }
    465              
    466             =encoding utf-8
    467              
    468             =head1 AUTHOR
    469              
    470             Václav Dovrtěl Evaclav.dovrtel@gmail.comE
    471              
    472             =head1 BUGS
    473              
    474             Please report any bugs or feature requests to github repository.
    475              
    476             =head1 ACKNOWLEDGEMENTS
    477              
    478             Inspired by L
    479              
    480             =head1 REPOSITORY
    481              
    482             L
    483              
    484             =head1 LICENSE AND COPYRIGHT
    485              
    486             Copyright 2015 Vaclav Dovrtel.
    487              
    488             This program is free software; you can redistribute it and/or modify it
    489             under the terms of either: the GNU General Public License as published
    490             by the Free Software Foundation; or the Artistic License.
    491              
    492             See L for more information.
    493              
    494             =cut
    495              
    496             1; # End of Rest::HtmlVis::Content