view release on metacpan or  search on metacpan

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

            map { { label => $_, value => $_ } }
              qw/plain wiki markdown pod html/
        ],
    };
    push @list, draft => { type => 'boolean', } unless $type eq 'info';

    @list = _fill_values( $entry, @list );
    return wantarray ? @list : \@list;
}

sub _fill_values {
    my $entry  = shift;
    my @fields = @_;
    my @filled;
    while (@fields) {
        my $name = shift @fields;
        my $opt  = shift @fields;
        $opt->{default} = $entry->serialize_field($name);

        if ( $name eq 'author' && !$opt->{default} ) {
            $opt->{default} = current_user();
        }
        push @filled, $name, $opt;
    }
    return @filled;
}

use Plack::Builder;

sub app {
    require Beagle::Web::Router;

    builder {
        for my $root ( system_roots() ) {
            enable 'Static',
              path         => sub { s!^/system/!! },
              root         => $root,
              pass_through => 1;
        }

        \&handle_request;
    }
}

my ( $bh, %updated, %bh, $name, $names, $prefix, $static, $router, %xslate );
$prefix = '/';
my ( %css, %js );
my $req;

sub template_exists {
    shift @_ if @_ && $_[0] eq 'Beagle::Web';
    my $name = shift;
    return unless defined $name;
    $name .= '.tx' unless $name =~ /\.tx$/;
    my @roots = (
        map( { catdir( $_, $bh->info->layout ), } web_template_roots() ),
        map( { catdir( $_, 'base' ), } web_template_roots() )
    );
    my @parts = split /\//, $name;
    for my $root (@roots) {
        return 1 if -e encode( locale_fs => catfile( $root, @parts ) );
    }
    return;
}

sub system_file_exists {
    shift @_ if @_ && $_[0] eq 'Beagle::Web';
    my $name = shift;
    return unless defined $name;
    my @roots = system_roots();
    my @parts = split /\//, $name;
    for my $root (@roots) {
        return 1 if -e encode( locale_fs => catfile( $root, @parts ) );
    }
    return;
}

use Text::Xslate;

sub xslate {
    shift @_ if @_ && $_[0] eq 'Beagle::Web';
    my $n = shift   || $name;
    my $b = $bh{$n} || $bh;
    return $xslate{$n} if $xslate{$n};
    return $xslate{$n} = Text::Xslate->new(
        path => [
            map( { catdir( $_, $b->info->layout ) } web_template_roots() ),
            map( { catdir( $_, 'base' ) } web_template_roots() ),
        ],
        cache_dir   => catdir( File::Spec->tmpdir, 'beagle_web_cache' ),
        cache       => 1,
        input_layer => ':utf8',
        function    => {
            substr => sub {
                my ( $content, $number ) = @_;
                $number ||= 40;
                utf8::decode($content);
                if ( length $content > $number ) {
                    $content = substr( $content, 0, $number - 4 ) . '...';
                }
                utf8::encode($content);
                return $content;
            },
            length => sub {
                return length shift;
            },
            size => sub {
                my $value = shift;
                return 0 unless $value;
                return 1 unless ref $value;
                if ( ref $value eq 'ARRAY' ) {
                    return scalar @$value;
                }
                elsif ( ref $value eq 'HASH' ) {
                    my $size = 0;
                    for ( keys %$value ) {
                        if ( ref $value->{$_} && ref $value->{$_} eq 'ARRAY' ) {
                            $size += @{ $value->{$_} };
                        }
                        else {
                            $size += 1;
                        }
                    }
                    return $size;
                }
                return;
            },
            split_id => sub {
                join '/', split_id(shift);
            },
            email_name => sub {
                require Email::Address;
                my $value = shift;