view release on metacpan or  search on metacpan

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

    shift @_ if @_ && $_[0] eq 'Beagle::Web';

    my $bh   = handle();
    my $name = $bh->name;
    return $feed{$name} if $feed{$name};

    my $backend = $bh->backend;
    my $info    = $bh->info;
    my $entries = $bh->entries;

    require XML::FeedPP;
    my $feed = XML::FeedPP::RSS->new( link => $info->url );
    $feed->copyright( $info->copyright );
    $feed->title( $info->title );
    $feed->description( $info->body );
    $feed->pubDate( $entries->[0]->created ) if @$entries;
    $feed->image( $info->avatar, $info->title, $info->url, $info->body, 80,
        80 );
    $feed->set( 'category' => from_array( $info->tags ) );

    my $limit = $ENV{BEAGLE_FEED_LIMIT} || $info->feed_limit() || 20;
    if ( scalar @$entries > $limit ) {
        $entries = [ @{$entries}[ 0 .. $limit - 1 ] ];
    }

    for my $entry (@$entries) {
        my $item = $feed->add_item();
        $item->link( $info->url . "/entry/" . $entry->id );
        $item->guid( $item->link );
        if ( $entry->can('title') ) {
            $item->title( $entry->title );
        }
        elsif ( $entry->can('summary') ) {
            $item->title( $entry->summary(30) );
        }
        else {
            $item->title( $entry->type );
        }

        $item->description(
              $entry->can('body_html')
            ? $entry->body_html
            : $entry->body
        );

        $item->pubDate( $entry->created );
        $item->author( $entry->author
              || $info->name . ' (' . $info->email . ')' );
        my $category = $entry->type,;
        if ( $entry->can('tags') ) {
            $category = join ', ', $category, $entry->type,
              from_array( $entry->tags );
        }
        $item->category($category);
    }

    $feed->normalize();
    return $feed{$name} = $feed;
}

sub update_feed {
    shift @_ if @_ && $_[0] eq 'Beagle::Web';
    my $bh = shift;
    delete $feed{ $bh->name };
    feed($bh);
}

my %archives;
my %tags;

use Storable 'dclone';

sub archives {
    shift @_ if @_ && $_[0] eq 'Beagle::Web';
    my $bh   = shift;
    my $name = $bh->name;
    return dclone( $archives{$name} ) if $archives{$name};

    my $archives = {};
    for my $entry ( @{ $bh->entries } ) {
        push @{ $archives->{ $entry->created_year }{ $entry->created_month } },
          $entry;
    }

    $archives{$name} = $archives;
    return dclone($archives);
}

sub update_archives {
    shift @_ if @_ && $_[0] eq 'Beagle::Web';
    my $bh = shift;
    delete $archives{ $bh->name };
    archives($bh);
}

sub tags {
    shift @_ if @_ && $_[0] eq 'Beagle::Web';
    my $bh   = shift;
    my $name = $bh->name;

    return dclone( $tags{$name} ) if $tags{$name};

    my $tags = {};
    for my $entry ( @{ $bh->entries } ) {
        if ( $entry->can('tags') ) {
            for my $tag ( @{ $entry->tags } ) {
                push @{ $tags->{$tag} }, $entry;
            }
        }
        push @{ $tags->{ $entry->type } }, $entry;
    }
    $tags{$name} = $tags;
    return dclone($tags);
}

sub update_tags {
    shift @_ if @_ && $_[0] eq 'Beagle::Web';
    my $bh = shift;
    delete $tags{ $bh->name };
    tags($bh);
}

sub field_list {
    shift @_ if @_ && $_[0] eq 'Beagle::Web';
    my $entry = shift;
    my @list  = (
        body  => { type => 'textarea', },
    );

    my $type = $entry->type;
    if ( $type ne 'info' ) {
        push @list, author => { type => 'text', };
    }

    if ( $type ne 'comment' ) {
        push @list, tags => { type => 'text', };
    }

    if ( $type ne 'entry' ) {
        my $names = $entry->extra_meta_fields;
        for my $name (@$names) {
            my $attr  = $entry->meta->get_attribute($name);
            my $const = $attr->type_constraint;
            if ($const) {
                if ( $const->can('values') ) {
                    push @list, $name => {
                        type    => 'select',
                        options => [
                            map { { label => $_, value => $_ } } $const->values,
                        ],
                    };
                    next;
                }
                elsif ( "$const" eq 'Bool' ) {
                    push @list, $name => { type => 'boolean', };
                    next;
                }
                elsif ( "$const" eq 'BeagleLayout' ) {
                    push @list, $name => {
                        type    => 'select',
                        options => [
                            map { { label => $_, value => $_ } } qw/blog plain/,
                        ],
                    };
                    next;
                }
                elsif ( "$const" eq 'BeagleTheme' ) {
                    push @list, $name => {
                        type    => 'select',
                        options => [
                            map { { label => $_, value => $_ } }
                              qw/orange blue dark/,
                        ],
                    };
                    next;
                }