File: Page.pm

package info (click to toggle)
libmojomojo-perl 1.01%2Bdfsg-1
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 4,272 kB
  • ctags: 879
  • sloc: perl: 14,055; sh: 145; xml: 120; ruby: 6; makefile: 2
file content (428 lines) | stat: -rw-r--r-- 13,290 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
package MojoMojo::Schema::Result::Page;

use strict;
use warnings;
use Carp qw/croak/;

use parent qw/MojoMojo::Schema::Base::Result/;

__PACKAGE__->load_components( "Core" );
__PACKAGE__->table("page");
__PACKAGE__->add_columns(
    "id",
    { data_type => "INTEGER", is_nullable => 0, size => undef, is_auto_increment => 1 },
    "version",
    { data_type => "INTEGER", is_nullable => 1, size => undef },
    "parent",
    { data_type => "INTEGER", is_nullable => 1, size => undef },
    "name",
    { data_type => "VARCHAR", is_nullable => 1, size => 200 },
    "name_orig",
    { data_type => "VARCHAR", is_nullable => 1, size => 200 },
    "depth",
    { data_type => "INTEGER", is_nullable => 1, size => undef },
    "lft",
    { data_type => "INTEGER", is_nullable => 1, size => undef },
    "rgt",
    { data_type => "INTEGER", is_nullable => 1, size => undef },
    "content_version",
    { data_type => "INTEGER", is_nullable => 1, size => undef },
);
__PACKAGE__->set_primary_key("id");
__PACKAGE__->add_unique_constraint( "page_unique_child_index", [ "parent", "name" ] );
__PACKAGE__->has_many( "wantedpages", "MojoMojo::Schema::Result::WantedPage", { "foreign.from_page" => "self.id" } );
__PACKAGE__->belongs_to( "parent", "MojoMojo::Schema::Result::Page", { id => "parent" } );
__PACKAGE__->has_many( "children", "MojoMojo::Schema::Result::Page", { "foreign.parent" => "self.id" } );
__PACKAGE__->belongs_to( "content", "MojoMojo::Schema::Result::Content", { page => "id", version => "content_version" } );
__PACKAGE__->has_many( "versions", "MojoMojo::Schema::Result::Content", { "foreign.page" => "self.id" }, { order_by => 'version desc' } );
__PACKAGE__->belongs_to( "page_version", "MojoMojo::Schema::Result::PageVersion", { page => "id", version => "version" } );
__PACKAGE__->has_many( "tags",       "MojoMojo::Schema::Result::Tag",  { "foreign.page"      => "self.id" } );
__PACKAGE__->has_many( "links_from", "MojoMojo::Schema::Result::Link", { "foreign.from_page" => "self.id" } );
__PACKAGE__->has_many( "links_to",   "MojoMojo::Schema::Result::Link", { "foreign.to_page"   => "self.id" } );
__PACKAGE__->has_many( "roleprivileges", "MojoMojo::Schema::Result::RolePrivilege", { "foreign.page"   => "self.id" } );
__PACKAGE__->has_many( "attachments",    "MojoMojo::Schema::Result::Attachment",    { "foreign.page"   => "self.id" }, {order_by=>'name asc' } );
__PACKAGE__->has_many( "comments",       "MojoMojo::Schema::Result::Comment",       { "foreign.page"   => "self.id" } );
__PACKAGE__->has_many( "journals",       "MojoMojo::Schema::Result::Journal",       { "foreign.pageid" => "self.id" } );

=head1 NAME

MojoMojo::Schema::Result::Page - store pages

=head1 METHODS

=cut

=head2 update_content <%args>

Create a new content version for this page.

%args is each column of L<MojoMojo::Schema::Result::Content>.

=cut

# update_content: this whole method may need work to deal with workflow.
# maybe it can't even be called if the site uses workflow...
# may need fixing for better conflict handling, too. maybe use a transaction?

