File Coverage

blib/lib/Nginx/FastCGI/Cache.pm

Criterion	Covered	Total	%
statement	89	92	96.7
branch	26	38	68.4
condition	20	25	80.0
subroutine	13	13	100.0
pod	3	3	100.0
total	151	171	88.3

use 5.12.1;
use warnings;

package Nginx::FastCGI::Cache;
$Nginx::FastCGI::Cache::VERSION = '0.010';
use Digest::MD5 'md5_hex';
use URI;
use feature qw/switch say/;
use Carp;

# ABSTRACT: Conveniently manage the nginx fastcgi cache

sub new {
    my ( $class, $args ) = @_;
    my $self = {};

    # directory must exist
    croak "location argument is mandatory $!" unless exists $args->{location};
    croak "unable to read location directory $args->{location} $!"
      unless -e $args->{location} && -x $args->{location};
    $self->{location} = $args->{location};

    # Must be 1-3 levels and have a value of 1 or 2
    if ( exists $args->{levels} ) {

        if (    ref $args->{levels} eq 'ARRAY'
            and @{ $args->{levels} } > 0
            and @{ $args->{levels} } < 4
            and @{ $args->{levels} } == grep { $_ > 0 and $_ < 3 }
            @{ $args->{levels} } )
        {
            $self->{levels} = $args->{levels};
        }
        else {
            croak "Invalid levels argument received $!";
        }
    }
    else {
        $self->{levels} = [ 1, 2 ];
    }

    # check only valid fastcgi cache key variables used
    if ( exists $args->{fastcgi_cache_key} ) {

        if (    ref $args->{fastcgi_cache_key} eq 'ARRAY'
            and @{ $args->{fastcgi_cache_key} } > 0
            and @{ $args->{fastcgi_cache_key} } ==
            grep /scheme|request_method|host|request_uri/,
            @{ $args->{fastcgi_cache_key} } )
        {
            $self->{fastcgi_cache_key} = $args->{fastcgi_cache_key};
        }
        else {
            croak "invalid fastcgi_cache_key received $!";
        }
    }
    else {
        $self->{fastcgi_cache_key} =
          [qw/scheme request_method host request_uri/];
    }

    return bless $self, $class;
}

# builds plaintext key using the fastcgi_cache_key elements
sub _build_fastcgi_key {
    my ( $self, $url, $method ) = @_;
    croak "missing url argument $!" unless $url;

    my $uri = URI->new($url);
    my $fastcgi_key;

    foreach ( @{ $self->{fastcgi_cache_key} } ) {
        given ($_) {
            when ('scheme') {
                $fastcgi_key .= $uri->scheme;
            }
            when ('request_method') {
                $fastcgi_key .= $method || 'GET';
            }
            when ('host') {
                $fastcgi_key .= $uri->host;
            }
            when ('request_uri') {
                $fastcgi_key .= $uri->path || '/';
            }
        }
    }
    return $fastcgi_key;
}

sub purge_file {
    my ( $self, $url, $method ) = @_;
    croak "missing url argument $!" unless $url;

    my $md5_key = md5_hex( $self->_build_fastcgi_key( $url, $method ) );
    my $path = $self->_build_path($md5_key);
    return $self->_purge_file($path);
}

sub _purge_file {
    my ( $self, $path_to_purge ) = @_;
    croak "missing path argument $!" unless $path_to_purge;

    if ( -e $path_to_purge and -w $path_to_purge ) {
        unlink $path_to_purge
          or croak "unable to purge cache at $path_to_purge $!";
        return 1;
    }
    croak "cache does not exist or is not writable at $path_to_purge";
    return 0;
}

sub purge_cache {
    my $self = shift;
    $self->{count_of_files_deleted} = 0;
    $self->_purge_cache( $self->{location} );
    return $self->{count_of_files_deleted};
}

# purge entire cache directory
sub _purge_cache {
    my ( $self, $dir ) = @_;
    croak "missing directory argument" unless $dir;

    $dir .= '/' unless '/' eq substr $dir, -1;

    opendir( my $DH, $dir ) or croak "Failed to open $dir $!";

    while ( readdir $DH ) {
        my $path = $dir . $_;
        if ( -d $path ) {

            # recurse but ignore Unix symlinks . and ..
            $self->_purge_cache($path) if $_ !~ /^\.{1,2}$/;
        }
        elsif ( -f $path ) {
            $self->{count_of_files_deleted} += $self->_purge_file($path);
        }
    }
}

# builds absolute path of file to purge
sub _build_path {
    my ( $self, $md5_key ) = @_;
    croak "missing md5 key argument $!" unless $md5_key;

    my $path = $self->{location};
    my $md5_path_key = $md5_key;    #the last few chars form the directory path
    for ( @{ $self->{levels} } ) {
        $path .= '/' . substr $md5_path_key, -$_;
        $md5_path_key = substr $md5_path_key, 0, -$_;
    }
    return "$path/$md5_key";
}

1;

__END__