view release on metacpan or  search on metacpan

PhotoIndex.pm  view on Meta::CPAN

####################
#
# PhotoIndex.pm,v 1.20 2002/07/10 23:04:16 myneid Exp
#
# xTODO:
#	add writing of sizes of images to index file
#	add ability for user defined files to ignore
#	add ability to define thumbnail size
##################
package Apache::PhotoIndex;

use strict;
use Carp;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD);
use Apache::Constants qw(:common OPT_INDEXES DECLINE_CMD REDIRECT DIR_MAGIC_TYPE);
#use Image::Magick;
use Imager;
use Apache;
use CGI::Carp qw(fatalsToBrowser warningsToBrowser);
require Exporter;
require DynaLoader;
require AutoLoader;

@ISA = qw(Exporter DynaLoader);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
@EXPORT = qw(
	
);
$VERSION = '1.20';


sub AUTOLOAD {
    # This AUTOLOAD is used to 'autoload' constants from the constant()
    # XS function.  If a constant is not found then control is passed
    # to the AUTOLOAD in AutoLoader.

    my $constname;
    ($constname = $AUTOLOAD) =~ s/.*:://;
    croak "& not defined" if $constname eq 'constant';
    my $val = constant($constname, @_ ? $_[0] : 0);
    if ($! != 0) {
	if ($! =~ /Invalid/) {
	    $AutoLoader::AUTOLOAD = $AUTOLOAD;
	    goto &AutoLoader::AUTOLOAD;
	}
	else {
		croak "Your vendor has not defined Apache::PhotoIndex macro $constname";
	}
    }
    no strict 'refs';
    *$AUTOLOAD = sub () { $val };
    goto &$AUTOLOAD;
}

bootstrap Apache::PhotoIndex $VERSION;

# Preloaded methods go here.
sub handler($)
{
	my $r = shift;

	if($r->args eq 'edit_photos')
	{
		edit_photos($r);
	}
	elsif($r->args eq 'save_index')
	{
		save_index($r);
	}
	elsif($r->content_type and ($r->content_type eq DIR_MAGIC_TYPE or $r->uri =~ /index.html/))
	{
		directory_listing($r,0);
	}
	elsif($r->content_type and $r->content_type eq 'text/photo')

PhotoIndex.pm  view on Meta::CPAN

sub create_new_index_file($$$;\@)
{
	# creates the new index file for individual page browsing
	my ($r, $documentroot, $uri, @images) = @_;
	my @index = get_directory_index($r, $documentroot, $uri);
	if(!defined($images[0]))
	{
		#we need to get these images
		opendir(DIR, "$documentroot$uri");
		foreach ( sort readdir(DIR))
		{
			next if /^\./ || /htaccess/ ;
			my $subr = $r->lookup_file($documentroot . $uri .  $_);
			if($subr->content_type =~ /^image/)
			{
				push(@images, $_);
			}

		}
		closedir(DIR);

	}

	open(IDX, ">$documentroot$uri.index") || die $!;
	if($index[0])
	{
		print IDX "Title $index[0]\n";
	}
	my $i =1;
	foreach(@images)
	{
		my($name,$ext) = split(/\./,$_,2);
		#print IDX "$name.$ext\n";
		printf IDX "%s %s %s %s\n", $_, '-', '-', ($index[$i]->{description}) ? $index[$i]->{description} : '';

	}
	close IDX;

}


sub create_thumbnail($$)
{
	my($source_file, $dest_file) = @_;
	my $percent = 20;
	my  $image = Imager->new;
	$image->read(file=>$source_file) or die "readerror on \"$source_file\": ".$image->{ERRSTR}."\n";
	my %opts=(scalefactor=>$percent/100);
	my $thumb = $image->scale(%opts) or die "scaleerror on \"$source_file\": ".$image->{ERRSTR}."\n";
	$thumb->filter(type=>'autolevels');
	
	$thumb->write(file=>$dest_file) or die "writeerror on \"$source_file\": ".$image->{ERRSTR}."\n";

	undef $image;
}
sub create_thumbnail_imagemagick($$)
{
	my($source_file, $dest_file) = @_;
	my $percent = .20;
	my  $image = Image::Magick->new;
	$image->ReadImage($source_file);
	my ($width, $height) = $image->Get('base-columns', 'base-rows');
	my $newwidth = $width * $percent;
	my $newheight = $height * $percent;
	$image->Scale(width=>"$newwidth", height=>"$newheight");
	$image->Write($dest_file) ;
	undef $image;
}

sub individual_template($)
{
	my $r = shift;
	my $uri = $r->uri;
	my @temp = split(/\//,$uri);
	$uri = '';
	for(my $i=0; $i<$#temp; $i++)
	{
		$uri .= "/$temp[$i]";
	}
	$uri .= '/';
	my $return;

	if($r->dir_config('IndividualTemplate') && (-e $r->dir_config('IndividualTemplate')))
	{
		open(FILE, $r->dir_config('IndividualTemplate')) || die $r->dir_config('IndividualTemplate') . ": $!";
		while(<FILE>)
		{
			$return .= $_;
		}
		close FILE;	
	}
	elsif(-e $r->document_root . $uri . ".individualtemplate")
	{
		open(FILE, $r->document_root . $uri . '.individualtemplate') || die $r->document_root . $uri . ".individualtemplate: $!";
		while(<FILE>)
		{
			$return .= $_;
		}
		close FILE;	

	}
	else
	{
		$return = default_individual_template();
	}

	return $return;
}

sub index_template($)
{
	my $r = shift;
	my $return;
	if($r->dir_config('IndexTemplate') && -e $r->dir_config('IndexTemplate'))
	{
		open(FILE, $r->dir_config('IndexTemplate')) || die $r->dir_config('IndexTemplate') . ": $!";
		while(<FILE>)
		{
			$return .= $_;
		}