sub update_content {
    my ( $self, %args ) = @_;

    my $content_version = (
          $self->content
        ? $self->content->max_version()
        : undef
    );
    my %content_data =
        map { $_ => $args{$_} } $self->result_source->related_source('content')->columns;
    my $now = DateTime->now;
    @content_data{qw/page version status release_date/} =
        ( $self->id, ( $content_version ? $content_version + 1 : 1 ), 'released', $now, );
    my $content =
        $self->result_source->related_source('content')->resultset->create( \%content_data );
    $self->content_version( $content->version );
    $self->update;
    
    $self->page_version->content_version_first($content_version)
        unless defined $self->page_version->content_version_first;
    $self->page_version->content_version_last($content_version);
    $self->page_version->update;

    if ( my $previous_content = $content->previous ) {
        $previous_content->remove_date($now);
        $previous_content->status('removed');
        $previous_content->comments("Replaced by version $content_version.");
        $previous_content->update;
    }
    else {
        $self->result_source->resultset->set_paths($self);
    }
    foreach my $want_me ($self->result_source->schema->resultset('WantedPage')
                              ->search( { to_path => $self->path } ) ) {
        my $wantme_page = $want_me->from_page;

        # convert the wanted into links
        $self->result_source->schema->resultset('Link')->create({
            from_page => $wantme_page,
            to_page   => $self,
        });

        # clear the precompiled (will be recompiled on view)
        if ( my $wantme_content = $wantme_page->content ) {
            $wantme_content->precompiled(undef);
            $wantme_content->update;
        }

        # ok, she don't want me anymore ;)
        $want_me->delete();
    }

}    # end sub update_content

=head2 add_version

    my $page_version_new = $page->add_version(
        creator => $user_id,
        name_orig => $page_new_name,
    );

Arguments: %replacementdata

Returns: The new L<PageVersion|MojoMojo::Schema::Result::PageVersion>
object.
    
Creates a new page version by cloning the latest version (hence pointing
to the same content), and replacing its values with data in the replacement
hash.

Used for renaming pages.

=cut

sub add_version {
    my ( $self, %args ) = @_;
    my $now = DateTime->now;

    my $page_version_last = $self->page_version->latest_version();
    
    # clone the last version and update fields passed in %args
    my %page_version_data = map {
        exists $args{$_}
      ? ( $_ => $args{$_} )
      : ( $_ => $page_version_last->$_ )
    } $self->result_source->related_source('page_version')->columns;
    
    delete $args{creator};  # creator is a field in page_version, not in page

    # for the new version, set the version number, status, and release date
    @page_version_data{qw/
          version                           status     release_date/} =
        ( $page_version_last->version + 1, 'released', $now );

    my $page_version_new;
    # commit the new version to the database and update the previously last version to indicate its removal
    $self->result_source->schema->txn_do(sub {
    
        $page_version_new = 
            $self->result_source->related_source('page_version')->resultset->create( \%page_version_data );
        
        $page_version_last->update({
            remove_date => $now,
            status => 'removed',
            comments => 'Replaced by version ' . $page_version_data{version}
        });
        
        $self->update(\%args);
    });
    
    return $page_version_new;
}

=head2 tagged_descendants($tag)

Return descendants with the given tag, ordered by name.

=cut

sub tagged_descendants {
    my ( $self, $tag ) = @_;
    my (@pages) = $self->result_source->resultset->search(
        {
            'ancestor.id' => $self->id,
            'tag'         => $tag,
            -or           => [
                'me.id' => \'=ancestor.id',
                -and    => [ 'me.lft', \'> ancestor.lft', 'me.rgt', \'< ancestor.rgt', ],
            ],

            'me.id'           => \'=tag.page',
            'content.page'    => \'=me.id',
            'content.version' => \'=me.content_version',
        },
        {
            distinct => 1,
            from     => "page as me, page as ancestor, tag, content",
            order_by => 'me.name',
        }
    )->all;
    return $self->result_source->resultset->set_paths(@pages);
}

=head2 tagged_descendants_by_date

Return descendants with the given tag, ordered by creation time, most
recent first.

=cut

sub tagged_descendants_by_date {
    my ( $self, $tag ) = @_;
    my (@pages) = $self->result_source->resultset->search(
        {
            'ancestor.id' => $self->id,
            'tag'         => $tag,
            -or           => [
                'me.id' => \'=ancestor.id',
                -and    => [ 'me.lft', \'> ancestor.lft', 'me.rgt', \'< ancestor.rgt', ],
            ],
            'me.id'           => \'=tag.page',
            'content.page'    => \'=me.id',
            'content.version' => \'=me.content_version',
        },
        {
            group_by => [ ('me.id') ],
            from     => "page as me, page as ancestor, tag, content",
            order_by => 'content.created DESC',
        }
    );
    return $self->result_source->resultset->set_paths(@pages);
}



=head2 descendants

  @descendants = $page->descendants( [$resultset_page] );

