package Gantry::Plugins::PageCache;

use strict; 
use warnings;

use Gantry;
use File::Spec;

my %registered_callbacks;

# lets export a do method and some conf accessors
use base 'Exporter';
our @EXPORT = qw( 
    gantry_pagecache_location
    gantry_pagecache_crud
    gantry_pagecache_action
    gantry_pagecache_mime_type
    gantry_pagecache_uri
    gantry_pagecache
);


#-----------------------------------------------------------
# $class->get_callbacks( $namespace )
#-----------------------------------------------------------
sub get_callbacks {
    my ( $class, $namespace ) = @_;

    return if ( $registered_callbacks{ $namespace }++ );

    return (
        { phase => 'post_init',    callback => \&gantry_pagecache_retrieve },
        { phase => 'post_process', callback => \&gantry_pagecache_store },
    );
}

#-----------------------------------------------------------
# gantry_pagecache_retrieve
#-----------------------------------------------------------
sub gantry_pagecache_retrieve {
    my ( $gobj ) = @_;

    # set config

    # 0/1
    $gobj->gantry_pagecache_crud( 
        $gobj->fish_config( 'gantry_pagecache_crud' ) || 0
    );
    
    # do_add, do_delete, ...
    $gobj->gantry_pagecache_action( 
        $gobj->fish_config( 'gantry_pagecache_action' ) || ''
    );

    # text/html, text/rss, ...
    $gobj->gantry_pagecache_mime_type( 
        $gobj->fish_config( 'gantry_pagecache_mime_type' ) || ''
    );

    # /controller1, ...
    $gobj->gantry_pagecache_location( 
        $gobj->fish_config( 'gantry_pagecache_location' ) || ''
    );

    # /controller1/view, ..., 
    $gobj->gantry_pagecache_uri( 
        $gobj->fish_config( 'gantry_pagecache_uri' ) || ''
    );
             
    my $cache_key;
    
    # special CRUD caching
    if ( $gobj->gantry_pagecache_crud() ) {

        if ( $gobj->is_post() 
            && $gobj->action() =~ /do_edit|do_add|do_delete/ ) {
        
            $cache_key = _make_gantry_cache_key( $gobj );

            # flag for cache store
            $gobj->gantry_pagecache( $cache_key );

            $gobj->cache_del( $cache_key . "content_type" );
            $gobj->cache_del( $cache_key );

            my @parts = split( '/', $cache_key );
            pop( @parts );
        
            $gobj->cache_del( join( '/', @parts ) . "content_type" );
            $gobj->cache_del( join( '/', @parts ) );
        
        }
    }

    # all other caching
    elsif ( _caching_enabled( $gobj ) ) {
        
        $cache_key = _make_gantry_cache_key( $gobj, { serialize => 1 } );
   
        if ( my $page = $gobj->cache_get( $cache_key ) ) {

            # set the content-type
            $gobj->content_type( 
                $gobj->cache_get( $cache_key . "content_type" )
            );
    
            # set cached page
            $gobj->gantry_response_page( $page );
        }
        # flag it for the cache store method
        else {
            $gobj->gantry_pagecache( $cache_key );
        } 
    }
        
}

#-----------------------------------------------------------
# gantry_pagecache_put
#-----------------------------------------------------------
sub _caching_enabled {
    my( $gobj ) = @_;

    my $cache = 0;
    
    if ( my @actions = split( /\s*,\s*/, $gobj->gantry_pagecache_action() ) ) {
        my $current_action = $gobj->action();
        foreach ( @actions ) {
            if ( $_ eq $current_action ) {
                return( 1 );
            }
        }
    }

    if ( my @types = split( /\s*,\s*/, $gobj->gantry_pagecache_mime_type() ) ) { 
        my $current_type = $gobj->content_type();
        foreach ( @types ) {
            if ( $_ eq $current_type ) {
                return( 1 );
            }
        }    
    }

    if ( my @locs = split( /\s*,\s*/, $gobj->gantry_pagecache_location() ) ) { 
        my $current_loc = $gobj->location();
        foreach ( @locs ) {
            if ( $_ eq $current_loc ) {
                return( 1 );
            }
        }    
    }
    
    if ( my @uris = split( /\s*,\s*/, $gobj->gantry_pagecache_uri() ) ) { 
        my $current_uri = $gobj->uri();
        foreach ( @uris ) {
            if ( $_ eq $current_uri ) {
                return( 1 );
            }
        }    
    }
    
    return( 0 );
}

#-----------------------------------------------------------
# gantry_pagecache_put
#-----------------------------------------------------------
sub gantry_pagecache_store {
    my ( $gobj ) = @_;

    # special CRUD caching
    if ( $gobj->gantry_pagecache_crud() ) {
        my $cache_key = $gobj->gantry_pagecache();

        if ( $gobj->action() =~ /do_edit|do_add|do_delete/ ) {

            # set page 
            $gobj->cache_set( $cache_key, $gobj->gantry_response_page() );

            # set content-type
            $gobj->cache_set( 
                ( $cache_key . 'content_type' ),
                $gobj->content_type()
            );
        }
    }
    
    # all other caching
    elsif( _caching_enabled( $gobj ) ) {
        my $cache_key = $gobj->gantry_pagecache();

        # set page 
        $gobj->cache_set( $cache_key, $gobj->gantry_response_page() );

        # set content-type
        $gobj->cache_set( 
            ( $cache_key . 'content_type' ),
            $gobj->content_type()
        );

    }   

}

