view release on metacpan or  search on metacpan

lib/Beagle/Web/Router.pm  view on Meta::CPAN

};

get '/static/*' => sub {
    my %vars = @_;
    my @parts = split '/', decode_utf8 $vars{splat}[0];
    my $file =
      encode( 'locale_fs',
        catfile( static_root( handle() ), @parts ) );
    return unless -e $file && -r $file;

    content_type( mime_type($file) );
    return scalar read_file $file;
};

post '/utility/markitup' => sub {
    my $data = request()->param('data');
    return unless $data;
    my $format = request()->param('format');
    return unless $format;

    my $content;
    my $parse_method = Beagle::Util->can( "parse_$format" );
    if ( $parse_method ) {
        $content = $parse_method->($data);
    }

    render 'markitup',
      content => $content,
      prefix  => prefix() || '../';
};

any '/utility/markitup_preview' => sub {
    render 'markitup_preview', prefix  => prefix() || '../';
};

get '/extra/*' => sub {
    my %vars = @_;
    my $name = decode_utf8 $vars{splat}[0];
    return unless $name;
    return unless Beagle::Web->template_exists("extra/$name");
    render("extra/$name");
};

get '/admin/term' => sub {
    render('admin/term');
};

post '/admin/term' => sub {
    my $data;
    content_type('application/json');

    eval { $data = from_json( request()->content, { utf8 => 1 } ) };
    if ( $@ ) {
        return to_json( { error => { message => decode( locale => $@ ) } } );
    }
    else {

        my $params = $data->{params} || [];

        local $ENV{BEAGLE_WEB_TERM} = 1;
        local @ARGV = ( $data->{method}, @$params );
        my $out;
        open my $out_fh, '>', \$out or die $!;
        local *STDOUT = $out_fh;
        local *STDERR = $out_fh;

        eval { Beagle::Cmd->run };
        my $ret = { id => $data->{id} };
        if ($@) {
            $ret->{error}{message} = decode( locale => $@ );
        }
        else {
            $ret->{result} = decode( locale => $out );
        }
        return to_json($ret);
    }
};

1;

__END__

=head1 AUTHOR

sunnavy <sunnavy@gmail.com>


=head1 LICENCE AND COPYRIGHT

Copyright 2011 sunnavy@gmail.com

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.