File Coverage

blib/lib/Apache/RandomImage.pm

Criterion	Covered	Total	%
statement	10	12	83.3
branch			n/a
condition			n/a
subroutine	4	4	100.0
pod			n/a
total	14	16	87.5

package Apache::RandomImage;

use strict;
use warnings;

use DirHandle;
use mod_perl;

BEGIN {
    my $MP2 = ( exists $ENV{MOD_PERL_API_VERSION} and
                      $ENV{MOD_PERL_API_VERSION} >= 2 );

    if (defined $MP2) {
        require Apache2::RequestRec;
        require Apache2::RequestUtil;
        require Apache2::SubRequest;
        require Apache2::Log;
        require Apache2::Const;
        Apache2::Const->import(qw(OK DECLINED NOT_FOUND));
    }
    else {
        require Apache::Constants;
        Apache::Constants->import(qw(OK DECLINED NOT_FOUND));
    }
}


=head1 NAME

Apache::RandomImage - Lightweight module to randomly display images from a directory.

=head1 VERSION

Version 0.3

=cut

# http://module-build.sourceforge.net/META-spec-current.html
# Does not like v0.3 versions :-/
#use version; our $VERSION = qv('0.3');
our $VERSION = '0.3';

=head1 SYNOPSIS

  Configure this module as a response handler to activate this module. The following
  examples will result in an image being randomly selected from the "images" directory.

    #mod_perl2 (PerlResponseHandler)

        SetHandler modperl
        PerlSetVar Suffixes "gif png jpg"
        PerlResponseHandler Apache::RandomImage


    #mod_perl1 (PerlHandler)

        SetHandler perl-script
        PerlSetVar Suffixes "gif png jpg tif jpeg"
        PerlHandler Apache::RandomImage


=head1 DESCRIPTION

Apache::RandomImage will randomly select an image from the dirname of the requested location.
You need to specify a white-space separated list of B with I,
otherwise the request will be declined.

=head1 FUNCTIONS

=head2 handler

Apache response handler

=cut
sub handler {
    my $r = shift;
    my $uri = $r->uri();
    $uri =~ s|[^/]+$||x;

    my $dir = $r->document_root() . $uri;

    my $dh = DirHandle->new($dir);
    if (not $dh) {
        $r->log_error("Cannot open directory $dir: $!");
        return NOT_FOUND;
    }

    my @suffixes = split('\s+',$r->dir_config("Suffixes"));
    return DECLINED unless scalar @suffixes;

    my @images;
    foreach my $file ( $dh->read() ) {
        next unless grep { $file =~ /\.$_$/xi } @suffixes;
        push (@images, $file);
    }

    return NOT_FOUND unless scalar @images;

    my $image = $images[rand @images];
    $r->internal_redirect_handler("$uri/$image");

    return OK;
}

=head1 Imported constants

=head2 OK

See Apache::Constants or Apache2::Const documentation

=head2 DECLINED

See Apache::Constants or Apache2::Const documentation

=head2 NOT_FOUND

See Apache::Constants or Apache2::Const documentation

=head1 SEE ALSO

=over 4

=item L

=item L

=back

=head1 AUTHOR

Michael Kroell, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to C, or through
the web interface at L.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.


=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Apache::RandomImage


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back


=head1 ACKNOWLEDGEMENTS

Apache::RandomImage was inspired by L

=head1 COPYRIGHT

Copyright 2003-2009 Michael Kroell, all rights reserved.

=head1 LICENSE

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.


=cut

1; # End of Apache::RandomImage