#-----------------------------------------------------------
# _make_gantry_cache_key
#-----------------------------------------------------------
sub _make_gantry_cache_key {
    my( $gobj, $opt ) = @_;
     
    my @parts;   
    push( @parts,
        $gobj->namespace, 
        $gobj->uri, 
    );    

    if ( $opt->{serialize} ) {
        my $serial = _serialize_params( $gobj );        
        
        push( @parts, 
            ( $serial ? ( '?' . $serial ) : '' ),        
        );
    }
    
    return join( '', @parts );
}

#-----------------------------------------------------------
# _serialize_params
#-----------------------------------------------------------
sub _serialize_params {
    my( $gobj ) = @_;
    
    my %param = $gobj->get_param_hash;
    my @param_serial;    

    foreach my $k ( sort { $a cmp $b } keys %param ) {
        next if substr( $k, 0, 1 ) eq '.';
            
        push( @param_serial, "$k=$param{$k}" );
    }
    
    return join( '&', @param_serial );
}

#-------------------------------------------------
# $self->gantry_pagecache_crud
#-------------------------------------------------
sub gantry_pagecache_crud {
    my ( $self, $p ) = ( shift, shift );

    $$self{__GANTRY_PAGECACHE_CRUD__} = $p if defined $p;
    return( $$self{__GANTRY_PAGECACHE_CRUD__} ); 
    
} # end gantry_pagecache_crud

#-------------------------------------------------
# $self->gantry_pagecache_location
#-------------------------------------------------
sub gantry_pagecache_location {
    my ( $self, $p ) = ( shift, shift );

    $$self{__GANTRY_PAGECACHE_LOCATION__} = $p if defined $p;
    return( $$self{__GANTRY_PAGECACHE_LOCATION__} ); 
    
} # end gantry_pagecache_location

#-------------------------------------------------
# $self->gantry_pagecache_action
#-------------------------------------------------
sub gantry_pagecache_action {
    my ( $self, $p ) = ( shift, shift );

    $$self{__GANTRY_PAGECACHE_ACTION__} = $p if defined $p;
    return( $$self{__GANTRY_PAGECACHE_ACTION__} ); 
    
} # end gantry_pagecache_action

#-------------------------------------------------
# $self->gantry_pagecache_mime_type
#-------------------------------------------------
sub gantry_pagecache_mime_type {
    my ( $self, $p ) = ( shift, shift );

    $$self{__GANTRY_PAGECACHE_MIMETYPE__} = $p if defined $p;
    return( $$self{__GANTRY_PAGECACHE_MIMETYPE__} ); 
    
} # end gantry_pagecache_mime_type

#-------------------------------------------------
# $self->gantry_pagecache_uri
#-------------------------------------------------
sub gantry_pagecache_uri {
    my ( $self, $p ) = ( shift, shift );

    $$self{__GANTRY_PAGECACHE_URI__} = $p if defined $p;
    return( $$self{__GANTRY_PAGECACHE_URI__} ); 
    
} # end gantry_pagecache_uri

#-------------------------------------------------
# $self->gantry_pagecache
#-------------------------------------------------
sub gantry_pagecache {
    my ( $self, $p ) = ( shift, shift );

    $$self{__GANTRY_PAGECACHE__} = $p if defined $p;
    return( $$self{__GANTRY_PAGECACHE__} ); 
    
} # end gantry_pagecache

1;

__END__

=head1 NAME

Gantry::Plugins::PageCache - A plugin for caching application pages

=head1 SYNOPSIS

In Apache Perl startup or app.cgi or app.server:

    <Perl>
        # ...
        use MyApp qw{ 
            -Engine=CGI 
            -TemplateEngine=TT 
            Cache::FastMap # or Cache::Storable 
            PageCache 
        };
                
    </Perl>


=head1 DESCRIPTION

The purpose of the plugin is to store and retrieve cached application pages.

Note that you must include PageCache in the list of imported items when you use 
your base app module. 

=head1 CONFIGURATION

The following items can be set by configuration. If any of the following 
match then caching will be enabled. 

** At least one cache criteria must be set.

Cache pages based on a certain action.

 $self->gantry_pagecache_action( 'do_edit,do_delete,do_view' );

Cache pages based on the mime types.

 $self->gantry_pagecache_mime_type( 'text/html,text/rss' );

Cache every page that is produced by a controller.

 $self->gantry_pagecache_location( '/controller1' );

Cache distinct pages produced by a controller.

 $self->gantry_pagecache_uri( '/controller1/rss' );

=over 4

=back

=head1 METHODS

=over 4

=item get_callbacks

For use by Gantry.pm. Registers the callbacks needed for cache  management
during the PerlHandler Apache phase or its moral equivalent.

=item gantry_pagecache_store

Callback to store the cached page.

=item gantry_pagecache_retrieve

Callback to retrieve the cached page.

=item gantry_pagecache_location

Location(s) to cache

=item gantry_pagecache_action

Action(s) to cache

=item gantry_pagecache_crud

Boolean accessor for whether to attempt caching of CRUD behaviors.

=item gantry_pagecache_mime_type

MIME type(s) to cache

=item gantry_pagecache_uri

URI(s) to cache

=item gantry_pagecache

Holds the cache key if caching is enabled

=back

=head1 TODO

Add a caching scheme where you can use an L<SQL::Abstract> like syntax.

 {
    -and => {
        mime_type = [
            'text/html',
            'text/rss',
        ],
        location = [
            '/controller1',
            '/controller2',
        ],
    },
    -or => {
        mime_type => { '!=', 'img/gif' } 
    }
 }

=head1 SEE ALSO

    Gantry

=head1 AUTHOR

Tim Keefer <tim@timkeefer.com>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2007 Tim Keefer

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.6 or,
at your option, any later version of Perl 5 you may have available.

=cut