view release on metacpan or  search on metacpan

lib/Ado/Control.pm  view on Meta::CPAN

package Ado::Control;
use Mojo::Base 'Mojolicious::Controller';

our $DEV_MODE = ($ENV{MOJO_MODE} || '' =~ /dev/);
has description => 'Ado is a framework for web projects based on Mojolicious,'
  . ' written in the Perl programming language.';
has keywords => 'SSOT, CRM, ERP, CMS, Perl, SQL';

sub generator { return 'Ado ' . $Ado::VERSION . ' - ' . $Ado::CODENAME }

sub config {
    state $app = $_[0]->app;
    return $app->config(ref $_[0])->{$_[1]} if $_[1];    #if key
    return $app->config(ref $_[0]);
}

sub debug;
if ($DEV_MODE) {

    sub debug {
        my ($package, $filename, $line, $subroutine) = caller(0);
        state $log = $_[0]->app->log;
        return $log->debug(
            @_[1 .. $#_]                                 #, "    at $filename:$line"
        );
    }
}

#Require a  list of formats or render "415 - Unsupported Media Type"
#and return false.
sub require_formats {
    my ($c, @formats) = @_;
    unless ($c->accepts(@formats)) {

        #propose urls with the accepted formats
        my @locations = map { $c->url_for(format => $_)->to_abs } @formats;
        $c->res->headers->add('Content-Location' => $locations[0]);

        my $message =
            "415 - Unsupported Media Type \""
          . ($c->req->headers->accept // '')
          . "\". Please try ${\ join(', ', @locations)}!";
        $c->debug($c->url_for . " requires " . join(',', @formats) . ". Rendering: $message")
          if $DEV_MODE;
        $c->render(
            text   => $message,
            status => 415
        );
        return;
    }
    return 1;
}

sub list_for_json {
    my ($c, $range, $dsc_objects, $meta) = @_;
    my $url = $c->url_with(format => $c->stash->{format})->query('limit' => $$range[0]);
    my $prev = $$range[1] - $$range[0];
    $prev = $prev > 0 ? $prev : 0;

    #arrayref of hashes or DSC objects?
    my $data =
      ref($dsc_objects->[0]) eq 'HASH'
      ? $dsc_objects
      : [map { $_->data } @$dsc_objects];
    return {
        json => {

            #TODO: Strive to implement linking using this reference:
            # http://www.iana.org/assignments/link-relations/link-relations.xhtml
            query => {offset => $$range[1], limit => $$range[0]},
            links => [
                {   rel  => 'self',
                    href => "" . $url->query([offset => $$range[1]])
                },
                (   @$data == $$range[0]
                    ? { rel  => 'next',
                        href => "" . $url->query([offset => $$range[0] + $$range[1]])
                      }
                    : ()
                ),
                (   $$range[1]
                    ? { rel  => 'prev',
                        href => "" . $url->query([offset => $prev])
                      }
                    : ()
                ),
            ],
            data => $data,
            ($meta ? (meta => $meta) : ())
        },
    };
}    # end sub list_for_json

#validates input parameters given a rules template
sub validate_input {
    my ($c, $template) = @_;
    my $v      = $c->validation;
    my $errors = {};
    foreach my $param (keys %$template) {
        my $checks = $template->{$param};
        $checks || next;    #false or undefined?!?

        #field
        my $f =
            $checks->{required}
          ? $v->required($param)
          : $v->optional($param);
        foreach my $check (keys %$checks) {
            next if $check eq 'required';
            if (ref $$checks{$check} eq 'HASH') {
                $f->$check(%{$checks->{$check}});
            }
            elsif (ref $$checks{$check} eq 'ARRAY') {
                $f->$check(@{$checks->{$check}});
            }
            else { $f->$check($checks->{$check}) }
        }    #end foreach my $check
        $errors->{$param} = $f->error($param)
          if $f->error($param);

    }    #end foreach my $param

    return {
        (   !!keys %{$errors}