In list context, returns all descendants of this page (no paging), including 
the page itself. In scalar context, returns the resultset object.

If the optional $resultset_page is passed, returns that page from the
L<resultset|DBIx::Class::ResultSet>.

=cut

sub descendants {
    my ($self, $resultset_page)  = @_;
    
    my $rs = $self->result_source->resultset->search(
        {
            'ancestor.id' => $self->id,
            -or           => [
                'ancestor.id' => \'=me.id',
                -and          => [
                    'me.lft' => \'> ancestor.lft',
                    'me.rgt' => \'< ancestor.rgt',
                ]
            ],
        },
        {
            $resultset_page? (page => $resultset_page || 1, rows => 20) : (),
            from     => 'page me, page ancestor',
            order_by => ['me.name']
        }
    );  # an empty arrayref if there are no results because we'll dereference in the 'return'

    return wantarray?
        $self->result_source->resultset->set_paths($rs->all)
      : $rs
}


=head2 descendants_by_date

  @descendants = $page->descendants_by_date;

Like L</descendants>, but returns pages sorted by the dates of their
last content release dates and pages results (20 per page).

=cut

sub descendants_by_date {
    my $self  = shift;
    my @pages = $self->result_source->resultset->search(
        {
            'ancestor.id'     => $self->id,
            'content.page'    => \'= me.id',
            'content.version' => \'= me.content_version',
            -or               => [
                -and => [
                    'me.lft' => \'> ancestor.lft',
                    'me.rgt' => \'< ancestor.rgt'
                ],
                'ancestor.id' => \'= me.id',
            ]
        },
        {
            rows     => 20,
            page     => 1,
            from     => 'page as me, page as ancestor, content',
            order_by => 'content.created DESC'
        }
    );
    return $self->result_source->resultset->set_paths(@pages);
}


=head2 user_tags($user)

Return popular tags for this page used C<$user>.

=cut

sub user_tags {
    my ( $self, $user ) = @_;
    my (@tags) = $self->result_source->related_source('tags')->resultset->search(
        {
            page   => $self->id,
            person => $user,
        },
        {
            select   => [ 'me.id', 'me.tag', 'count(me.tag) as refcount' ],
            as       => [ 'id',    'tag',    'refcount' ],
            order_by => ['refcount'],
            group_by => [ 'me.id','me.tag'],
        }
    );
    return @tags;
}

=head2 others_tags($user)

Return popular tags for this page used by other people than C<$user>.

=cut

sub others_tags {
    my ( $self, $user ) = @_;
    my (@tags) = $self->result_source->related_source('tags')->resultset->search(
        {
            page   => $self->id,
            person => { '!=', $user }
        },
        {
            select   => [ 'me.id', 'me.tag', 'count(me.tag) as refcount' ],
            as       => [ 'id',    'tag',    'refcount' ],
            order_by => ['refcount'],
            group_by => ['me.tag','me.id'],
        }
    );
    return @tags;
}

=head2 tags_with_counts($user)

Return an array of {id, tag, refcount} for the C<$user>'s tags.

=cut

sub tags_with_counts {
    my ( $self, $user ) = @_;
    my (@tags) = $self->result_source->related_source('tags')->resultset->search(
        { page => $self->id, },
        {
            select   => [ 'me.id', 'me.tag', 'count(me.tag) as refcount' ],
            as       => [ 'id',    'tag',    'refcount' ],
            order_by => ['refcount'],
            group_by => [ 'me.id', 'me.tag'],
        }
    );
    return @tags;
}

=head2 path( [$path] )

TODO Accessor?

=cut

sub path {
    my ( $self, $path ) = @_;
    require Carp;
    if ( defined $path ) {
        $self->{path} = $path;
    }
    unless ( defined $self->{path} ) {
        return '/' if ( $self->depth == 0 );
        $self->result_source->resultset->set_paths($self);

        # croak 'path is not set on the page object: ' . $self->name;
    }
    return $self->{path};
}

=head2 has_photos

Return the number of photos attached to this page. Use for galleries.

=cut

sub has_photos {
    my $self = shift;
    return $self->result_source->schema->resultset('Photo')->search(
        { 'attachment.page' => $self->id },
        { join => [qw/attachment/] }
    )->count;
}

=head1 AUTHOR

Marcus Ramberg <mramberg@cpan.org>

=head1 LICENSE

This library is free software. You can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;