File Coverage

blib/lib/Rest/HtmlVis/Content.pm
Criterion Covered Total %
statement 23 228 10.0
branch 0 118 0.0
condition 0 82 0.0
subroutine 8 19 42.1
pod 6 6 100.0
total 37 453 8.1


line stmt bran cond sub pod time code
1             package Rest::HtmlVis::Content;
2              
3 1     1   612 use 5.006;
  1         6  
4 1     1   3 use strict;
  1         1  
  1         17  
5 1     1   2 use warnings FATAL => 'all';
  1         1  
  1         23  
6              
7 1     1   3 use parent qw( Rest::HtmlVis::Key );
  1         0  
  1         4  
8              
9 1     1   210630 use Plack::Request;
  1         50220  
  1         24  
10 1     1   398 use YAML::Syck;
  1         1402  
  1         66  
11 1     1   427 use URI::Escape::XS qw/decodeURIComponent/;
  1         1649  
  1         54  
12 1     1   464 use Encode;
  1         6479  
  1         1814  
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.13';
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           my $header = $self->getHeader;
    211 0           my $duration = sprintf ( "%.3f",$header->{'X-Runtime'} *1000);
    212              
    213 0           $ret .= "
    214             $links
    215            
    216            
    217            
    218            
     
    219             $content
    220            
    221            
    Duration: $duration ms
    222            
    223            
    224              
    225            
    226            
      ";
    227              
    228 0           foreach my $method (@defualtMethods){
    229 0 0         $ret .="
  • {$method}?'':" class=\"disabled\"")) . ">{$method}?" href=\"#$method\" data-toggle=\"tab\"":'') . ">" . uc($method) . "
  • ";
        0          
        0          
    230             }
    231 0           $ret .= "
    232            
    ";
    233 0           foreach my $method (@defualtMethods){
    234             $ret .= "
    235 0 0 0      
    ".($form->{$method}||'
    Not allowed
    ')."
        0          
    236            
    237             ";
    238             }
    239 0           $ret .= "
    240              
    241            
    242             ";
    243 0           return $ret;
    244             }
    245              
    246             sub _getAjaxCall {
    247 0     0     my ($self, $methodType, $params) = @_;
    248 0           my $jsvar = "\$(this).serialize()";
    249 0           my $url = $self->getEnv()->{REQUEST_URI};
    250 0 0         if (defined $params){
    251 0 0         $jsvar = $params->{jsvar} if exists $params->{jsvar};
    252 0 0         $url = $params->{url} if exists $params->{url};
    253             }
    254 0           return <
    255             sendPut('$methodType','$url',$jsvar);
    256             END
    257             }
    258              
    259              
    260             my $defaultForm = {
    261             get => "
    262            
    263            
    264            
    265            
    266            
    267            
    268             ",
    269            
    270             post => "
    271            
    272            
    273            
    274            
    275            
    276            
    277            
    278            
    279            
    280            
    281            
    282            
    283             ",
    284              
    285             put => "
    286            
    287            
    288            
    289            
    290            
    291             ",
    292              
    293             delete => "",
    294             };
    295              
    296              
    297             sub _decodeQuery {
    298 0   0 0     my $str = shift || return {};
    299 0           my %ret;
    300             map
    301             {
    302 0           my ($a,$b) = split '=', $_, 2;
      0            
    303 0 0         unless ($a =~ /^(?:format|enctype)$/i) {
    304 0           $b =~ s/\+/ /g;
    305 0           $b = Encode::decode_utf8(decodeURIComponent($b));
    306 0 0         if (exists $ret{$a}) {
    307 0           $ret{$a} .= "|$b";
    308             } else {
    309 0           $ret{$a} = $b;
    310             }
    311             }
    312             }
    313             split '&', $str;
    314 0           return {%ret}
    315             }
    316              
    317             sub _paramsToHtml {
    318 0     0     my ($env, $param, $paramValue) = @_;
    319 0           my $type = $paramValue->{type};
    320 0           my $name = $param;
    321 0 0 0       next unless $name and $type;
    322              
    323 0   0       my $description = $paramValue->{description}||'';
    324 0           my $html = '';
    325 0           my $query = _decodeQuery($env->{QUERY_STRING});
    326 0 0         if(exists $query->{$name}){
    327 0 0         $paramValue->{default} = $query->{$name} =~ /\|/?[split '\|',$query->{$name}]:$query->{$name};
    328             }
    329 0 0         if ($type eq 'text'){
        0          
        0          
        0          
        0          
        0          
    330 0   0       my $default = ($paramValue->{default}||'');
    331 0 0 0       if (ref $default eq 'HASH' || ref $default eq 'ARRAY'){
    332 0           $default = YAML::Syck::Dump($default);
    333             }
    334 0           $html .= '
    ';
    335 0 0         $html .= '' if ($description);
    336 0           $html .= '';
    337 0           $html .= '';
    338             }elsif ($type eq 'textarea'){
    339 0   0       my $rows = ($paramValue->{rows}||20);
    340 0   0       my $cols = ($paramValue->{cols}||3);
    341 0   0       my $default = ($paramValue->{default}||'');
    342 0 0 0       if (ref $default eq 'HASH' || ref $default eq 'ARRAY'){
    343 0           $default = YAML::Syck::Dump($default);
    344             }
    345 0           $html .= '
    ';
    346 0 0         $html .= '' if ($description);
    347 0           $html .= '';
    348 0           $html .= '';
    349             }elsif ($type eq 'checkbox'){
    350 0           $html .= '
    ';
    351 0 0         $html .= "' if ($description);
    352 0 0         $paramValue->{options} = [$paramValue->{options}] if ( ref $paramValue->{options} ne "ARRAY");
    353 0           foreach my $v (@{$paramValue->{options}}){
      0            
    354 0           my $optionName = ''; my $value = '';
      0            
    355 0 0         if (ref $v eq 'ARRAY'){
    356 0           ($optionName, $value) = @$v;
    357             }else{
    358 0           $optionName = $v; $value = $v;
      0            
    359             }
    360 0           my $checked='';
    361 0 0         if(exists $paramValue->{default}){
    362 0 0         if(ref $paramValue->{default} eq 'ARRAY'){
    363 0           foreach my $d (@{$paramValue->{default}}){
      0            
    364 0 0         $checked = 'checked="checked"'if ($d eq $value);
    365             }
    366             }else{
    367 0 0         $checked = 'checked="checked"'if ($paramValue->{default} eq $value);
    368             }
    369             }
    370 0           $html .= "
    ";
    371             }
    372 0           $html .= '';
    373             }elsif ($type eq 'radio'){
    374 0           $html .= '
    ';
    375 0 0         $html .= "' if ($description);
    376 0           foreach my $v (@{$paramValue->{options}}){
      0            
    377 0           my $optionName = ''; my $value = '';
      0            
    378 0 0         if (ref $v eq 'ARRAY'){
    379 0           ($optionName, $value) = @$v;
    380             }else{
    381 0           $optionName = $v; $value = $v;
      0            
    382             }
    383 0           my $checked='';
    384 0 0         if(exists $paramValue->{default}){
    385 0 0         if(ref $paramValue->{default} eq 'ARRAY'){
    386 0           foreach my $d (@{$paramValue->{default}}){
      0            
    387 0 0         $checked = 'checked="checked"'if ($d eq $value);
    388             }
    389             }else{
    390 0 0         $checked = 'checked="checked"'if ($paramValue->{default} eq $value);
    391             }
    392             }
    393 0           $html .= "
    ";
    394             }
    395 0           $html .= '';
    396             }elsif ($type eq 'select'){
    397 0           $html .= '
    ';
    398 0 0         $html .= '' if ($description);
    399 0           $html .= '
    400 0           foreach my $v (@{$paramValue->{options}}){
      0            
    401 0           my $name = ''; my $id = '';
      0            
    402 0 0         if (ref $v eq 'ARRAY'){
    403 0           ($id, $name) = @$v;
    404             }else{
    405 0           $name = $v; $id = $v;
      0            
    406             }
    407 0 0 0       my $default = (defined $paramValue->{default} && $id eq $paramValue->{default}) ? 'selected="selected"' : '';
    408 0           $html .= '';
    409             }
    410 0           $html .= '';
    411 0           $html .= '';
    412             }elsif ($type eq 'hidden'){
    413 0           $html .= " ";
    414            
    415             }
    416 0           return $html;
    417             }
    418              
    419             sub _extFormToHtml {
    420 0     0     my ($env, $struct, @methods) = @_;
    421 0           my $form = {};
    422 0           foreach my $defaultMethod (@methods) {
    423 0           my $method = delete $struct->{$defaultMethod};
    424 0 0 0       if (defined $method and exists $method->{params} && ref $method->{params} eq 'HASH'){
          0        
    425 0           my $html = '';
    426 0           delete $method->{params}{format};
    427             #delete $method->{params}{ENCTYPE};
    428 0   0       foreach my $param (sort {($method->{params}{$a}{description}||$a) cmp ($method->{params}{$b}{description}||$b) } keys %{$method->{params}}) {
      0   0        
      0            
    429 0           $html .= _paramsToHtml($env, $param, $method->{params}{$param});
    430             }
    431 0           $form->{$defaultMethod}{html} .= $html;
    432             }
    433 0 0 0       if(defined $method and exists $method->{default}){
    434 0           my $html = '';
    435 0           $html .= '';
    436 0           $form->{$defaultMethod}{html} .= $html;
    437             }
    438 0           delete $method->{params};
    439 0           $form->{$defaultMethod}{params} = $method;
    440 0 0         $form->{$defaultMethod}{html} .= $defaultForm->{lc ($method->{method}) } if exists $defaultForm->{ lc($method->{method}) };
    441             }
    442              
    443 0           return $form;
    444             }
    445              
    446             sub _formToHtml {
    447 0     0     my ($env,$struct, @methods) = @_;
    448 0           my $form = {};
    449 0           foreach my $defaultMethod (@methods) {
    450 0           my $method = delete $struct->{$defaultMethod};
    451 0 0 0       if (defined $method and exists $method->{params} && ref $method->{params} eq 'HASH'){
          0        
    452 0           my $html = '';
    453 0   0       foreach my $param (sort {($method->{params}{$a}{description}||$a) cmp ($method->{params}{$b}{description}||$b) } keys %{$method->{params}}) {
      0   0        
      0            
    454 0           $html .= _paramsToHtml($env, $param, $method->{params}{$param});
    455             }
    456 0           $form->{$defaultMethod} .= $html;
    457             }
    458 0 0 0       if(defined $method and exists $method->{default}){
    459 0           my $html = '';
    460 0           $html .= '';
    461 0           $form->{$defaultMethod} .= $html;
    462             }
    463            
    464 0 0         $form->{$defaultMethod} .= $defaultForm->{$defaultMethod} if defined $method;
    465             }
    466              
    467 0           return $form;
    468             }
    469              
    470             =encoding utf-8
    471              
    472             =head1 AUTHOR
    473              
    474             Václav Dovrtěl Evaclav.dovrtel@gmail.comE
    475              
    476             =head1 BUGS
    477              
    478             Please report any bugs or feature requests to github repository.
    479              
    480             =head1 ACKNOWLEDGEMENTS
    481              
    482             Inspired by L
    483              
    484             =head1 REPOSITORY
    485              
    486             L
    487              
    488             =head1 LICENSE AND COPYRIGHT
    489              
    490             Copyright 2015 Vaclav Dovrtel.
    491              
    492             This program is free software; you can redistribute it and/or modify it
    493             under the terms of either: the GNU General Public License as published
    494             by the Free Software Foundation; or the Artistic License.
    495              
    496             See L for more information.
    497              
    498             =cut
    499              
    500             1; # End of Rest::HtmlVis::Content