";
}
print "album.pl - ";
print $::S{1};
if ($::create_html_flag le 1)
{
print "";
}
if ($::create_html_flag le 1)
{
$::object=printHeader();
print <
HTML
}
print $::S{2};
print "\n\n";
if ($::create_html_flag le 1)
{
print "
";
}
print $::S{3};
print "\n\n";
if ($::create_html_flag le 1)
{
print "
";
}
print $::S{4};
print "\n\n";
if ($::create_html_flag le 1)
{
print "
";
}
print $::S{5};
print "\n\n";
if ($::create_html_flag le 1)
{
print "
";
}
print "$::album_dir...\n";
if ($::create_html_flag le 1)
{
print " ";
}
debug("Calling photoAlbum($::album_dir)",4,__LINE__);
photoAlbum($::album_dir);
debug("Back from photoAlbum($::album_dir) call",4,__LINE__);
debug("Calling recursiveScan($::album_dir)",4,__LINE__);
recursiveScan($::album_dir);
debug("Back from recursiveScan($::album_dir) call",4,__LINE__);
$::static_time_taken=time()-$::static_time;
if ($::create_html_flag le 1)
{
print "
";
}
print $::S{6};
print " $::static_photos_done ";
print $::S{7};
# Any movies?
if ($::static_movies_done)
{
print " ";
print $::S{8};
print " $::static_movies_done ";
print $::S{9};
}
# Add 1 to account for the root album
$::static_albums_done++;
print " ";
print $::S{10};
print " $::static_albums_done ";
print $::S{11};
print "\n";
# Count thumbnails
if ($::static_photos_thumb)
{
if ($::create_html_flag le 1)
{
print "
";
}
print "$::static_photos_thumb ";
print $::S{12};
print " ";
print $::S{15};
print "\n";
}
if ($::static_movies_thumb)
{
if ($::create_html_flag le 1)
{
print "
";
}
print "$::static_movies_thumb ";
print $::S{13};
print " ";
print $::S{15};
print "\n";
}
if ($::static_albums_thumb)
{
if ($::create_html_flag le 1)
{
print "
";
}
print "$::static_albums_thumb ";
print $::S{14};
print " ";
print $::S{15};
print "\n";
}
# Count descriptions
if ($::totalphotodesc)
{
if ($::create_html_flag le 1)
{
print "
";
}
print "$::totalphotodesc ";
print $::S{12};
print " ";
print $::S{205};
print "\n";
}
if ($::totalmoviedesc)
{
if ($::create_html_flag le 1)
{
print "
";
}
print "$::totalmoviedesc ";
print $::S{13};
print " ";
print $::S{205};
print "\n";
}
if ($::totalalbumdesc)
{
if ($::create_html_flag le 1)
{
print "
";
}
print "$::totalalbumdesc ";
print $::S{14};
print " ";
print $::S{205};
# Average
print "\n$::S{269} ".int($::static_photos_done/$::static_albums_done)." $::S{270}";
print "\n\n";
}
if ($::create_html_flag le 1)
{
print "
";
}
print $::S{265};
$::static_minutes=int($::static_time_taken/60);
$::static_hours=int($::static_minutes/60);
$::static_seconds=$::static_time_taken-($::static_minutes*60);
$::static_minutes=$::static_minutes-($::static_hours*60);
if ($::static_hours)
{
print " $::static_hours $::S{268}";
}
if ($::static_minutes)
{
print " $::static_minutes $::S{267}";
}
print " $::static_seconds $::S{266}\n";
}
else
{
# Authenticate user
$::authenticated=Authenticate();
if (!$::debug)
{
printHTMLHeader();
}
# Clear manual override
$::manual_override="";
# Are we creating an album?
if ($form->param('admincreate') && $form->param('album')!~/$::recent_upload_album$/)
{
printHTMLHeader();
# Actually create the album
if ($form->param('albumname'))
{
require $::admin_module;
if (createAlbum($form->param('album'),$form->param('albumname'),$form->param('title'),$form->param('description'),$::owner))
{
error(__LINE__,"upload_dir",$form->param('albumname'))
}
else
{
$::album=$::album_dir."/".$form->param('album')."/".$form->param('albumname');
$::function="";
}
}
else
# Just display the form
{
$::shortdesc=$::S{49};
require $::display_module;
display(buildTemplate());
exit(0);
}
}
# Are we doing random pics?
if ($::randompic)
{
require $::recent_module;
$::manual_override=randomizer();
# SSI Random Pic
if ($::ssi)
{
$::album=$::manual_override;
$::album=~s/(.*)\/.*/$1/;
require $::display_module;
display(showObject($::manual_override));
exit(0);
}
}
# Bypass login form for function=about
if ($::function eq "about")
{
$::authenticated=1;
}
# Do we have public albums?
if ($::public_albums && !$form->param('photo'))
{
$::authenticated=1;
}
# Show Login Screen if not already logged in
if ((($::album_password && !$::authenticated) && ($::password ne $::album_password)) || ($::protect_album && !$::authenticated))
{
debug("\$::function=$::login_code for one of the following reasons:",2,__LINE__);
debug("\ 1. \$::album_password required ($::album_password). (\$::password = $::password)",2,__LINE__);
debug("\ 2. \$::protect_album required ($::protect_album). (\$::authenticated = $::authenticated)",2,__LINE__);
debug("\ 3. Not logged in (\$::loggedin = $::loggedin)",2,__LINE__);
$::function=$::login_code;
# Manually reset the album to the root album, to avoid users passing in sub albums or photos
$::manual_override=$::album_dir;
}
photoAlbum($::manual_override);
}
######################## END OF MAIN ########################
################### START OF SUBROUTINES ####################
##############################################################
=head3 photoAlbum()
photoAlbum($manual_override);
$manual_override - Start in this album or with this photo (optional)
Does the majority of the processing for the photo album
=cut
sub photoAlbum
{
my $manual_override=shift;
$::keep_this="1";
debug("Entering subroutine: photoAlbum($manual_override)",4,__LINE__);
if ($manual_override)
{
debug("\$manual_override=$manual_override",2,__LINE__);
}
# Localize some vars
{
my $key;
my @keys;
# Read web environment variables
@keys=keys %ENV;
debug("---- BEGIN Web environment variables ----",3,__LINE__);
foreach $key (@keys)
{
debug("$key: $ENV{$key}",3,__LINE__);
}
debug("---- END Web environment variables ----",3,__LINE__);
}
# Check to see if we're being called with function=$::upload
if ($::function eq "$::upload")
{
require $::upload_module;
uploadPhoto();
exit(0);
}
# Check to see if the user is updating a description
if ($::function eq $::update_desc)
{
require $::ratings_module;
updateDesc($form->param('object'),$form->param('desc_file_loc'),$form->param('title'),$form->param('description'),$form->param('owner'),translateLevel($form->param('view_level')));
if (!$form->param('advance'))
{
$manual_override=$form->param('photo2');
}
}
# Check to see if the user is adding a rating
if ($::function eq $::rating_form)
{
my $temp=$form->param('rating_file_loc');
if(!$::loggedin && $::authentication_type)
{
require $::display_module;
display(javaAlert("Must be logged in to add ratings!"));
$::function="";
}
elsif (isGuest() && $::authentication_type)
{
require $::display_module;
display(javaAlert("Guests can not add ratings!"));
$::function="";
}
else
{
openDescfile("$::album_dir/$temp/");
getDescription($form->param('object'));
$::shortdesc="$::S{229} ".$::shortdesc;
require $::display_module;
display(buildTemplate());
exit(0);
}
}
# Check to see if the user is adding a rating
if ($::function eq "$::update_rating")
{
if ($form->param('comments'))
{
$::object="$::S{203} ";
if ($form->param('name'))
{
$::object.=$form->param('name');
}
else
{
$::object.="$::S{204}";
}
$::object.=": ".$form->param('comments');
}
require $::ratings_module;
updateRating($form->param('object'),$form->param('rating_file_loc'),$form->param('rating'),$::object);
}
# Have we been told to stop adding descriptions?
if ($form->param('stop_add_desc') eq "stop")
{
$::function="";
}
# Translate into shorter variable names
if ($form->param('album') && !$::album)
{
$::album=$::album_dir."/".$form->param('album');
debug("\$::album has been set to $::album (from the web form var)",2,__LINE__);
}
if ($form->param('photo'))
{
$::photo=$form->param('photo');
# Change all \'s to /'s
$::photo=~s/\\/\//g;
debug("\$::photo has been set to $::photo (from the web form var)",2,__LINE__);
# Is it a link? If so, just turn it into a direct link to the photo...
if (isAPhotoOrJp2($::photo) eq 2)
{
debug("\$::photo is a link...",4,__LINE__);
$::photo=getLinkURL("$::album_dir/$::photo");
debug("\$::photo has been set to $::photo (from the link url)",4,__LINE__);
}
}
if ($::album)
{
# Change all \'s to /'s
$::album=~s/\\/\//g;
}
# Are we checking for updates?
if ($::function eq $::checkupdate)
{
require $::admin_module;
checkUpdate();
}
# Override album (for creating static HTML)
if ($manual_override || $::create_html_flag)
{
debug("Manual Override is [$manual_override]",2,__LINE__);
if (isAPhotoOrJp2($manual_override))
{
$::photo=$manual_override;
debug("Setting photo to [$::photo]",2,__LINE__);
$::static_filename_to_use="$::full_directory.html";
$::album="";
}
else
{
if (isAMovie($manual_override))
{
$::album=$manual_override;
# Change all \'s to /'s
$::album=~s/\\/\//g;
$::album=~s/(.*)\/(.*)/$1/;
$::album="$::album_dir/$::album";
}
else
{
$::album=$manual_override;
}
debug("Setting album to [$::album]",2,__LINE__);
if ($::full_directory)
{
# For photo albums to be scanned
$::static_filename_to_use="$::full_directory/$::static_html_filename";
}
else
{
# For root photo album
$::static_filename_to_use="$::album_dir/$::static_html_filename";
}
$::photo="";
}
}
# Is this the top level?
if (!($::photo || $::album))
{
$::album="$::album_dir";
}
if ($::album)
{
$::middle=$::album;
}
if ($::photo)
{
$::middle=$::photo;
}
if ($::middle=~/^$::album_dir$/i)
{
$::middle="";
}
else
{
# Change all \'s to /'s
$::middle=~s/\\/\//g;
$::middle=~s/$::album_dir\/(.*)/$1/;
}
# Open static HTML file...
if ($::create_html_flag)
{
# Open the static HTML file
open(STATIC,">$::static_filename_to_use") || error(__LINE__,"not_writable","$::static_filename_to_use");
debug("Creating static HTML file at [$::static_filename_to_use]",2,__LINE__);
}
debug("The album is: $::album",2,__LINE__);
debug("The middle bit is: $::middle",2,__LINE__);
$::goback=$::middle;
# Change all \'s to /'s
$::goback=~s/\\/\//g;
# Drop the filename
$::goback=~s/(.*)\/.*/$1/;
if ($::goback eq $::middle)
{
$::goback="";
}
# Keep a copy, so you don't have all the funny web stuff when you do a compare
$::realgoback=$::goback;
debug("GoBack: $::goback",2,__LINE__);
if ($::photo)
{
$::descfile=$::album_dir."/";
if ($::goback)
{
$::descfile.=$::goback."/";
}
}
if ($::album)
{
#$::shortalbum=$::album_dir."/".$::album;
$::shortalbum=$::album;
if ($::realgoback)
{
$::shortalbum=~s/(.*\/).*/$1/;
}
else
{
$::shortalbum=$::album_dir;
}
$::shortalbum=$::shortalbum."/";
debug("ShortAlbum: $::shortalbum",2,__LINE__);
# If you're updating descriptions, this is the file you want.
$::desc_to_update="$::shortalbum";
openDescfile($::shortalbum);
if ($::album=~/^$::album_dir$/i)
{
$::shortalbum="$::rootalbumname";
}
else
{
if ($::realgoback)
{
$::shortalbum=$::middle;
$::shortalbum=~s/(.*)$::realgoback\//$1/;
}
else
{
$::shortalbum=$::middle;
}
}
debug("ShortAlbum: $::shortalbum",2,__LINE__);
$::shortobject=$::shortalbum;
getDescription($::shortalbum);
# Set album thumbnail
if ($form->param('setthumb'))
{
use File::Copy;
my $ext;
my $temp2;
my $temp;
$::shortalbum=$form->param('album');
$ext=$form->param('setthumb');
$temp="$::album_dir/$::shortalbum/$ext";
# Change all \'s to /'s
$::shortalbum=~s/\\/\//g;
# Pull out path
$::shortalbum=~s/.*\/(.*)/$1/;
$ext=~s/.*\.(.*)/$1/;
$temp2="$::album_dir/".$form->param('album')."/../$::thumbprefix$::shortalbum.$ext";
debug("Copying album thimbnail: $temp --> $temp2",2,__LINE__);
# Make sure source thumb is readable, and that we are authorized to do this
if (-r $temp && ($::function eq $::admin || (($::owner eq $::loggedin || $::default_admins=~/(.*,)*$::loggedin(,.*)*/) && $::loggedin)))
{
unlink($temp2);
copy($temp,$temp2);
}
}
# Keep count for static
if ($::founddesc)
{
$::totalalbumdesc++;
}
close(DESC);
# Set the description to pass as a default for editing
$::existing_shortdesc=$::shortdesc;
if (!$::shortdesc)
{
if ($::shortalbum eq $::rootalbumname)
{
$::shortdesc="$::S{87}";
}
else
{
$::shortdesc=$::shortalbum;
}
}
$::descfile="$::album_dir/$::middle/";
if (!isViewable("$::album_dir/$::goback",$::shortalbum,1))
{
$::keep_this="";
}
}
# Select directory to read all entries from
if ($::album)
{
$::dir_to_read="$::album_dir/$::goback";
}
# *** This is the spot that causes the bug.
if (!$::usebuttons)
{
my $temp=passVars(0);
if ($temp)
{
$::goback.="?".$temp;
}
}
if ($::photo)
{
$::dir_to_read="$::descfile";
$::shortphoto=$::photo;
$::shortphoto=~s/.*\/(.*)/$1/;
debug("\$::shortphoto = $::shortphoto",3,__LINE__);
if (!isViewable($::goback,$::shortphoto,3))
{
$::keep_this="";
}
}
# Are we deleting an object? If so, confirm.
if ($form->param('deleteobject'))
{
$::shortdesc=$::S{183};
$::longdesc="";
require $::display_module;
display(buildTemplate());
exit(0);
}
# Have we confirmed the delete?
if ($form->param('confirmdeleteobject') && $form->param('yes'))
{
require $::admin_module;
debug("Calling deleteObject(confirmdeleteobject)",3,__LINE__);
deleteObject($form->param('confirmdeleteobject'));
}
# Are we moving an object? If so, confirm.
if ($form->param('moveobject'))
{
require $::display_module;
display(buildTemplate());
exit(0);
}
# Have we confirmed the move?
if ($form->param('confirmmoveobject') && $form->param('yes'))
{
require $::admin_module;
debug("Calling moveObject(confirmmoveobject)",3,__LINE__);
moveObject($form->param('confirmmoveobject'),0,$form->param('category'),$form->param('newobjectname'));
}
# Are we linking an object? If so, confirm.
if ($::linkobject)
{
# ...unless you're using a default_linkdir setting...
if ($::default_linkdir)
{
require $::admin_module;
linkObject($::linkobject,0,$::default_linkdir);
$::linkobject="";
}
else
{
require $::display_module;
display(buildTemplate());
exit(0);
}
}
# Have we confirmed the link?
if ($form->param('confirmlinkobject') && $form->param('yes') && !$::default_linkdir)
{
require $::admin_module;
debug("Calling linkObject(confirmlinkobject)",3,__LINE__);
linkObject($form->param('confirmlinkobject'),0,$form->param('category'));
}
# Show Recent Uploads
if ($form->param('album')=~/$::recent_upload_album$/)
{
$::album=$::recent_upload_album;
require $::display_module;
display(buildTemplate());
exit(0);
}
# Show search screen, or the search results
if ($form->param('searchstart') || $::searchstring)
{
$::shortdesc=$::S{280};
$::longdesc="";
require $::display_module;
display(buildTemplate());
exit(0);
}
# Show Most Popular screen
if ($::popular_flag && $::most_popular)
{
$::shortdesc="$::most_popular $::S{271}";
$::longdesc="";
# Set the number to show by the number passed in via SSI
if ($::ssi)
{
$::most_popular=$::ssi;
}
require $::display_module;
display(buildTemplate());
exit(0);
}
# Find next and previous pictures/albums as appropriate
debug("Looking for next and previous objects in [$::dir_to_read]...",2,__LINE__);
@::file_list=readDirectory($::dir_to_read);
debug("Done Directory Scan, comparing for $::shortphoto or $::shortalbum...",3,__LINE__);
# clear re-used vars
$::prev_obj_desc="";
$::next_obj_desc="";
$::next_obj="";
# Prep the "jump station" for the footer
if ($::jump_to && $::middle && $::album && $::contains_dir)
{
# Add JS for auto submitting
$::jump_station.=<
function JumpNow()
{
document.JumpStation.submit();
}
\n";
}
# Cache descriptions, to be restored later
$::temp_shortdesc=$::shortdesc;
$::temp_longdesc=$::longdesc;
$::shortdesc=$::longdesc="";
# strip off last album, to get descriptions for the current album, next album and previous album
$::back_descfile=$::descfile;
$::back_descfile=~s/(.*\/).*\/.*/$1/;
if ($::album)
{
openDescfile($::back_descfile);
}
if ($::photo)
{
openDescfile($::descfile);
}
# Get description for the next object
if ($::next_obj)
{
getDescription($::next_obj);
if ($::founddesc)
{
$::next_obj_desc=$::shortdesc;
}
}
# Get description for the previous object
if ($::prev_obj)
{
getDescription($::prev_obj);
if ($::founddesc)
{
$::prev_obj_desc=$::shortdesc;
}
}
close(DESC);
# Restore original descriptions
$::shortdesc=$::temp_shortdesc;
$::longdesc=$::temp_longdesc;
debug("Next Object: $::next_obj [$::next_obj_desc]",3,__LINE__);
debug("Previous Object: $::prev_obj [$::prev_obj_desc]",3,__LINE__);
# clear array of photos, to save a lot of work later
@::file_list="";
if ($::album)
{
# Re-load the list of files from the current album directory
@::file_list=readDirectory($::album);
debug("Found objects in this album: @::file_list",3,__LINE__);
}
debug("Finished looking for next and previous objects...",2,__LINE__);
# If the current object is an album, you have to go up one more
if ($::album && ($::middle=~/\//))
{
$::back_descfile=~s/(.*\/).*\/.*/$1/;
}
# Get description of current object's album
openDescfile($::back_descfile);
$::temp_shortdesc=$::shortdesc;
$::temp_longdesc=$::longdesc;
$::shortdesc=$::longdesc="";
if (!$::realgoback)
{
$::object=$::rootalbumname;
}
else
{
$::object=$::realgoback;
if ($::object=~/\//)
{
$::object=~s/.*\/(.*)/$1/;
}
}
getDescription($::object);
$::back_desc=$::shortdesc;
$::shortdesc=$::temp_shortdesc;
$::longdesc=$::temp_longdesc;
debug("Desc for object's parent album is: $::back_desc",4,__LINE__);
close(DESC);
# clear re-used vars
$::prev_object="";
# Remove any web variables, if present
$::descfile=~s/(.*)\&.*/$1\//;
openDescfile($::descfile);
if ($::photo)
{
debug("ShortPhoto: $::shortphoto",2,__LINE__);
$::shortobject=$::shortphoto;
$::shortdesc="";
$::longdesc="";
getDescription($::shortphoto);
if (isAMovie($::shortphoto))
{
$::totalmoviedesc+=$::founddesc;
}
else
{
$::totalphotodesc+=$::founddesc;
}
# Set the description to pass as a default for editing
$::existing_shortdesc=$::shortdesc;
if (!$::shortdesc)
{
$::shortdesc=$::shortphoto;
}
# If you're updating descriptions, this is the file you want.
$::desc_to_update="$::descfile";
}
debug("ShortObject: $::shortobject",2,__LINE__);
# Make a "text" (not html) version of the long description
$::textlongdesc=$::longdesc;
$::textlongdesc=~s/ //g;
$::textlongdesc=~s/ //g;
$::textlongdesc=~s/[\n\r]//g;
# Build the "next photo" url
if ($::create_html_flag)
{
$::next_photo_link="$::next_obj.html";
}
else
{
$::next_photo_link="$::albumprog?photo=$::realgoback/$::next_obj";
}
$::next_photo_link.=passVars(0);
if (!$::keep_this)
{
$::shortdesc=$::S{337};
$::longdesc="";
}
# When a photo is displayed, it is in an HTML page, with a reference to the actual photo.
# The short description is the photo's title, and the long description is displayed below it.
# Description information is read out of $::descfile file, in the photo album.
# Save off descriptions
$::temp_shortdesc=$::shortdesc;
$::temp_longdesc=$::longdesc;
# Only build object if it's real.
if (($::photo && -e "$::album_dir/$::photo") || ($::album && -e "$::album"))
{
if ($::keep_this)
{
$::actual_object=buildObject();
}
else
{
$::actual_object=$::S{338};
}
}
else
{
$::actual_object=$::S{294};
}
# Restoredescriptions
$::shortdesc=$::temp_shortdesc;
$::longdesc=$::temp_longdesc;
$::template=buildTemplate();
# Translate funny web chars like spaces --> %20 (not if static though)
if (!$::create_html_flag)
{
$::template=parseLinks($::template);
}
debug("Object template is built! [$::template]",4,__LINE__);
# Remove comments
if ($::strip_comments)
{
$::template=~s/\n* It's a match!",3,__LINE__);
$storedpass=$edit_array[1];
$::displayname=$edit_array[3]." ".$edit_array[4];
$::loggedin=$edit_array[0];
$::mem_level=$edit_array[5];
if ($::mem_level eq "Guest")
{
$::mem_level=0;
}
elsif ($::mem_level eq "Family")
{
$::mem_level=1;
}
elsif ($::mem_level eq "Friend")
{
$::mem_level=2;
}
debug("--> member level is $::mem_level",3,__LINE__);
}
else
{
debug("--> Does not match.",3,__LINE__);
}
}
$lines = "";
@edit_array = @database_array = "";
}
# Flatfile authentication
if ($::authentication_type eq 1)
{
debug("Using Flatfile Authentication (type $::authentication_type)",2,__LINE__);
# Open the text database
open(AUTH_DB,$::auth_db) || error(__LINE__,"open_db","$::auth_db");
# First check if user exists
while ()
{
chomp;
($data,$storedpass)=split('\|',$_);
chomp($data);
$data=~s/[\n\r]//g;
$storedpass=~s/[\n\r]//g;
chomp($storedpass);
if ($::username eq $data)
{
last;
}
}
close(AUTH_DB);
if ($::username eq $data)
{
$::displayname=$::username;
# Set "logged in" user
$::loggedin=$::username;
$::mem_level=2;
}
else
{
$storedpass="";
}
}
# Check for encrypted/hashed passwords stored in cookies
$storedpass=checkPassword($::password,$storedpass);
# Check for encrypted/hashed passwords stored on server
$::password=checkPassword($storedpass,$::password);
# If display name is not already set, then just use the username
if (!$::displayname)
{
$::displayname=$::username;
}
chomp($::displayname);
chomp($storedpass);
# Anonymous, and no other controls are set
if (!$::authentication_type && !$::protect_album && !$::album_password)
{
debug("Using Anonymous Authentication (type $::authentication_type)",2,__LINE__);
$storedpass=$::password;
$::displayname=$::username;
$auth=1;
}
# Anonymous, with a password
if (!$::authentication_type && $::album_password)
{
$storedpass=$::album_password;
}
# Check the password
if ($::password eq $storedpass && $::password)
{
$auth=1;
}
else
{
# If not authenticated, blow away the username. Not doing this opens up a huge hole - users can get into the admin menu knowing only the username of the admins!
$::loggedin="";
}
debug("Username: $::username",3,__LINE__);
debug("Entered Password: $::password",3,__LINE__);
debug("Stored Password: $storedpass",3,__LINE__);
if ($::authentication_type eq 2)
{
debug("Member #: $::usernumber",3,__LINE__);
}
debug("Authenticated: $auth",3,__LINE__);
# Reset cookie login to show if login was successful or not
if ($::cookielogin)
{
$::cookielogin=$auth;
}
debug("Username: $::username : Password: $::password : Cookielogin: $::cookielogin : Auth: $auth : Header: $::header_printed",3,__LINE__);
# print "Username: $::username : Password: $::password : Cookielogin: $::cookielogin : Auth: $auth : Header: $::header_printed";
# Set album cookie
# if (($::username && $::password) && !$::cookielogin && $auth && !$::header_printed)
if (($::username && $::password) && !$::cookielogin && $auth)
{
use CGI qw(:standard);
eval("use CGI::Cookie;");
if ($@!~/^Can't locate/)
{
my $cookie1;
my $cookie2;
debug("\$auth=$auth",3,__LINE__);
debug("\$::cookielogin=$::cookielogin",3,__LINE__);
debug("Setting cookie ($::username/$::password)",3,__LINE__);
if ($::authentication_type eq 5)
{
if ($function eq $::update_desc || $function eq $::update_rating || ($form->param('confirmdeleteobject') && $form->param('yes')) || ($form->param('confirmmoveobject') && $form->param('yes')) || ($form->param('confirmlinkobject') && $form->param('yes') && !$::default_linkdir))
{
}
else
{
$pwseed='amlite';
$::password=crypt($::password,$pwseed);
}
}
debug("Remember logins via cookie:".$form->param('login_memory'),3,__LINE__);
if($form->param('login_memory') eq "yes")
{
# Set cookies with a 5 year expiry
debug("Setting cookie ($::username/$::password/five year)",3,__LINE__);
eval("\$cookie1=new CGI::Cookie(-name=>\$::albumcookieusername,-value=>\$::username,-expires=>'+5y');");
eval("\$cookie2=new CGI::Cookie(-name=>\$::albumcookiepassword,-value=>\$::password,-expires=>'+5y');");
}
else
{
# Set cookies to expire at session close
debug("Setting cookie ($::username/$::password/session)",3,__LINE__);
eval("\$cookie1=new CGI::Cookie(-name=>\$::albumcookieusername,-value=>\$::username);");
eval("\$cookie2=new CGI::Cookie(-name=>\$::albumcookiepassword,-value=>\$::password);");
}
eval("print header(-cookie=>[\$cookie1,\$cookie2]);");
# Now we have logged in via a cookie
$::cookielogin=1;
# Don't print the HTML header - we just did that
$::header_printed=1;
}
}
debug("Did authentication come from a cookie? (\$::cookielogin): $::cookielogin",3,__LINE__);
debug("Leaving subroutine: Authenticate",4,__LINE__);
return($auth);
}
##########################################################################
=head3 checkPassword()
$goodpass=checkPassword($mypassword,$storedpass);
$goodpass - The password that matched, if found. (Otherwise, the stored password ($storedpass) is returned).
$mypassword - The password that the user has entered.
$storedpass - The password on file for that user.
Checks $mypassword against $storedpass using all known encryption methods, and returns a copy of the "good" (clear) password, if found
=cut
sub checkPassword
{
my $mypassword=shift;
my $storedpass=shift;
my $passcheck;
my $pwseed;
debug("Entering subroutine: checkPassword($mypassword,$storedpass);",4,__LINE__);
# Check to ensure we have stuff to check
if (!$mypassword || !$storedpass)
{
return($storedpass);
}
# Check plaintext
if ($mypassword eq $storedpass)
{
return($mypassword);
}
# YaBB Security Mod
# Code added from clubSTi.com (Gerlando)
$pwseed ||= 'ya';
$passcheck=crypt($mypassword,$pwseed);
debug("Trying YaBB Security Mod encryption: $passcheck",3,__LINE__);
if ($passcheck eq $storedpass)
{
debug("--> It's a match!",3,__LINE__);
return($passcheck);
}
else
{
debug("--> Does not match.",3,__LINE__);
}
# Crypt
$pwseed=$mypassword;
$pwseed=~s/(..).*/$1/;
$passcheck=crypt($storedpass,$pwseed);
debug("Trying crypt() encrypted password: $passcheck",3,__LINE__);
if ($passcheck eq $mypassword)
{
debug("--> It's a match!",3,__LINE__);
return($passcheck);
}
else
{
debug("--> Does not match.",3,__LINE__);
}
$truncmypassword=substr($mypassword,0,13);
debug("Trying truncated crypt() encrypted password: $truncmypassword ($passcheck)",3,__LINE__);
if ($truncmypassword eq $passcheck)
{
debug("--> It's a match!",3,__LINE__);
return($mypassword);
}
else
{
debug("--> Does not match.",3,__LINE__);
}
#### If you're having MD5 "include" problems, delete everything from this line to the line like it below. ####
if (!$::skip_md5)
{
# Check for MD5 package, include if present
my $pkg="Digest";
my $method="MD5";
eval("use ".$pkg."::".$method."()");
# eval("use ".$pkg.";\n".$pkg."::".$method."()");
if ($@!~/^Can't locate/)
{
# MD5 (Hex)
eval("use ".$pkg."::".$method." qw(md5_hex);");
# If not, throw a warning
if ($@)
{
$::warning.="Could not import $pkg::$method (md5_hex) ($@). Continuing anyway... ";
}
eval { $passcheck=md5_hex($storedpass); };
debug("Trying md5_hex hashed cookie password: $passcheck",3,__LINE__);
if ($passcheck eq $mypassword)
{
debug("--> It's a match!",3,__LINE__);
return($passcheck);
}
else
{
debug("--> Does not match.",3,__LINE__);
}
# Use the UBB.Threads way: hash username and password
eval { $passcheck=md5_hex($::username.$storedpass); };
debug("Trying md5_hex hashed cookie of username ($::username) and password: $passcheck",3,__LINE__);
if ($passcheck eq $mypassword)
{
debug("--> It's a match!",3,__LINE__);
return($passcheck);
}
else
{
debug("--> Does not match.",3,__LINE__);
}
# MD5 (Base 64)
# Check to see if we can load the package
eval("use ".$pkg."::".$method." qw(md5_base64);");
# If not, throw a warning
if ($@)
{
$::warning.="Could not import md5_base64 ($@). Continuing anyway... ";
}
eval { $passcheck=md5_base64($storedpass); };
debug("--> Trying $pkg::$method (md5_base64) hashed cookie password: $passcheck.",3,__LINE__);
if ($passcheck eq $mypassword)
{
debug("--> It's a match!",3,__LINE__);
return($passcheck);
}
else
{
debug("--> Does not match.",3,__LINE__);
}
# Plain MD5
# Check to see if we can load the package
eval("use ".$pkg."::".$method." qw(md5);");
# If not, throw a warning
if ($@)
{
$::warning.="Could not import $pkg::$method (md5) ($@). Continuing anyway... ";
}
eval { $passcheck=md5($storedpass); };
debug("--> Trying plain md5 hashed cookie password: $passcheck.",3,__LINE__);
if ($passcheck eq $mypassword)
{
debug("--> It's a match!",3,__LINE__);
return($passcheck);
}
else
{
debug("--> Does not match.",3,__LINE__);
}
}
else
{
debug("Could not import $pkg::$method: ($@)",3,__LINE__);
}
}
#### If you're having MD5 "include" problems, delete everything from this line to the line like it above. ####
#### If you're having HMAC_MD5 "include" problems, delete everything from this line to the line like it below. ####
if (!$::skip_hmac)
{
# Check for HMAC package, include if present
my $pkg="Digest";
my $method="HMAC_MD5";
eval("use ".$pkg."::".$method."()");
# eval("use ".$pkg.";\n".$pkg."::".$method."()");
if ($@!~/^Can't locate/)
{
# YaBB SE "double" MD5 HMAC
# Check to see if we can load the package
eval("use ".$pkg."::".$method." qw(hmac_md5_hex);");
# If not, throw a warning
if ($@)
{
$::warning.="Could not import $pkg::$method (hmac_md5_hex) ($@). Continuing anyway... ";
}
eval { $passcheck=hmac_md5_hex($storedpass,$::username); };
debug("--> Trying hmac_md5_hex hashed cookie password: $passcheck (key: $storedpass - $::username).",3,__LINE__);
if ($passcheck eq $mypassword)
{
debug("--> It's a match!",3,__LINE__);
return($passcheck);
}
else
{
debug("--> Does not match.",3,__LINE__);
}
# SMF 1.0 Authentication
eval { $passcheck=hmac_md5_hex($storedpass,"ys"); };
debug("--> Trying hmac_md5_hex hashed cookie password for SMF 1.0: $passcheck (key: $storedpass - \"ys\").",3,__LINE__);
if ($passcheck eq $mypassword)
{
debug("--> It's a match!",3,__LINE__);
return($passcheck);
}
else
{
debug("--> Does not match.",3,__LINE__);
}
}
else
{
debug("Could not import $pkg::$method: ($@)",3,__LINE__);
}
}
#### If you're having HMAC_MD5 "include" problems, delete everything from this line to the line like it above. ####
if (!$::skip_sha1)
{
# Check for SHA1 package, include if present
my $pkg="Digest";
my $method="SHA1";
eval("use ".$pkg."::".$method."()");
# eval("use ".$pkg.";\n".$pkg."::".$method."()");
if ($@!~/^Can't locate/)
{
# Check to see if we can load the package
eval("use ".$pkg."::".$method." qw(sha1_hex);");
# If not, throw a warning
if ($@)
{
$::warning.="Could not import $pkg::$method (sha1_hex) ($@). Continuing anyway... ";
}
# SMF 1.1+ Authentication
eval { $passcheck=sha1_hex($storedpass.$::passwordSalt); };
debug("--> Trying sha1 hashed cookie password for SMF 1.1+: $passcheck (using: $storedpass.$::passwordSalt).",3,__LINE__);
if ($passcheck eq $mypassword)
{
debug("--> It's a match!",3,__LINE__);
return($passcheck);
}
else
{
debug("--> Does not match.",3,__LINE__);
}
}
else
{
debug("Could not import $pkg::$method: ($@)",3,__LINE__);
}
}
debug("Leaving subroutine: checkPassword($mypassword,$storedpass);",4,__LINE__);
return($storedpass);
}
##########################################################################
=head3 loginStatus()
$login_html=loginStatus();
$login_html = The user's login status, as HTML.
Returns the user's login status as either a URL to the login page (if the user is not logged in) or as as "Welcome [username]" message (if the user is logged in).
=cut
sub loginStatus
{
my @chips;
my $singlechip;
my $data;
my $lastchip;
my $albumref;
if ($::authentication_type)
{
if ($::authenticated)
{
if ($::displayname)
{
$data=" $::S{178} $::displayname";
}
else
{
$data=" $::S{178} $::username";
}
if (($::authentication_type eq 1) || ($::authentication_type eq 5))
{
if ($::textmenu)
{
$data.=" $S{98} ";
}
$data.=" ";
if ($::textmenu)
{
$data.=$::S{305};
}
else
{
$data.="";
}
$data.="";
if ($::textmenu)
{
$data.=" $S{98} ";
}
}
}
else
{
if ($::shortalbum eq $::rootalbumname)
{
$albumref="";
}
else
{
$albumref=";album=".$::goback."/".$::shortalbum;
}
$data="";
if ($::textmenu)
{
$data.=" $::S{237}";
}
else
{
$data.="";
}
$data.="";
if ($::textmenu)
{
$data.=" $S{98} ";
}
}
}
else
{
$data="$::S{178}$::S{295}";
}
return($data);
}
##########################################################################
=head3 cookieLogin()
$status=cookieLogin();
$status - 1 if login info was found, otherwise 0
Retrieves login information from the cookie (if found) and passes it back as $::username, $::password, $::usernumber (UBB) and $::displayname.
=cut
sub cookieLogin
{
my $chip;
my @chips;
my $singlechip;
my $chipcount;
my $lastchip;
my $mypassword;
my $myusername;
my $retcode=0;
# Change these if you've customized your YaBB cookie names...
my $YaBBusername="YaBBusername";
my $YaBBpassword="YaBBpassword";
# SMF default cookie name
my $SMFCookie="SMFCookie";
# Iconboard default cookie names
my $iBMemberID="iBMemberID";
my $iBPassWord="iBPassWord";
debug("Entering subroutine: cookieLogin",4,__LINE__);
# Check to see if the user has a cookie, and log them in with that.
foreach $chip (%::cookie)
{
# Handle special case for eblah setting $username in the cookie value
if ($lastchip=~/eblah_Logout/i && $::cookie{$lastchip}=~/username/i)
{
next;
}
# Check YaBB logins (username)
if ($lastchip=~/^$YaBBusername.*/ && !$myusername && $::authentication_type eq 3)
{
debug("Found YaBB username info: $lastchip",3,__LINE__);
$myusername=$chip;
debug("\$myusername set to $myusername",3,__LINE__);
}
# Check YaBB logins (password)
if ($lastchip=~/^$YaBBpassword.*/ && !$mypassword && $::authentication_type eq 3)
{
debug("Found YaBB password info: $lastchip",3,__LINE__);
$mypassword=$chip;
debug("\$mypassword set to $mypassword",3,__LINE__);
}
# Check phpbb logins
if ($chip=~/^(phpbb2mysql_data|phpbb_data)/i && !$mypassword && !$myusername) # && $::authentication_type eq 4)
{
my $junk;
my $chipdata=$::cookie{$chip};
debug("Found phpbb password info: $chip --> $chipdata",3,__LINE__);
# Crappy way to "unserialize" the cookie data
($junk,$junk,$junk,$mypassword)=split("\"",$chipdata);
my @temparray=split("\"",$chipdata);
$myusername=pop(@temparray);
if ($myusername!~/\d/)
{
$myusername=pop(@temparray);
}
debug("\$myusername starting as $myusername",3,__LINE__);
$myusername=~tr/0-9/ /c;
$myusername=~s/\s+//g;
debug("\$myusername set to $myusername",3,__LINE__);
debug("\$mypassword set to $mypassword",3,__LINE__);
}
# Check SMF logins
if ($chip=~/^$SMFCookie/i && $::authentication_type eq 4)
{
my $junk;
my $chipdata=$::cookie{$chip};
debug("Found SMF password info: $chip --> $chipdata",3,__LINE__);
# Crappy way to "unserialize" the cookie data
($junk,$::usernumber,$junk,$mypassword)=split("\"",$chipdata);
# Now user the userID to look up the username
# Check for DBI package, include if present
$dbi_fail=DBICheck();
if (!$dbi_fail)
{
my $user_sql;
my $dbh;
my $sth;
my $rv;
my @row;
my $maybedisplayname;
debug("Using database Authentication (type $::authentication_type)",2,__LINE__);
# Set "logged in" user
$::loggedin=$::username;
# Connect to database
$dbh=DBI->connect("DBI:$::db_driver:$::db_name:$::db_hostname:$::db_port",$::db_user,$::db_password) || die $DBI::errstr;
# Build SQL command
$user_sql="SELECT `$::db_username`,`$::db_displaynamefield` FROM `$::db_membertable` WHERE `ID_MEMBER` = $::usernumber";
debug("SQL query: $user_sql",2,__LINE__);
if ($dbh)
{
# Check SQL command
$sth=$dbh->prepare($user_sql);
# Check for errors
if (!$sth)
{
$::warning.="$::S{293}$::S{221} ";
$::warning.=$sth->errstr." ";
}
# Run SQL command
$rv=$sth->execute;
debug("Query returned $rv rows.",2,__LINE__);
# Check for errors
if (!$rv)
{
$::warning.="$::S{293}$::S{221} ";
$::warning.=$sth->errstr." ";
}
# Fetch Rows
while(@row=$sth->fetchrow_array)
{
$myusername=$row[0];
debug("\$row[0]=$myusername",2,__LINE__);
$maybedisplayname=$row[1];
debug("\$row[1]=$maybedisplayname",2,__LINE__);
if ($maybedisplayname)
{
$::displayname=$maybedisplayname;
}
}
# Finish and disconnect from database
$sth->finish();
$dbh->disconnect;
}
}
debug("\$myusername set to $myusername",3,__LINE__);
debug("\$mypassword set to $mypassword",3,__LINE__);
debug("\$::displayname set to $::displayname",3,__LINE__);
debug("\$::usernumber set to $::usernumber",3,__LINE__);
}
# Found Ikonboard username
if ($lastchip=~/.*$iBMemberID.*/ && !$myusername && $::authentication_type eq 4)
{
debug("Found YaBB username info: $lastchip",3,__LINE__);
$myusername=$chip;
debug("\$myusername set to $myusername",3,__LINE__);
}
# Found Ikonboard passwords
if ($lastchip=~/.*$iBPassWord.*/ && !$mypassword && $::authentication_type eq 4)
{
debug("Found Ikonboard password info: $lastchip",3,__LINE__);
$mypassword=$chip;
debug("\$mypassword set to $mypassword",3,__LINE__);
}
# Found YaBB 2 username
if ($lastchip=~/^Y2User/ && !$myusername && $::authentication_type eq 3)
{
debug("Found YaBB 2 username: $lastchip",3,__LINE__);
$myusername=$chip;
debug("\$myusername set to $myusername",3,__LINE__);
}
# Found YaBB 2 password
if ($lastchip=~/^Y2Pass/ && !$mypassword && $::authentication_type eq 3)
{
debug("Found YaBB 2 password info: $lastchip",3,__LINE__);
$mypassword=$chip;
debug("\$mypassword set to $mypassword",3,__LINE__);
# Convert spaces to + in password
$mypassword=~s/ /+/g;
}
# Found e-Blah username
if ($lastchip=~/^eblah_un$/ && !$myusername && $::authentication_type eq 3)
{
debug("Found e-Blah username: $lastchip",3,__LINE__);
$myusername=$chip;
debug("\$myusername set to $myusername",3,__LINE__);
}
# Found e-Blah password
if ($lastchip=~/^eblah_pw$/ && !$mypassword && $::authentication_type eq 3)
{
debug("Found e-Blah password info: $lastchip",3,__LINE__);
$mypassword=$chip;
debug("\$mypassword set to $mypassword",3,__LINE__);
}
# UBB.Threads Username (or USERID)
if ($lastchip=~/^ubbt_myid$/ && !$myusername && $::authentication_type eq 4)
{
debug("Found UBB.Threads username: $lastchip",3,__LINE__);
$myusername=$chip;
debug("\$myusername set to $myusername",3,__LINE__);
}
# UBB.Threads Password
if ($lastchip=~/^ubbt_key$/ && !$mypassword && $::authentication_type eq 4)
{
debug("Found UBB.Threads password: $lastchip",3,__LINE__);
$mypassword=$chip;
debug("\$mypassword set to $mypassword",3,__LINE__);
}
# Handle arrays
if ($chip=~/&/)
{
@chips=splitCookie($chip);
$chipcount=0;
foreach $singlechip (@chips)
{
debug("Processing \$singlechip [$singlechip], part of [$lastchip]",4,__LINE__);
$chipcount++;
# Check UBB logins
if ($lastchip=~/^ubb.*/ && $::authentication_type eq 2)
{
debug("Found UBB login info: $lastchip",3,__LINE__);
# Username first
if ($chipcount eq 1 && !$myusername)
{
$myusername=$singlechip;
debug("\$myusername set to $myusername",3,__LINE__);
}
# Password second
if ($chipcount eq 2 && !$mypassword)
{
$mypassword=$singlechip;
debug("\$mypassword set to $mypassword",3,__LINE__);
}
# display name third
if ($chipcount eq 3)
{
$::displayname=$singlechip;
debug("\$::displayname set to $::displayname",3,__LINE__);
}
# Member number fourth
if ($chipcount eq 5)
{
$::usernumber=$singlechip;
debug("\$::usernumber set to $::usernumber",3,__LINE__);
}
}
}
}
# Check for a general password
if ($lastchip=~/pass/i)
{
debug("Found generic password info: $chip",3,__LINE__);
$mypassword=$chip;
debug("\$mypassword set to $mypassword",3,__LINE__);
# Convert spaces to + in password
$mypassword=~s/ /+/g
}
# Check for a general userid
if (($lastchip=~/userid/i || $lastchip=~/name/i) && ($lastchip!~/ogout/i && $chip!~/ogout/i))
{
debug("Found generic userid info: $chip ($lastchip)",3,__LINE__);
$myusername=$chip;
debug("\$myusername set to $myusername",3,__LINE__);
}
# Native album.pl cookie login info
if ($lastchip=~/^$::albumcookieusername.*/)
{
debug("Found Native album.pl username info: $lastchip",3,__LINE__);
$myusername=$chip;
debug("\$myusername set to $myusername",3,__LINE__);
}
# Native album.pl cookie login info
if ($lastchip=~/^$::albumcookiepassword.*/)
{
debug("Found Native album.pl password info: $lastchip",3,__LINE__);
$mypassword=$chip;
debug("\$mypassword set to $mypassword",3,__LINE__);
}
if ($::cookie{$chip})
{
debug("[$chip] = [$::cookie{$chip}] (u:$myusername-p:$mypassword)",3,__LINE__);
}
$lastchip=$chip;
}
# Discard "deleted" cookies
if ($myusername=~/^deleted/ && $mypassword=~/^deleted/)
{
$myusername=$mypassword="";
}
# Return status flag (was login info found...)
if ($myusername && $mypassword)
{
$::username=$myusername;
$::password=$mypassword;
debug("Found username: $::username and password: $::password in cookie. (Maybe #:$::usernumber and name: $::displayname too...)",2,__LINE__);
$retcode=1;
}
else
{
debug("No login information found in cookies.",2,__LINE__);
$retcode=0;
}
debug("Leaving subroutine: cookieLogin --> return code is $retcode",4,__LINE__);
return($retcode);
}
##########################################################################
=head3 openDescfile()
openDescfile($descfilename);
$descfilename - The full, filesystem path to the album you want to read descriptions from.
Opens up $descfilename so that photo/album titles/descriptions can be loaded.
=cut
sub openDescfile
{
my $descfilename=shift;
# Close any open filehandles here
close(DESC);
$descfilename.=$::descname;
debug("Looking for DescFile: [$descfilename]",3,__LINE__);
if (-r $descfilename)
{
$::usedesc=1;
open(DESC,"$descfilename");
debug("Using DescFile: [$descfilename]",3,__LINE__);
}
}
##########################################################################
=head3 getDescription()
getDescription($desctoget,$mode);
$desctoget - Photo or album to get description of
$mode - 0 = Normal; 1 = Searching
Retrieves the title, description and owner of the provided object. Puts the title in $::shortdesc, the description in $::longdesc (if present) and the owner in $::owner (if present) and the view permission level in $::this_level (if present).
=cut
sub getDescription
{
my $desctoget=shift;
my $mode=shift;
my $descline;
my $prevline;
my $filename;
my $tempowner;
my $temp_level;
my $temp_file;
my $desctosearch;
debug("Entering subroutine: getDescription($desctoget,$mode)",4,__LINE__);
debug("Getting Description for [$desctoget] --> \$::usedesc=[$::usedesc]",3,__LINE__);
# Clear variables, in case they're being re-used
$::shortdesc=$::longdesc=$::owner=$::this_level="";
# Haven't found a description yet.
$::founddesc=0;
# See if description exists
if ($::usedesc && $desctoget)
{
# Clear $desctoget if it was just set as a placeholder
if ($desctoget eq "./")
{
$desctoget="";
}
$desctosearch=quotemeta($desctoget);
# Rewind description file
seek(DESC,0,0);
# Reset for search
$prevline=$::desc_delim;
while ($descline=)
{
chomp($descline);
$descline=~s/[\n\r]//g;
chomp($descline);
# Block codes
$descline=~s/####/#\/###/sg;
# Doing search
if ($mode && ($::searchdescriptions || $::searchowners))
{
if ($::searchdescriptions)
{
if ($descline=~/$::searchstring/i && $prevline!~/^$::desc_delim$/)
{
debug("Found a MATCH (description) of $::searchstring in $descline for object $desctoget$filename",4,__LINE__);
if(isViewable($desctoget,$filename,"2"))
{
push @::searchresults,"$desctoget$filename";
}
}
}
# Store off filenames and check owners
if ($prevline=~/^$::desc_delim$/)
{
($filename,$tempowner,$temp_level)=split(":",$descline);
if ($tempowner=~/$::searchstring/ && $::searchowners)
{
debug("Found a MATCH (owner) of $::searchstring in $descline for object $desctoget$filename",4,__LINE__);
if(isViewable($desctoget,$filename,"2"))
{
push @::searchresults,"$desctoget$filename";
}
}
}
$prevline=$descline;
}
# Found the description we're looking for (not via the search screen)
if ($descline=~/^$desctosearch$/i || $descline=~/^$desctosearch:.*$/i)
{
# $::owner=$descline;
# $::owner=~s/.*:(.*)/$1/;
# debug("$descline:$::owner",2,__LINE__);
# if ($::owner eq $descline)
# {
# $::owner="";
# }
# Why was this here? I commented it out, because it was breaking ownership! (Mike: 01 Jul 04)
#$descline=~s/(.*):.*/$1/;
# Pull out owner and view level
($temp_file,$::owner,$::this_level)=split(":",$descline);
# if($::owner && !$::this_level)
# {
# $::this_level=$::owner;
# $::owner="";
# }
debug("$::owner owns $descline",2,__LINE__);
debug("object level is $::this_level",2,__LINE__);
$::shortdesc=;
chomp($::shortdesc);
$::longdesc="";
my $longdescline="";
while (($::longdescline=) && ($::longdescline!~/^$::desc_delim\w*/))
{
$::longdesc.=$::longdescline." \n";
}
$::founddesc=1;
}
}
if (!$::founddesc)
{
$::shortdesc=$::longdesc="";
debug("No description found.",3,__LINE__);
}
debug("ShortDesc: [$::shortdesc]",3,__LINE__);
debug("LongDesc: [$::longdesc]",3,__LINE__);
}
debug("Leaving subroutine: getDescription($desctoget,$mode)",4,__LINE__);
}
##########################################################################
=head3 buildDescFooter()
$add_desc_footer=buildDescFooter($status);
$add_desc_footer - The HTML code for adding a description, which is returned.
$status - 0 if building the whole form, 1 if building it as part of another form (like the create album form, for example).
Creates $directory in $basedir, and updates the description with $::shortdesc and $::longdesc.
=cut
sub buildDescFooter
{
my $add_desc_footer;
my $status=shift;
# Form for entering a new description
if (!$status)
{
$add_desc_footer=<
HTML
}
$add_desc_footer.="$::S{190} \n";
if (!$status)
{
# Where do we go when we click submit?
$add_desc_footer.="\n";
# Where do we go when we click submit?
if (isAPhotoOrJp2($::next_obj))
{
$add_desc_footer.="\n";
}
$add_desc_footer.="\n";
$add_desc_footer.="\n";
}
if (!$status)
{
# Set the correct function
$::function=$::update_desc;
$add_desc_footer.=passVars(1);
# Now set it back
$::function=$::enter_desc;
}
$add_desc_footer.="
\n";
# If the next object is a photo, display the option to go to it.
if (isAPhotoOrJp2($::next_obj))
{
$add_desc_footer.=" \n";
}
$add_desc_footer.="\n";
$add_desc_footer.=<
HTML
}
return($add_desc_footer);
}
##########################################################################
=head3 getPhotoDimensions()
($height,$width)=getPhotoDimensions($filepath);
$height - Height of photo.
$width - Width of photo.
$filepath - Full filesystem path to the photo to check.
Uses Imagemagick to determine the size of a photo.
=cut
sub getPhotoDimensions
{
use strict;
my $system_call;
my $flag;
my $height;
my $width;
my $data;
my $filepath=shift;
debug("Entering subroutine: getPhotoDimensions($filepath);",4,__LINE__);
# Imagemagick is not installed
if (!$::imagemagick)
{
debug("ImageMagick is not installed",4,__LINE__);
$width=-1;
$height=-1;
return($height,$width);
}
# File is not an image
if (isAPhotoOrJp2($filepath) ne 1)
{
debug("$filepath is not a photo or jp2",4,__LINE__);
return();
}
# Check the size of the pic
$system_call="\"$::imagemagick/identify\" \"$filepath\"";
debug("IMAGEMAGICK: $system_call",3,__LINE__);
open(IMAGEMAGICK,"$system_call|") || error(__LINE__,"cant_fork","$system_call: $!");
$flag=1;
while (($data=) && $flag)
{
debug("IMAGEMAGICK: $data",4,__LINE__);
if ($data=~/\s*$filepath\s+(.*)/)
{
$data=$1;
$data=~s/^(\w+) *(\d+x\d+).*/$2/;
$height=$width=$data;
$width=~s/(\d+)x(\d+)/$1/;
$height=~s/(\d+)x(\d+)/$2/;
$flag=0;
}
}
close(IMAGEMAGICK);
debug("$filepath size is as follows: $width wide by $height high.",2,__LINE__);
debug("Leaving subroutine: getPhotoDimensions($filepath);",4,__LINE__);
return($height,$width);
}
##########################################################################
=head3 showFooter()
$footer=showFooter($show);
$footer - HTML footer, if returned.
$show - If set to 0, the footer simply returned, if set to 1, it is displayed and returned.
Rerturns or displays the HTML footer for all pages.
=cut
sub showFooter
{
my @allinfo;
my $revdate;
my $show=shift;
if ($::create_html_flag)
{
$revdate=setDate();
$revdate="$::S{80} $revdate";
}
else
{
@allinfo=stat($0);
$revdate=localtime($allinfo[9]);
}
my $footer="
\n$::S{95} V$::ver
HTML
# Check to see if the version is correct
if (($::cfgver ne $::ver) && (($form->param('function') ne "$::config") && ($form->param('function') ne "$::updateconfig")))
{
$::warning.="$::S{81} $::cfgver $::S{82} $::ver $::S{83} ";
}
if ($::warning)
{
$footer.="
$::warning
\n";
}
if ($show)
{
require $::display_module;
display($footer);
}
return($footer);
}
##########################################################################
=head3 buildTemplate()
$template=buildTemplate();
$template = variable to pass the template back into
Builds the object template, and returns it.
=cut
sub buildTemplate
{
my $template;
my $shortdesctitle;
my $template_loaded;
debug("Entering subroutine: buildTemplate();",4,__LINE__);
$template_loaded=0;
# Check for local templates, if not found add full path to template files
# Album Template
$::album_template=findTemplate($::original_album_template);
# Photo Template
$::photo_template=findTemplate($::original_photo_template);
# Object Template
$::object_template=findTemplate($::original_object_template);
# Upload Template
$::upload_template=findTemplate($::original_upload_template);
# Login Template
$::login_template=findTemplate($::original_login_template);
debug("\$::album_template is now $::album_template",4,__LINE__);
debug("\$::photo_template is now $::photo_template",4,__LINE__);
debug("\$::object_template is now $::object_template",4,__LINE__);
debug("\$::upload_template is now $::upload_template",4,__LINE__);
debug("\$::login_template is now $::login_template",4,__LINE__);
# Photo template
if ($::photo)
{
open(TEMPLATE,"$::photo_template") || error(__LINE__,"not_readable","$::photo_template: $!");
debug("Using Template File: [$::photo_template]",2,__LINE__);
$template_loaded=1;
}
# Upload Template
if ($::function eq $::upload)
{
open(TEMPLATE,"$::upload_template") || error(__LINE__,"not_readable","$::upload_template: $!");
debug("Using Template File: [$::upload_template]",2,__LINE__);
$template_loaded=1;
}
# Login Template
if (($::function eq $::login_code) && !$::authenticated)
{
open(TEMPLATE,"$::login_template") || error(__LINE__,"not_readable","$::login_template: $!");
debug("Using Template File: [$::login_template]",2,__LINE__);
$template_loaded=1;
}
# Album template
if (!$template_loaded)
{
open(TEMPLATE,"$::album_template") || error(__LINE__,"not_readable","$::album_template: $!");
debug("Using Template File: [$::album_template]",2,__LINE__);
}
$template=join("",);
close(TEMPLATE);
debug("Loaded object_template: [$template]",4,__LINE__);
# Cut out HTML for title
$shortdesctitle=$::shortdesc;
$shortdesctitle=~s/<([^>]|\n)*>//g;
if (!$shortdesctitle)
{
$shortdesctitle="$::S{87}";
}
# Handle SSI pages by ripping out everything but ####OBJECT#### from the templates. It's rough, but it works.
if ($::ssi && ($::function ne $::login_code))
{
# Rip out everything
$template="####OBJECT####";
# ...and if we're doing a slideshow, we have to re-insert that stuff...
if ($::slide_timer)
{
$template="####SLIDESHOW####$template";
}
# Re-add stylesheet tag
$template="####STYLESHEET####$template";
}
# Substitute tags for actual data
$template=substituteData($template);
# Adjust style sheet link for static HTML (best when not burning to CD)
if ($::create_html_flag)
{
#$template=~s/$::style_sheet/$::album_dir$::style_sheet/g;
}
debug("Leaving subroutine: buildTemplate();",4,__LINE__);
return($template);
}
##########################################################################
=head3 buildNavFooter()
$nav_footer=buildNavFooter($mode);
$mode - 0 = Build entire Nav footer; 1 = Build "Previous" section only; 2 = Build "Up" section only; 3 = Build "Next" section only; 4 = Jump station only
Builds the navigaction footer, and returns it. (The navigation footer is the buttons/links that allow you to visit the next/previous photo or album.)
=cut
sub buildNavFooter
{
use strict;
my $mode=shift;
my $nav_footer;
my $temp;
my $static_photos_thumb_temp;
my $albumtemp;
my $isalbumtemp;
my $dotdot;
my $tempfilenum=$::filenum;
# Max length of button descriptions
my $desclen=25;
debug("Entering subroutine: buildNavFooter()",4,__LINE__);
debug("\$::page = [$::page]",2,__LINE__);
debug("\$::numfiles = [$::numfiles]",2,__LINE__);
debug("\$::photos_per_page = [$::photos_per_page] [$::rows]x[$::columns]",2,__LINE__);
debug("\$tempfilenum = [$tempfilenum]",2,__LINE__);
debug("\$::filenum = [$::filenum]",2,__LINE__);
debug("\$::photo = [$::photo]",2,__LINE__);
# Crappy modulo code that I wrote on the bus
if ($::photo && $::photos_per_page)
{
debug("In the loop",2,__LINE__);
$::page=1;
while ($tempfilenum > $::photos_per_page)
{
$::page++;
$tempfilenum-=$::photos_per_page;
debug("Incrementing page to $::page [$tempfilenum]",2,__LINE__);
}
}
debug("\$::page = [$::page]",2,__LINE__);
# Display the "previous photo" link/button
if (!$mode || $mode eq 1)
{
$nav_footer="
\n";
}
if (!$mode)
{
# New line
$nav_footer.=" ";
}
if (!$mode || $mode eq 4)
{
# Display jump station
if ($::jump_to)
{
$nav_footer.=$::jump_station;
}
}
debug("Leaving subroutine: buildNavFooter()",4,__LINE__);
return($nav_footer);
}
##########################################################################
=head3 passVars()
$vars=passVars($format);
$vars = variable to pass the formed variables back into
$format = 0: pass in web URL format (&debug=1&configfile=file, etc); 1: pass in button format (\n";
}
if ($::slide_timer_passed)
{
$vars.="\n";
}
if ($::configfilepassed)
{
$vars.="\n";
}
if ($::debug)
{
$vars.="\n";
}
if ($mypass)
{
$vars.="\n";
}
if ($myuser)
{
$vars.="\n";
}
if ($::photo_width)
{
$vars.="\n";
}
if ($::photo_height)
{
$vars.="\n";
}
if ($::fullscreen)
{
$vars.="\n";
}
if ($::ssi)
{
$vars.="\n";
}
}
# Restore function, if required
if (!$::function)
{
$::function=$tempfunc;
}
return($vars);
}
##########################################################################
=head3 printHeader()
$header=printHeader($mode);
$header - The formed header, with style sheet or body colour tags, is returned.
$mode - 0 = Return all header HTML; 1 = Return just style sheet tag
Prints out either the style sheet or a generic body tag.
=cut
sub printHeader
{
my $mode=shift;
my $html;
my $width;
my $padding;
my $float;
# Not for SSI
# Uncomment this line to turn on the style sheet for SSI recent uploads
# if ($::ssi && ($::album ne $::recent_upload_album) && !$::popular_flag)
# Otherwise this line is in effect
if ($::ssi && !$::popular_flag)
{
return();
}
if ($::style_sheet)
{
$html="\n";
}
$html.="";
# If columns is not set yet, then give it a value, so we can show things properly
if (!$::columns)
{
$::columns=5;
}
# # Set the "float" properly, per browser
# if (detectBrowser())
# {
# # Mozilla
# $float="left";
# }
# else
# {
# # IE
# $float="none";
# }
# Add style info for objects in an album, because width is dynamic
# $width=int(100/$::columns)-int($::column_spacing/3);
# $padding=$::column_spacing."px";
# $html.=<
#.dynwidth { width: $width%; display: inline; padding: $padding; float: $float; }
#
#HTML
if (!$mode)
{
$html.="\n\n";
}
# Insert "missing style sheet" warning
$html.="
$::S{297}
";
return($html);
}
##########################################################################
=head3 trackView()
$current_views=trackView($currentphoto,$mode;$newcount);
$current_views - Returns a string containing the number of views and the last viewed date.
$currentphoto - Photo to update views for.
$mode - 0 = Update views; 1 = Don't update views; 2 = Reset count to zero; 3 = set count to passed number
$newcount - Set counter to this number if passed and mode 3.
Updates the number of views and the last viewed date for the current photo in $::viewfile.
=cut
sub trackView
{
my $currentphoto=shift;
my $mode=shift;
my $newcount=shift;
my $updated_views;
my $data;
my $current_count;
my $this_count;
my $last_viewed_date;
my $read_date;
my $virtualfile="";
my $current_viewfile="$::album_dir/";
my $current_view_date=setDate();
if ($::goback)
{
$current_viewfile.="$::goback/";
}
$current_viewfile.="$::viewfile";
if (!$currentphoto)
{
debug("No photo selected, not updating views.",2,__LINE__);
return();
}
debug("Entering subroutine: trackView($currentphoto,$mode,$newcount);",4,__LINE__);
debug("Updating views for $currentphoto in $current_viewfile",2,__LINE__);
# Does it already exist?
if (-e $current_viewfile)
{
# Open $::viewfile for reading
if (!open(VIEWS,"$current_viewfile"))
{
$::warning.="$::S{20} $current_viewfile ";
}
if (!-W "$current_viewfile")
{
$::warning.="$::S{23} $current_viewfile ";
}
# have not updated views
$updated_views=0;
if ($::warning)
{
return;
}
while ($data=)
{
# Check to see if this is the one we want
if ($data=~/^$currentphoto\t.*/)
{
chomp($data);
debug("Found match: $data",3,__LINE__);
close(RATINGS);
($current_count,$current_count,$read_date)=split("\t",$data);
if ($read_date eq $data || !$read_date)
{
$read_date="$::S{93}";
}
debug("Data: [$data] --> Count:[$current_count] Date:[$read_date]",4,__LINE__);
$this_count=$current_count;
if ($mode eq 2)
{
$this_count=0;
}
elsif ($mode eq 3)
{
$this_count=$newcount;
}
elsif (!$mode)
{
$this_count++;
}
$last_viewed_date=$read_date;
$virtualfile.="$currentphoto\t$this_count\t$current_view_date\n";
# don't re-add the desc at the end
$updated_views=1;
}
else
{
debug("Wrote: $data",4,__LINE__);
$virtualfile.="$data";
}
}
# If the photo didn't already hav an entry, add it now.
if (!$updated_views)
{
debug("No entry found, adding one.",2,__LINE__);
if (!$mode)
{
$virtualfile.="$currentphoto\t1\t$current_view_date\n";
}
else
{
$virtualfile.="$currentphoto\t$newcount\t$current_view_date\n";
}
}
close(VIEWS);
# Update views if that's what we're doing
if (!$mode || $mode eq 2 || $mode eq 3)
{
# Re-open views file and write out new contents
if (!open(VIEWS,">$current_viewfile"))
{
$::warning.="$::S{23} $current_viewfile ";
return();
}
print VIEWS $virtualfile;
close(VIEWS);
}
}
elsif (!$mode || $ mode eq 3)
{
$last_viewed_date="";
debug("$current_viewfile does not exist, creating...",2,__LINE__);
if (!open(VIEWS,">$current_viewfile"))
{
$::warning.="$::S{23} $current_viewfile ";
return();
}
if (!$mode)
{
print VIEWS "$currentphoto\t1\t$current_view_date\n";
debug("printing $currentphoto\t1\t$current_view_date",2,__LINE__);
}
else
{
print VIEWS "$currentphoto\t$newcount\t$current_view_date\n";
debug("printing $currentphoto\t$newcount\t$current_view_date",2,__LINE__);
$this_count=$newcount;
}
close(VIEWS);
}
if (!$this_count)
{
$this_count=1;
}
if (!$mode)
{
$data="$::S{94} ";
}
$data.=$this_count;
if (!$mode)
{
$data.=" ";
if ($this_count gt 1)
{
$data.="$::S{202}";
}
else
{
$data.="$::S{200}";
}
if (!$last_viewed_date)
{
$data.=" $::S{96}";
}
else
{
$data.=". $::S{97} $last_viewed_date.";
}
}
debug("Data is: $data",4,__LINE__);
debug("Leaving subroutine: trackView($currentphoto,$mode);",4,__LINE__);
return($data);
}
##########################################################################
=head3 findTemplate()
$template_path=findTemplate($template_name);
$template_path - The full path to the appropriate template (local or global).
$template_path - The filename of the template.
Replaces all the tags in the data passed in, and returns the updated string.
=cut
sub findTemplate
{
my $template_name=shift;
my $localdir;
debug("Entering subroutine: findTemplate($template_name);",4,__LINE__);
if ($::album && $::album ne $::recent_upload_album)
{
$localdir=$::album;
}
else
{
$localdir="$::album_dir/$goback";
}
debug("Checking [$localdir/$template_name]",4,__LINE__);
# Load localized object template if present
if (-r "$localdir/$template_name")
{
$template_name="$localdir/$template_name";
}
elsif (-r "$::template_dir/$template_name")
{
$template_name="$::template_dir/$template_name";
}
debug("Template is now [$template_name]",4,__LINE__);
debug("Leaving subroutine: findTemplate($template_name);",4,__LINE__);
return($template_name);
}
##########################################################################
=head3 substituteData()
$output_data=substituteData($input_data);
$input_data - Data that is passed in. Each of the "####TAGS####" tags are replaced with actual data. See the file format section of this document for details on the tags.
$output_data - After substitutions, the data that is returned.
Replaces all the tags in the data passed in, and returns the updated string.
=cut
sub substituteData
{
my $html_data=shift;
my $footer;
my $legend_html;
my $notify_html;
my $add_desc_footer;
my $slidestop_html;
my $slideshow_html;
my $views;
my $ratings;
my $format_html;
my $upload_form;
my $date;
my $fullscreen_html;
my $insert_file;
my $temp;
my $temp2;
my $thisphoto;
my $thisalbum;
my $debug_html;
my $insert_filename;
my $login_html;
my $login_form;
my $jhead_data;
my $vars;
my $recent_uploads_html;
my $purl;
my $purl2;
my $create_html;
my $delete_html;
my $move_html;
my $link_html;
my $bread_html;
my $sizes_html;
my $style_html;
my $search_html;
my $config_html;
my $random_html;
my $tempalbum;
my $popular_html;
my $admin_menu;
my $navprev;
my $navup;
my $navnext;
my $navjump;
debug("Data before substitution: [$html_data]",4,__LINE__);
# Add create album form - Note that this only replaces the OBJECT tag if we're on admincreate.
if ($form->param('admincreate') && !$form->param('albumname'))
{
require $::admin_module;
$create_html=createAlbumForm($form->param('album'));
$html_data=~s/####OBJECT####/\n\n$create_html\n\n/g;
}
# Add delete form - Note that this only replaces the OBJECT tag if we're on deleteobject.
if ($form->param('deleteobject'))
{
require $::admin_module;
$delete_html=deleteObject($form->param('deleteobject'),1);
$html_data=~s/####OBJECT####/\n\n$delete_html\n\n/g;
}
# Add move form - Note that this only replaces the OBJECT tag if we're on moveobject.
if ($form->param('moveobject'))
{
require $::admin_module;
$move_html=moveObject($form->param('moveobject'),1);
$::shortdesc=$::S{217};
$::longdesc="";
$html_data=~s/####OBJECT####/\n\n$move_html\n\n/g;
}
# Add link form - Note that this only replaces the OBJECT tag if we're on linkobject.
if ($::linkobject)
{
require $::admin_module;
$link_html=linkObject($::linkobject,1);
$::shortdesc=$::S{309};
$::longdesc="";
$html_data=~s/####OBJECT####/\n\n$link_html\n\n/g;
}
# Add search form - Note that this only replaces the OBJECT tag if we're on search.
if ($form->param('searchstart'))
{
require $::recent_module;
$search_html=searchForm();
$html_data=~s/####OBJECT####/\n\n$search_html\n\n/g;
}
# Add search results - Note that this only replaces the OBJECT tag if we're processing a search.
if ($::searchstring)
{
debug("Calling search($::searchstring)",3,__LINE__);
require $::recent_module;
$search_html=search($::searchstring);
$html_data=~s/####OBJECT####/\n\n$search_html\n\n/g;
}
# Recent Uploads Page
if ($::recent_uploads && ($form->param('album') eq $::recent_upload_album))
{
require $::recent_module;
$recent_uploads_html=recentUploads();
$::shortdesc="$::recent_uploads $::S{195}";
$::longdesc="";
$html_data=~s/####OBJECT####/\n\n$recent_uploads_html\n\n/g;
}
# Add Most Popular results - Note that this only replaces the OBJECT tag if we're processing a search.
if ($::popular_flag)
{
debug("Calling popular()",3,__LINE__);
require $::recent_module;
$popular_html=popular();
$html_data=~s/####OBJECT####/\n\n$popular_html\n\n/g;
}
# Add rating form - Note that this only replaces the OBJECT tag if we're entering a rating.
if ($::function eq $::rating_form)
{
$ratings=<
HTML
$::shortphoto=$::object;
$thisalbum=$form->param('rating_file_loc');
$thisphoto=$form->param('object');
if ($::ratingfile)
{
$ratings.=getRatings(1,$thisalbum);
}
$ratings.=<
$::S{197}
$::S{114}
HTML
$ratings.="";
$ratings.=<
$::S{115}
HTML
$::function=$::update_rating;
$ratings.=passVars(1);
$ratings.=<
HTML
$html_data=~s/####OBJECT####/\n\n$ratings\n\n/g;
}
# Replace object tag if we're just doing regular stuff
$html_data=~s/####OBJECT####/\n\n$::actual_object\n\n/g;
# Insert files (this is done first so that all inserted tags are also replaced
while ($html_data=~/####FILE=([^#]*)####/)
{
$insert_filename=$1;
$insert_filename=findTemplate($insert_filename);
debug("Inserting file: [$insert_filename]",2,__LINE__);
if (-r $insert_filename)
{
open(FILE,$insert_filename);
$insert_file=join("",);
close(FILE)
}
else
{
$insert_file="\n";
debug("Not inserted! (Not readable)",2,__LINE__);
}
$html_data=~s/####FILE=([^#]*)####/\n\n$insert_file\n\n/;
}
# Set internal variables
while ($html_data=~/####CODE=(.*?)####/s)
{
debug("Evaluating CODE expression: [$1]",2,__LINE__);
$config_html=eval("$1");
# Don't display return codes of 0/1, but display any other returned data
if (!$config_html || $config_html eq 1)
{
$config_html="";
}
$html_data=~s/####CODE=(.*?)####/$config_html/s;
}
# Substitute Strings from album_strings.txt
$html_data=~s/####STRING=(\d*)####/$::S{$1}/g;
# Substitute internal variables
while ($html_data=~/####CONFIG=(.*?)####/)
{
debug("Evaluating CONFIG expression: [$1]",2,__LINE__);
$config_html=eval("\$$1");
$html_data=~s/####CONFIG=(.*?)####/$config_html/;
}
# Replace object title tag with object title
$html_data=~s/####TITLE####/\n\n$::shortdesc\n\n/g;
# Replace metadata title tag with object title. Do not put the start and end comments here it hoses up meta tags.
$html_data=~s/####METATITLE####/$::shortdesc/g;
# Strip out HTML tags from the object title if it's used as the page title.
$temp=$::shortdesc;
$temp=~s/<([^>]|\n)*>//g;
$html_data=~s/.*<\/title>/$temp<\/title>/isg;
# Perform substitutions of tags for actual data
$html_data=~s/####DESCRIPTION####/\n\n$::longdesc\n\n/g;
# Replace metadata description tag with object desctiption and remove any other HTML. Do not put the start and end comments here it hoses up meta tags.
$temp=$::longdesc;
$temp=~s/<([^>]|\n)*>//g;
$html_data=~s/####METADESCRIPTION####/$temp/g;
$style_html=printHeader(1);
$html_data=~s/####STYLESHEET####/\n\n$style_html\n\n/g;
$html_data=~s/####SIZE####/\n\n$::upload_size_limit\n\n/g;
$html_data=~s/####MOVIESIZE####/\n\n$::movie_upload_size_limit\n\n/g;
$html_data=~s/####PAGES####/\n\n$::pages_html\n\n/g;
# Build navigation footer buttons/links
$navprev=buildNavFooter(1);
if ($::keep_this)
{
$navup=buildNavFooter(2);
}
$navnext=buildNavFooter(3);
$navjump=buildNavFooter(4);
$::nav_footer=buildNavFooter();
$html_data=~s/####NAVPREV####/\n\n$navprev\n\n/g;
$html_data=~s/####NAVUP####/\n\n$navup\n\n/g;
$html_data=~s/####NAVNEXT####/\n\n$navnext\n\n/g;
$html_data=~s/####NAVJUMP####/\n\n$navjump\n\n/g;
$html_data=~s/####NAV####/\n\n$::nav_footer\n\n/g;
# Date
$date=setDate("",1);
$html_data=~s/####DATE####/\n\n$date\n\n/g;
# Direct URL to photo (not through album.pl), plain
if ($::photo)
{
$purl="$::album_web/$::photo";
$purl=~s/ /%20/g;
}
$html_data=~s/####OBJECTURL####/$purl/g; # Don't put tags around OBJECTURL, as it screws up the HTML if it's used in a link
# Direct URL to photo (not through album.pl), HTMLized
if ($::photo)
{
$purl="$::S{210} $purl $::S{211}";
}
$html_data=~s/####URL####/\n\n$purl\n\n/g;
# Album/Photo Path
if ($::photo)
{
$purl2=webifyLinks($::photo);
}
else
{
if ($::shortalbum ne $::rootalbumname)
{
if ($::goback)
{
$purl2.="$::goback/";
}
$purl2.="$::shortalbum";
}
}
$html_data=~s/####PATH####/$purl2/g; # Don't put tags around PATH, as it screws up the HTML if it's used in a link
# URL to photo through album.pl, not HTMLized
if ($::photo)
{
$purl2="$::albumprog?photo=$purl2";
}
else
{
if ($::shortalbum ne $::rootalbumname)
{
$purl2="?album=$purl2";
}
$purl2="$::albumprog$purl2";
}
$html_data=~s/####URLONLY####/$purl2/g; # Don't put tags around URLONLY, as it screws up the HTML if it's used in a link
# Direct call to album.pl root album (with vars), not the curent object.
$vars=passVars(2);
$html_data=~s/####ALBUMPROG####/$::albumprog?full=1$vars/g; # Don't put tags around albumprog, as it screws up the HTML if it's used in a link
# Code to set default upload dir to current album provided by Systematic
if (($::shortalbum ne $::rootalbumname) && $::shortalbum)
{
my $temptemp="function=$::upload".$::webdelim."album=";
if ($::goback)
{
$temptemp.="$::goback/";
}
$temptemp.="$::shortalbum\"";
$html_data=~s/function=$::upload"/$temptemp/g;
}
# Is this the root album? If so, build legend and notify chunks.
if (!$::middle)
{
if ($::legend)
{
$legend_html="$::S{101} \n";
$legend_html.="
\n";
# Don't add twice
$::notify=0;
}
$html_data=~s/####LEGEND####/\n\n$legend_html\n\n/g;
$html_data=~s/####NOTIFY####/\n\n$notify_html\n\n/g;
# Fullscreen slide show
if ($::photo)
{
$temp="$::albumprog?slideshow=";
if ($::slide_timer)
{
$temp.=$::slide_timer;
}
else
{
$temp.="5";
}
$temp.=$::webdelim."fullscreen=1".$::webdelim."photo=".webifyLinks($::photo).$::webdelim;
# Clear constrained values
my $temp_height=$::photo_height;
my $temp_width=$::photo_width;
$::photo_height=$::photo_width=0;
$temp.=passVars(0);
$temp2=$temp."photo_width=auto".$::webdelim."photo_height=auto";
($height,$width)=getPhotoDimensions("$::album_dir/$::photo");
if ($width > $height)
{
$temp.=$::webdelim."photo_width=";
$fullscreen_html.="";
}
else
{
$temp.=$::webdelim."photo_height=";
$fullscreen_html.="";
}
if ($::textmenu)
{
$fullscreen_html.=" $::S{98} $::S{51}";
}
else
{
$fullscreen_html.="";
}
$fullscreen_html.="";
# Restore original sizes
$::photo_height=$temp_height;
$::photo_width=$temp_width;
}
$html_data=~s/####FULLSCREEN####/\n\n$fullscreen_html\n\n/g;
# Insert "sizes" text for photos
if ($::photo && !$::create_html_flag)
{
$temp=$::photo_width;
$temp2=$::photo_height;
$::photo_width=0;
$::photo_height=0;
# Display [ Small ] resize link
if ($::small_width || $::small_height)
{
$sizes_html.="";
if ($::textmenu)
{
$sizes_html.=$::S{54};
}
else
{
$sizes_html.="";
}
$sizes_html.=" ";
}
# Display [ Medium ] resize link
if ($::medium_width || $::medium_height)
{
# Insert divider for text menus
if ($::textmenu && ($::small_width || $::small_height))
{
$sizes_html.=" $::S{98} ";
}
$sizes_html.="";
if ($::textmenu)
{
$sizes_html.=$::S{139};
}
else
{
$sizes_html.="";
}
$sizes_html.=" ";
}
# Display [ Large ] resize link
if ($::large_width || $::large_height)
{
# Insert divider for text menus
if ($::textmenu && ($::medium_width || $::medium_height))
{
$sizes_html.=" $::S{98} ";
}
$sizes_html.="";
if ($::textmenu)
{
$sizes_html.=$::S{177};
}
else
{
$sizes_html.="";
}
$sizes_html.=" ";
}
# If we've displayed any of these, display the [ Full Size ] link.
if ($::small_width || $::small_height || $::medium_width || $::medium_height || $::large_width || $::large_height)
{
# Display [ Auto Size ] resize link
# Insert divider for text menus
if ($::textmenu)
{
$sizes_html.=" $::S{98} ";
}
$sizes_html.="";
if ($::imagemagick)
{
if ($::textmenu)
{
$sizes_html.=$::S{339};
}
else
{
$sizes_html.="";
}
}
$sizes_html.=" ";
# Insert divider for text menus
if ($::textmenu)
{
$sizes_html.=" $::S{98} ";
}
$sizes_html.="";
if ($::textmenu)
{
$sizes_html.=$::S{179};
}
else
{
$sizes_html.="";
}
$sizes_html.=" ";
}
$::photo_width=$temp;
$::photo_height=$temp2;
}
$html_data=~s/####SIZES####/\n\n$sizes_html\n\n/g;
# Recent Uploads Link
if ($::recent_uploads && !$::create_html_flag)
{
$recent_uploads_html="";
if ($::textmenu)
{
$recent_uploads_html.=$::S{234};
}
else
{
$recent_uploads_html.="";
}
$recent_uploads_html.="";
}
$html_data=~s/####RECENTUPLOADS####/\n\n$recent_uploads_html\n\n/g;
# Are we tracking the number of photo views?
if ($::viewfile && !$::create_html_flag && $::keep_this)
{
$views=trackView($::shortphoto);
}
$html_data=~s/####VIEWS####/\n\n$views\n\n/g;
# Height an dwidth (no tags)
$html_data=~s/####HEIGHT####/$height/g;
$html_data=~s/####WIDTH####/$width/g;
# Get thumbnail URL
$thumburl=showThumb($::photo,1);
$html_data=~s/####THUMBURL####/$thumburl/g;
# Insert "breadcrumbs"
if ($::keep_this)
{
$bread_html=showBreadCrumbs();
}
$html_data=~s/####BREAD####/\n\n$bread_html\n\n/g;
# Substitute upload formats
$format_html=join(", ",@::imgexts);
if ($::movie_upload)
{
if ($::imgexts[0])
{
$format_html.=", "
}
$format_html.=join(", ",@::movieexts);
}
$format_html=~s/(.*), /$1 $::S{245} /;
$html_data=~s/####FORMAT####/\n\n$format_html\n\n/g;
# Random Thumbnail
if ($html_data=~/####RANDTHUMB####/)
{
# Save off album
$tempalbum=$::album;
# Get random image
require $::recent_module;
$random_html=randomizer();
# Fix album var for this operation
$::album=$::manual_override;
$::album=~s/(.*)\/.*/$1/;
# Generate random HTML
$random_html=showObject($random_html);
$html_data=~s/####RANDTHUMB####/\n\n$random_html\n\n/g;
# Reset album to normal value
$::album=$tempalbum;
}
# Login status
$login_html=loginStatus();
$html_data=~s/####LOGIN####/\n\n$login_html\n\n/g;
# jhead information
if ($::jhead && $::photo)
{
$jhead_data=$::jhead_html;
}
$html_data=~s/####JHEAD####/\n\n$jhead_data\n\n/g;
# Put in fullscreen popup java code (must appear in section)
if ($::photo && ($::fullscreen ne "1" && $::fullscreen ne $::S{263}))
{
$slideshow_html=<
HTML
}
# Put slide show directive in (must appear in section)
if ($::slide_timer && $::photo)
{
my $next_web_link=$::next_photo_link;
# If there's a next photo, refresh to it
if ($::next_obj)
{
$next_web_link=~s/;/&/g;
if (($form->param('fullscreen') ne "1") && $::fullscreen ne $::S{263})
{
$slideshow_html.="";
}
else
{
$next_web_link=~s/photo_width=//g;
$next_web_link=~s/photo_height=//g;
$next_web_link.="\&";
($height,$width)=getPhotoDimensions("$::album_dir/$::goback/$::next_obj");
if ($width > $height)
{
$next_web_link.="photo_width=";
$slideshow_html.=<
HTML
}
else
{
$next_web_link.="photo_height=";
$slideshow_html.=<
HTML
}
}
}
# Full screen mode!
if ((($form->param('fullscreen') eq "1") || $::fullscreen eq $::S{263}) && $::photo)
{
$html_data="\n####STYLESHEET####\n$slideshow_html";
$html_data.=<
HTML
$style_html=printHeader(1);
$html_data=~s/####STYLESHEET####/\n\n$style_html\n\n/g;
$html_data.="\n\n
\n\n";
}
}
$html_data=~s/####SLIDESHOW####/\n\n$slideshow_html\n\n/g;
# Slideshow Controls
if ($::slide_timer && $::next_obj && $::photo)
{
$slidestop_html="\n";
}
$html_data=~s/####STOPSLIDESHOW####/\n\n$slidestop_html\n\n/g;
if ($::debug)
{
$debug_html="\n";
}
$html_data=~s/####STOPDEBUG####/\n\n$debug_html\n\n/g;
# Show upload form
if ($::function eq $::upload)
{
require $::upload_module;
$upload_form=showUploadForm();
}
$html_data=~s/####UPLOAD####/\n\n$upload_form\n\n/g;
# Show Administration menu
if (isAdmin())
{
require $::admin_module;
$admin_menu=showAdminMenu(0);
}
$html_data=~s/####ADMIN####/\n\n$admin_menu\n\n/g;
# Show Login Form
if ($::function eq $::login_code)
{
require $::login_module;
$login_form=showLogin();
}
$html_data=~s/####LOGINFORM####/\n\n$login_form\n\n/g;
# Check to see if we are adding a description
if ($::function eq $::enter_desc || $form->param('editobject'))
{
$add_desc_footer=buildDescFooter(0);
}
$html_data=~s/####ENTERDESC####/\n\n$add_desc_footer\n\n/g;
# Are we rating photos?
if ($::ratingfile && !$::create_html_flag && !$::album && $::keep_this)
{
$ratings=getRatings();
}
$html_data=~s/####RATINGS####/\n\n$ratings\n\n/g;
# Add footer last, in case there are any warnings
$footer=showFooter(0);
$html_data=~s/####FOOTER####/\n\n$footer\n\n/g;
debug("Data after substitution: [$html_data]",4,__LINE__);
# Return data
return($html_data);
}
##########################################################################
=head3 buildObject()
$output_data=buildObject();
$output_data - The HTML for displaying the object is build and returned.
Builds the "object" to be displayed. For a photo, it builds the HTML to display the photo, and for an album, it builts the list of objects in that album (photos and sub-albums).
=cut
sub buildObject
{
my $actual_object;
my $relpath;
my $temppage;
my $temppage2;
my $pages_html2;
my $jhead_txt;
my @sorted;
my $movietemp;
my @temp_file_list;
my $item;
my $first;
my $platform;
my $convertflag;
my $systemcall;
my $time_taken;
my $width;
my $height;
my $buff;
my $type;
my $auto_size=0;
my $g_HTML_string="";
debug("Entering subroutine: buildObject();",4,__LINE__);
if ($::function eq "about")
{
$actual_object=<
Version $::ver ($::release Release) written by Mike Bobbitt.
With modifications by J.J. Frister
HTML
return($actual_object);
}
if (($::photo_width eq "auto" || $::photo_height eq "auto") && (!$::imagemagick))
{
$::photo_width=$::small_width;
$::photo_height=$::small_height;
}
if (($::photo_width eq "auto" || $::photo_height eq "auto") && isAPhotoOrJp2("$::album_dir/$::photo"))
{
$auto_size=1;
debug("Auto size = 1",4,__LINE__);
# jscript for window sizing
$actual_object.=<
resize();
HTML
}
if ($::jhead_html)
{
$actual_object.=$::jhead_html;
}
if ($::album)
{
my $temptemplate;
$actual_object="";
if ($form->param('pickthumb'))
{
$actual_object.=$::S{275}."
";
}
$temptemplate=$::object_template;
# Load localized object template if present
$::object_template=findTemplate($::object_template);
# Open object template
open(TEMPLATE,"$::object_template") || error(__LINE__,"not_readable","$::object_template: $!");
debug("Using Template File: [$::object_template]",2,__LINE__);
$::subtemplate=join("",);
close(TEMPLATE);
# Make substitutions for dynamic data in the object template
$::subtemplate=substituteData($::subtemplate);
# Restore object template
$::object_template=$temptemplate;
# Reset the number of pictures in the current row and on the current page
$::num_page_pics=$::multi_page=$::total_objects=0;
$::starting_number=$::photos_per_page*$::page-$::photos_per_page;
$::ending_number=$::photos_per_page*$::page+1;
debug("Displaying pictures in range: $::starting_number to $::ending_number",2,__LINE__);
@temp_file_list=@::file_list;
if (@::album_list)
{
@::file_list=@::album_list;
@sorted=sortObjects();
if (@::photo_list || @::movie_list)
{
$actual_object.="
\n";
# Close off line
$actual_object.=" \n";
}
@::file_list=@temp_file_list;
# Display total number of pages...
if ($::multi_page)
{
$::pages_html="";
$::num_page_pics=$::total_objects;
$temppage=1;
while ($::num_page_pics > 0)
{
$::num_page_pics-=$::photos_per_page;
$::pages_html.=" ";
if ($::page ne $temppage)
{
$::pages_html.="";
}
$::pages_html.="$temppage";
if ($::page ne $temppage)
{
$::pages_html.="";
}
$temppage++;
}
$temppage--;
debug("Total pages: $temppage",2,__LINE__);
debug("Current page: $::page",2,__LINE__);
# Print "Previous" page link
if (($temppage > 1) && ($::page > 1))
{
$pages_html2.=" $::S{89} ";
$pages_html2.="$::S{209}";
$::pages_html="$pages_html2 $::pages_html";
}
# Print "Next" page link
if (($temppage > 1) && ($::page < $temppage))
{
$::pages_html.=" ";
$::pages_html.="$::S{208} $::S{92} ";
}
# Show "All" pages
$pages_html2="";
$pages_html2.="$::S{303}";
$::pages_html="$pages_html2 $::pages_html";
# "Page:" prefix
$::pages_html="$::S{207} $::pages_html";
}
}
debug("Leaving subroutine: buildObject();",4,__LINE__);
return($actual_object);
}
##########################################################################
=head3 sortObjects()
@sorted=sortObjects($mode);
@sorted - The @::file_list, sorted according to the configuration
$mode - 0 = Sorting for album view; 1 = Sorting for navigation bar (cuts off photo filename)
Sorts @::file_list, according to configuration settings, and returns the sorted array.
=cut
sub sortObjects
{
my @tempsort;
my @sorted;
my $count;
my $length;
my $newmiddle=$::middle;
my $mode=shift;
my %m;
# $sortby =
# 0 = Sort by filename (ascending)
# 1 = Sort by filename (descending)
# 2 = Sort by modified date (newest first)
# 3 = Sort by modified date (oldest first)
# 4 = Sort by creation date (newest first)
# 5 = Sort by creation date (oldest first)
debug("Entering subroutine: sortObject()",4,__LINE__);
debug("\$::sortby = $::sortby",2,__LINE__);
# Cheap way to do debug("XX",2,__LINE__);
if ($::debug gt 2)
{
my $temp;
require $::display_module;
display("
");
}
@::file_list=sort {uc($a) cmp uc($b)} @::file_list;
# Sort by file date
if ($::sortby eq 2 || $::sortby eq 3 || $::sortby eq 4 || $::sortby eq 5)
{
debug("Sorted by modified date, newest first...",3,__LINE__);
# Sorting Code by Sukeband (sukeband@vzavenue.net)
@tempsort=@::file_list;
# Change all \'s to /'s
$newmiddle=~s/\\/\//g;
if ($mode)
{
$newmiddle=~s/(.*)\/.*/$1/;
}
$newmiddle=$::album_dir."/".$newmiddle."/";
# Cycle through all elements of @tempsort, adding full path
for($count=1;$count<=@tempsort;$count++)
{
$tempsort[$count-1]="$newmiddle$tempsort[$count-1]";
}
$length=1;
if ($::sortby eq 2 || $::sortby eq 3)
{
# Get the modified date of each file
@sorted=sort{ ($m{$a} ||= -M $a) <=> ($m{$b} ||= -M $b) } @tempsort;
}
elsif ($::sortby eq 4 || $::sortby eq 5)
{
# Get the creation date of each file
@sorted=sort{ ($m{$a} ||= -C $a) <=> ($m{$b} ||= -C $b) } @tempsort;
}
}
else
# Sort by filename, ascending
{
debug("Sorted by filename, ascending...",3,__LINE__);
@sorted=@::file_list;
}
# Reverse
if ($::sortby eq 1 || $::sortby eq 3 || $::sortby eq 5)
{
debug("Reversing Sort...",3,__LINE__);
@sorted=reverse @sorted;
}
# Strip out added path, if required
if ($length)
{
# How long is the path we added?
$length=length("$newmiddle");
# Chop the added path off again!
for($count=1;$count<=@sorted;$count++)
{
substr($sorted[$count-1],0,$length)="";
}
}
# Cheap way to do debug("XX",2,__LINE__);
if ($::debug gt 2)
{
my $temp;
require $::display_module;
display("
");
}
debug("Leaving subroutine: sortObject()",4,__LINE__);
return(@sorted);
}
##########################################################################
=head3 buildAlbum()
$return_html=buildAlbum($mode);
$return_html - The built HTML for the current object
$mode - 1 = Display this group on every page (albums); 0 = Display as per usual (photos and movies)
Builds the HTML for a photo, album or movie, as it appears in it's album (called when building an album page, for each "thimbnail" object on that page).
=cut
sub buildAlbum
{
# Pull down clean copy of template to use
my $actual_object=$::subtemplate;
my $mode=shift;
my $imagelink="";
my $admin_html="";
my $rating_html="";
my $objthumb="";
my $count_html="";
my $marker_html="";
my $setthumbflag=0;
my $webfile;
my $itsamovie;
my $photocount;
my $moviecount;
my $subalbumcount;
my $eachfile;
debug("Entering subroutine: buildAlbum($mode)",4,__LINE__);
# Keep count of total objects
if ($::shortfile)
{
$::total_objects++;
}
debug("\$::num_page_pics: $::num_page_pics",3,__LINE__);
debug("\$::total_objects: $::total_objects (out of $::photos_per_page, exclusive range $::starting_number to $::ending_number)",3,__LINE__);
# Is this page full?
if ($::shortfile && (!$::photos_per_page || (($::starting_number < $::total_objects) && ($::ending_number > $::total_objects))) || $mode)
{
my $tempmiddle=$::middle;
debug("\Going to display $::shortfile",3,__LINE__);
$::isimage=0;
$::isalbum=0;
$::file="$::album_dir";
$webfile="$::album_web";
if ($::middle)
{
$::file.="/$::middle";
$webfile.="/$::middle";
}
$::file.="/$::shortfile";
$webfile.="/$::shortfile";
# Check to see if file has photo extension
$::isimage=isAPhotoOrJp2($::file);
# Handle links
$::link_relpath="";
if ($::isimage eq 2)
{
$::link_relpath=$::file;
$::file=getLinkURL("$::file");
$::file="$::album_dir/$::file";
$::shortfile=$::file;
$::shortfile=~s/.*\/(.*)/$1/;
$::middle=$::file;
$::middle=~s/$::album_dir\/(.*)/$1/;
$::middle=~s/(.*)\/.*/$1/;
$webfile=$::album_web;
if ($::middle)
{
$webfile.="/$::middle";
}
$webfile.="/$::shortfile";
}
debug("\$::file: $::file",3,__LINE__);
debug("\$webFile: $webfile",3,__LINE__);
# Find relative path
$::relpath=$::file;
$::relpath=~s/$::album_dir\/(.*)/$1/;
$::link_relpath=~s/$::album_dir\/(.*)/$1/;
debug("Relpath: $::relpath",3,__LINE__);
debug("Link Relpath: $::link_relpath",3,__LINE__);
$itsamovie=0;
# If it's not a photo and not a JPEG 2000, check to see if it's a movie
if (!$::isimage)
{
$::isimage=$itsamovie=isAMovie($::file);
}
openDescfile("$::album_dir/$middle/");
getDescription($::shortfile);
debug("Checking to see if $::file is a directory",4,__LINE__);
if (-d $::file)
{
debug("$::file is a directory",4,__LINE__);
$::isimage=0;
$::isalbum=1;
}
# Cheap way to do debug("XX",2,__LINE__);
if ($::debug gt 2)
{
require $::display_module;
display("
".__LINE__.": $::file");
if ($::isimage)
{
display(" is a photo (so says \$::isimage)");
}
if ($::isalbum)
{
display(" is an album (so says \$::isalbum)");
}
display("
");
}
# Use filename if no desc found
if (!$::founddesc)
{
$::shortdesc=$::shortfile;
}
# New object
# $actual_object.="
";
debug("Returning rating of [$data]",4,__LINE__);
debug("Leaving subroutine: getRatings($mode,$rating_file_loc);",4,__LINE__);
return($data);
}
##########################################################################
=head3 webifyLinks()
$output=webifyLinks($input);
$input - The string to webify (make web safe).
$output - Web safe version returned.
Returns the "websafe" version of the passed filename/path.
=cut
sub webifyLinks
{
my $input=shift;
eval("use URI::Escape;");
if ($@!~/^Can't locate/)
{
eval("use URI::Escape");
# Replace any unsafe chars with their web versions
$input=uri_escape($input);
}
# Replace %2f's with slashes again
$input=~s/%2f/\//ig;
# Replace broken http:'s
$input=~s/http%3a/http:/ig;
# Clean out '
$input=~s/\'/%27/g;
return($input);
}
##########################################################################
=head3 isAdmin()
$status=isAdmin();
$status - 0 = Not an admin; 1 = Yep, they're an admin!; 2 = They're a user, but they own this album.
Checks to see if the current user is an authenticated admin.
=cut
sub isAdmin
{
my $status=0;
# Check to see if the user owns this album
if ($::loggedin eq $::owner && $::loggedin)
{
$status=2;
}
# If the current user is a default admin and is logged in, or the admin function is being used.
if (($::default_admins=~/.*,$::loggedin,.*/ && $::loggedin) || $::function eq $::admin)
{
$status=1;
}
debug("isAdmin: \$::function=$::function; \$::loggedin=$::loggedin; \$::owner=$::owner; \$::default_admins=$::default_admins... Is admin: $status",2,__LINE__);
return($status);
}
##########################################################################
=head3 isGuest()
$status=isGuest();
$status - 0 = Not a guest, 1 = Yep, they're a guest!
Checks to see if the current user is an authenticated guest.
=cut
sub isGuest
{
my $status=0;
# If the current user is a default admin and is logged in, or the admin function is being used.
if (($::default_guests=~/.*,$::loggedin,.*/ && $::loggedin) || $::default_guests=~/^,all,$/i && !isAdmin())
{
$status=1;
}
if ($::mem_level eq 0 && $::loggedin)
{
$status=1;
}
debug("isGuest: \$::loggedin=$::loggedin; \$::default_guests=$::default_guests... Is guest: $status",2,__LINE__);
return($status);
}
##########################################################################
=head3 getCookie()
getCookie();
Gets cookie from browser, and puts it into %cookie hash.
=cut
sub getCookie
{
my $chip;
my $val;
# split cookie at each ; (cookie format is name=value; name=value; etc...)
# Convert plus to space (in case of encoding (not necessary, but recommended)
foreach (split(/; /, $ENV{'HTTP_COOKIE'}))
{
s/\+/ /g;
# Split into key and value.
# splits on the first =.
($chip, $val) = split(/=/,$_,2);
# Convert %XX from hex numbers to alphanumeric
$chip =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
$val =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
# Associate key and value
$::cookie{$chip} .= "\1" if (defined($::cookie{$chip})); # \1 is the multiple separator
$::cookie{$chip} .= $val;
}
}
##########################################################################
=head3 splitCookie()
splitCookie($param);
$param = parameter to split
Splits a multi-valued chip into a list of parameters.
=cut
sub splitCookie
{
my $param=shift;
my @params=split("&",$param);
return (wantarray ? @params : $params[0]);
}
##########################################################################
=head3 showCookie()
showCookie();
Displays the contents of a cookie in debug level 2.
=cut
sub showCookie
{
my $chip;
my @chips;
my $singlechip;
debug("Cookie Contents Follow: ",2,__LINE__);
foreach $chip (%::cookie)
{
# Handle arrays
if ($chip=~/&/)
{
@chips=splitCookie($chip);
foreach $singlechip (@chips)
{
debug(" --> [$singlechip]",2,__LINE__);
}
}
if ($::cookie{$chip})
{
debug("[$chip] = [$::cookie{$chip}]",2,__LINE__);
}
}
debug("END OF COOKIE",2,__LINE__);
}
##########################################################################
=head3 genThumb()
$status=genThumb($myobject,$image_thumb,$mode);
$status - 0 = Success, 1 = Failure
$myobject - The full file system path to the object to generate a thumbnail for
$image_thumb - The full file system path to the thumbnail to create for this image
$mode - 0 = Generate thumbnails for pictures; 1 = Resize pictures on upload; 2 = Resize pictures on upload by file size (not dimensions)
Generates a thumbnail for $object, according to the current rules for thumbnails. This subroutine requires ImageMagick to be installed in order to work.
=cut
sub genThumb
{
my $myobject=shift;
my $image_thumb=shift;
my $mode=shift;
my $system_call;
my $output;
my $retcode;
my $count;
my $target_filesize=$::pic_resize;
my $height;
my $width;
my $resize_dims;
debug("Entering subroutine: genThumb($myobject,$image_thumb,$mode)",4,__LINE__);
# Imagemagick is not installed
if (!$::imagemagick && !$::perl_gd)
{
debug("Neither ImageMagick nor GD are installed",4,__LINE__);
return(1);
}
# File is not an image
if (isAPhotoOrJp2($myobject) ne 1)
{
debug("$myobject is not a photo",4,__LINE__);
return(1);
}
# Copy down upload resize dimensions
$resize_dims=$::pic_resize;
# Resizing by file size
if ($mode eq 2)
{
my $filesize;
my $jig;
my $resizefacator;
$target_filesize=~s/(\d+)k$/$1/gi;
debug("Target File Size: $target_filesize",3,__LINE__);
# Check file size
($jig,$jig,$jig,$jig,$jig,$jig,$jig,$filesize,$jig,$jig,$jig,$jig,$jig)=stat($myobject);
debug("$myobject file size: $filesize",3,__LINE__);
if ($filesize gt ($target_filesize*1024))
{
$resizefacator=($target_filesize*1024)/$filesize;
# Average dimension reduction
# $resizefacator=($resizefacator+1)/2;
debug("Resize Factor: $resizefacator",3,__LINE__);
# Don't enlarge images
if ($resizefacator lt 1)
{
# Check image dimensions
($height,$width)=getPhotoDimensions($myobject);
debug("$myobject dimensions (original): $width x $height",3,__LINE__);
$height=int($height*$resizefacator);
$width=int($width*$resizefacator);
$resize_dims=$width."x".$height;
debug("$myobject dimensions (new): $width x $height",3,__LINE__);
}
else
{
return(0);
}
}
}
# Generate thumbnail using ImageMagick
if ($::imagemagick)
{
$system_call="\"$::imagemagick/convert\" ";
if ($::thumb_quality)
{
$system_call.="-quality $::thumb_quality ";
}
# Add size parm per ImageMagick man page to reduce processing
$system_call.="-size ";
if ($mode)
{
$system_call.="$resize_dims";
}
else
{
if ($::thumb_width)
{
$system_call.=$::thumb_width;
}
if ($::thumb_width || $::thumb_height)
{
$system_call.="x";
}
if ($::thumb_height)
{
$system_call.=$::thumb_height;
}
}
if ($mode)
{
# Some older ImageMagick installs don't know "resize" so use "scale" instead
# $system_call.=" -scale ";
$system_call.=" -resize ";
}
else
{
# Likewise, ImageMagick 6+ knows how to do "thumbnail" so use that instead
$system_call.=" -thumbnail ";
}
if ($mode)
{
$system_call.="$resize_dims";
}
else
{
if ($::thumb_width)
{
$system_call.=$::thumb_width;
}
if ($::thumb_width || $::thumb_height)
{
$system_call.="x";
}
if ($::thumb_height)
{
$system_call.=$::thumb_height;
}
}
# limit thumbnails to 256 colors
if (!$mode)
{
# Commented out because it seems to have no effect
# $system_call.=" -depth 8";
# call -type Pallete because -colors 256 gives segmentation faults in Imagemagick when type already is Grayscale, Pallete or Bilevel
$system_call.=" -type Palette";
}
$system_call.=" \"$myobject\" \"$image_thumb\"";
# Resize into desired quality and dimensions
debug("IMAGEMAGICK: $system_call",2,__LINE__);
# system("$system_call");
$output=`$system_call 2>&1`;
debug("IMAGEMAGICK RETURNED: $output",2,__LINE__);
# Add shadow borders, if configured to do so
if (!$mode && $::shadow_borders)
{
$system_call="\"$::imagemagick/convert\" ";
$system_call.=" \"$image_thumb\"";
$system_call.=" -threshold 100% +matte - | ";
$system_call.="\"$::imagemagick/convert\" ";
$system_call.="- -bordercolor ";
if ($::shadow_background)
{
$system_call.="\"$::shadow_background\"";
}
else
{
$system_call.="white";
}
$system_call.=" -border 20x20 -gaussian 0x3 -shave 15x15 - | \"$::imagemagick/composite\" -gravity northwest";
$system_call.=" \"$image_thumb\"";
$system_call.=" -";
$system_call.=" \"$image_thumb\"";
# Add drop shadow to thumbnail
debug("IMAGEMAGICK: $system_call",2,__LINE__);
# system("$system_call");
$output.=`$system_call 2>&1`;
debug("IMAGEMAGICK RETURNED: $output",2,__LINE__);
if ($::shadow_borders eq 2)
{
$system_call="\"$::imagemagick/convert\" ";
$system_call.=" \"$myobject\"";
$system_call.=" -threshold 100% +matte - | ";
$system_call.="\"$::imagemagick/convert\" ";
$system_call.="- -bordercolor ";
if ($::shadow_background)
{
$system_call.="\"$::shadow_background\"";
}
else
{
$system_call.="white";
}
$system_call.=" -border 40x40 -gaussian 0x3 -shave 30x30 - | \"$::imagemagick/composite\: -gravity northwest";
$system_call.=" \"$myobject\"";
$system_call.=" -";
$system_call.=" \"$myobject\"";
# Add drop shadow to original
debug("IMAGEMAGICK: $system_call",2,__LINE__);
# system("$system_call");
$output.=`$system_call 2>&1`;
debug("IMAGEMAGICK RETURNED: $output",2,__LINE__);
}
}
if ($output)
{
print "$::S{214} $output
";
}
$retcode=1;
# Keep checking for thumbnail, for 2 seconds
for($count=0;$count ge 20;$count++)
{
if (!$retcode)
{
next;
}
sleep(.1);
if (-r $image_thumb)
{
$retcode=0;
}
}
}
# Generate thumbnail using GD
if ($::perl_gd)
{
# Many thanks for daniel.hofverberg@telia.com for the GD thumbnail code!
debug("Using Perl GD to create thumbnail...",2,__LINE__);
eval("use GD;");
if ($@!~/^Can't locate/)
{
GD::Image->trueColor(1); # 1 = Truecolor, 0 = 256 colors
my $new_height=$::thumb_height;
my $new_width=$::thumb_width;
# Create new image
my $srcimage = GD::Image->newFromJpeg($myobject);
# For creating thumbnails from PNG files, use newFromPng instead
# (works exactly the same way)
if (!$srcimage)
{
debug("Could not newFromJpeg for $myobject (probably not a jpeg).",2,__LINE__);
}
else
{
# Get original dimentions
my ($srcW,$srcH) = $srcimage->getBounds();
debug("Original dimensions: $srcW x $srcH",4,__LINE__);
# Handle situations where only 1 dimension is provided
if ($new_height && !$new_width && $srcH)
{
$new_width=int(($new_height/$srcH)*$srcW);
}
if ($new_width && !$new_height && $srcW)
{
$new_height=int(($new_width/$srcW)*$srcH);
}
debug("Resize dimensions: $new_width x $new_height",4,__LINE__);
debug("Config'd thumbnail dimensions: $$::thumb_width x $::thumb_height",4,__LINE__);
# Create thumbnail image
my $newimage = new GD::Image($new_width,$new_height);
# Resize original into thumbnail
$newimage->copyResampled($srcimage,0,0,0,0,$new_width,$new_height,$srcW,$srcH);
debug("Created newimage ($new_width x $new_height)",4,__LINE__);
# Write out thumbnail file
open(GDFILE, ">$image_thumb") || error(__LINE__,"not_writable","$image_thumb");
debug("Opened $image_thumb",4,__LINE__);
binmode(GDFILE);
if ($newimage)
{
debug("Creating as JPEG, quality $::thumb_quality.",4,__LINE__);
print GDFILE $newimage->jpeg($::thumb_quality);
debug("JPEG created and written.",4,__LINE__);
}
debug("Wrote Image",4,__LINE__);
close(GDFILE);
debug("Closed $image_thumb",4,__LINE__);
}
}
else
{
debug("Could not use GD: ($@) $!",4,__LINE__);
$::warning.="$@: $!";
}
}
debug("Leaving subroutine: genThumb($myobject,$image_thumb,$mode)",4,__LINE__);
return($retcode);
}
##########################################################################
=head3 showBreadCrumbs()
$breadcrumbs=showBreadCrumbs();
$breadcrumbs - The HTML for the breadcrumb trail.
Builds an HTML "breadcrumb" trail so the user can navigate upwards in their album.
$::bread_style defines the format to be used:
0 = Use folder heirarchy
1 = use » single » line » breadcrumbs
=cut
sub showBreadCrumbs
{
my @slices;
my $temp;
my $lastslice;
my $count;
my $indent=0;
my $slice;
my $fullslice;
my $first=1;
my $breadcrumbs;
debug("Entering subroutine: showBreadCrumbs()",4,__LINE__);
if ($::album)
{
$slice=$::album;
}
if ($::photo)
{
$slice=$::photo;
}
$slice=~s/^$::album_dir(.*)/$1/;
@slices=split("/",$slice);
$count=scalar(@slices);
$count--;
debug("There are $count levels in this breadcrumb path.",2,__LINE__);
if (($breadcrumbs || $::album eq $::album_dir) && !$::create_html_flag)
{
return($breadcrumbs);
}
$breadcrumbs="";
openDescfile("$::album_dir/");
getDescription($::rootalbumname);
if (!$::bread_style)
{
$breadcrumbs.=" ";
}
if (!$::shortdesc)
{
$::shortdesc="$::S{87}";
}
$breadcrumbs.="$::shortdesc";
$breadcrumbs.="\n";
foreach $slice (@slices)
{
# Are we on the last "slice" and is it a photo?
my $lastphoto=($::photo && isAPhotoOrJp2($slice));
if (!$slice)
{
next;
}
$indent++;
if ($lastphoto)
{
openDescfile("$::album_dir/$lastslice/");
}
else
{
openDescfile("$::album_dir/$fullslice/");
}
$::shortdesc="";
getDescription($slice);
if (!$::bread_style)
{
$breadcrumbs.=" ";
# Indent sub albums
$temp=$indent;
while ($temp)
{
$breadcrumbs.=$::S{232};
$temp--;
}
}
else
{
$breadcrumbs.="$::S{276} ";
}
if ($first)
{
$first=0;
}
else
{
$fullslice.="/";
}
$fullslice.=$slice;
debug("\$slice=$slice",4,__LINE__);
debug("\$fullslice=$fullslice",4,__LINE__);
$breadcrumbs.="";
if (!$::shortdesc)
{
$::shortdesc=$slice;
}
if ($slice eq $::recent_upload_album)
{
$::shortdesc="$::recent_uploads $::S{195}";
}
if (!$::bread_style)
{
$breadcrumbs.=" ";
}
$breadcrumbs.="$::shortdesc\n";
$lastslice=$fullslice;
$count--;
}
debug("Leaving subroutine: showBreadCrumbs()",4,__LINE__);
return($breadcrumbs);
}
##########################################################################
=head3 shroudPic()
$imgcode=shroudPic($image);
$imgcode - The actual content of the image, to display
$image - The full file path to the image to display back
Displays the image pointed to by $image, even if it is not under the web root.
=cut
sub shroudPic
{
my $image=shift;
my $imgcode="";
my $ext=$image;
my $buf;
my $err=0;
my $referer=$::albumprog;
my $env_referer=$ENV{'HTTP_REFERER'};
my $convertflag=0;
my $ext2="";
debug("Entering subroutine: shroudPic($image)",4,__LINE__);
debug("Referer is: $referer",2,__LINE__);
debug("HTTP_REFERER is: $env_referer",2,__LINE__);
if ($image eq "random" || $image eq "randthumb")
{
# Get random pic
require $::recent_module;
$image=randomizer();
debug("IMAGE: $image",2,__LINE__);
# Just do thumbnails
if ($mode ne "randthumb")
{
if (isAJp2($image))
{
$ext2="jp2";
if(!$::temp_loc)
{
$::temp_loc=$::album_dir;
}
if ($::imagemagick)
{
$convertflag=convertImg("$::album_dir/$image","jp2");
$image=$::temp_loc."/converted.jpg";
}
else
{
print "Content-Type: text/html\n\n";
debug("ImageMagick not Installed - Could not convert $image",2,__LINE__);
print "ImageMagick not Installed - Could not convert $image";
print "Can not display random JPEG 2000 image. Please use the following URL: ";
print "$::albumprog";
exit(1);
}
}
}
# Bypass valid referer check
$env_referer=$referer;
}
# Check for valid referer
if ($env_referer!~/^$referer/i || !$env_referer)
{
print "Content-Type: text/html\n\n";
debug("Bad Referer: $env_referer",2,__LINE__);
print "You are not permitted to view this image. Please use the following URL: ";
print "$::albumprog";
exit(1);
}
# Get extension
$ext=$image;
$ext=~s/.*\.(.*)/$1/;
$ext="\L$ext";
if ($ext eq "jpg")
{
$ext="jpeg";
}
# Special hack for /stuff/image.gif/../morestuff --> /morestuff
if ($image=~/$ext.*$ext/)
{
$image=~s/(.*)\/.*$ext\/\.\.(\/.*$ext)/$1$2/;
}
# Strip funny stuff off image link
#$image=~s/[^a-z0-9\.\_\-\\\/:] ,//gi;
# Check for relative paths
if ($image=~/^\\*\./)
{
$err=1;
}
if ($image=~/^\/*\./)
{
$err=1;
}
# Remove special chars
$image=~s/[|><]//g;
if ($err)
{
exit(1);
}
if (!$ext2)
{
$image="$::album_dir/$image";
}
debug("Displaying shrouded image: $image",2,__LINE__);
# Only show the image if it exists
# if (-e $image && isAPhotoOrJp2($image))
if (-e $image)
{
$imgcode="Content-Type: image/$ext\n\n";
open(IMG,"< $image");
binmode(IMG);
binmode(STDOUT);
# Read next 1024 bytes
while(sysread(IMG, $buf, 1024))
{
$imgcode.=$buf;
}
close(IMG);
}
else
{
debug("PROBLEM! Could not open $image",4,__LINE__);
# for debugging only
$imgcode="Content-Type: text/html\n\n";
$imgcode.="PROBLEM! Could not open $image, it does not exist.";
$imgcode.=" Please use the following URL: ";
$imgcode.="$::albumprog";
# exit(1);
}
debug("\$imgcode=[$imgcode]",4,__LINE__);
debug("Leaving subroutine: shroudPic($image)",4,__LINE__);
return($imgcode);
}
##########################################################################
=head3 showObject()
$html=showObject($myobject,$mode,$uploaduser,$uploadtime);
$html - The object, as seen in "album view," including thumbnail, ratings, etc. Formatted in HTML.
$myobject - The path to the object (relative to $::album_dir) to display.
$mode - 0 = Display object normally; 1 = Display object for Recent Uploads; 2 = Display for Popular List
$uploaduser - Username that uploaded this file (recent uploads only)
$uploadtime - Time/date that the file was uploaded (recent uploads only)
Displays $object using the current settings of the album.
=cut
sub showObject
{
my $myobject=shift;
my $mode=shift;
my $uploaduser=shift;
my $uploadtime=shift;
my $object_html="";
my $temp;
my $path;
my $albumtemp;
my $middletemp;
my $filetemp;
my $ssitemp;
my $objecttype;
my $classtype;
my $auto_size=0;
my $g_HTML_string="";
my $height=0;
my $width=0;
debug("Entering subroutine: showObject($myobject,$mode);",4,__LINE__);
# Save off vars
$albumtemp=$::album;
$middletemp=$::middle;
# find album, path for permission check
# Is it a photo, movie or an album?
if (-d "$::album_dir/$myobject")
{
$objecttype="album";
}
$::album=$myobject;
$::album=~s/(.*)\/(.*)/$1/;
$path=$2;
# Clear middle (album) if it's bogus
if ($::album eq $myobject)
{
$::album="";
}
$::middle=$::album;
# Set path if it's empty
if (!$path)
{
$path=$myobject;
}
if ($objecttype eq "album")
{
$::album="$::album_dir/$myobject";
$::album=~s/(.*)\/.*/$1/;
$path=$::middle;
$::middle=~s/(.*)\/.*/$1/;
if ($path eq $::middle)
{
$::middle="";
}
$path=$myobject;
$path=~s/.*\/(.*)/$1/;
}
else
{
$::album="$::album_dir/$::album";
}
debug("\$myobject = $myobject",3,__LINE__);
debug("\$::album = $::album",3,__LINE__);
debug("\$path = $path",3,__LINE__);
debug("\$::middle = $::middle",3,__LINE__);
if(!isViewable($::album,$path,1))
{
# restore vars
$::album=$albumtemp;
$::middle=$middletemp;
return;
}
# Change all \'s to /'s
$myobject=~s/\\/\//g;
# If we were passed an object, and is readable, and if it still points to a file which isn't a thumbnail, display it
if ($myobject && -r "$::album_dir/$myobject" && $myobject!~/$::thumbprefix/i)
{
debug("Displaying object: $myobject",3,__LINE__);
# Handle links
if (isAPhotoOrJp2($myobject) eq 2)
{
$myobject=getLinkURL("$::album_dir/$myobject");
}
# Open table
if ($mode)
{
$object_html.='
';
}
# For "regular" photos, view in $::columns colums
# if (!$mode)
# {
# $object_html.="
\n";
# }
# else
# {
if ($::ssi)
{
# Add slide show randomizer
if ($::randompic && $::slide_timer)
{
$object_html="\n";
$object_html.="\n";
$object_html.="\n";
}
if ($::ssi eq 2)
{
$object_html="\n";
$object_html.="\n";
}
$object_html.="
\n";
}
elsif ($mode eq 1)
{
$object_html.="
\n";
}
elsif ($mode eq 2)
{
$object_html.="
\n";
}
# }
# Is it a photo, movie or an album?
if (-d "$::album_dir/$myobject")
{
$objecttype="album";
}
elsif (isAMovie($myobject))
{
$objecttype="movie";
}
else
{
$objecttype="photo";
}
if (($::photo_width eq "auto" || $::photo_height eq "auto") && (!$::imagemagick))
{
$::photo_width=$::small_width;
$::photo_height=$::small_height;
}
if (($::photo_width eq "auto" || $::photo_height eq "auto") && isAPhotoOrJp2($myobject) && $::ssi eq 2)
{
$auto_size=1;
debug("Auto size = 1",4,__LINE__);
# jscript for window sizing
$object_html.=<
resize();
HTML
}
# Restore vars
$::file=$filetemp;
# For SSI, don't display all the "fluff"
if (!$::ssi)
{
# Get description for this photo
openDescfile("$::album/");
getDescription($path);
close(DESC);
# Set title to filename, if no title was found
if (!$::shortdesc)
{
$::shortdesc=$path;
}
# Recent Uploads
if ($mode)
{
my $photodesc=$::shortdesc;
my $albumdir="$::album_dir/$::middle";
# Get album description
$albumdir=~s/(.*)\/(.*)/$1/;
openDescfile("$albumdir/");
getDescription("$2");
close(DESC);
# Set to album (directory) name if no description
if (!$::shortdesc)
{
my $totaltemp=$::middle;
$totaltemp=~s/.*\/(.*)/$1/;
$::shortdesc=$totaltemp;
}
$object_html.="";
$object_html.="
\n";
# Table it
$object_html.="
";
if ($mode eq 1)
{
$object_html.="
\n";
}
elsif ($mode eq 2)
{
$object_html.="
\n";
}
$object_html.="$photodesc \n";
# Uploaded by
if ($mode eq 1)
{
$object_html.="$::S{79} $uploaduser$::S{226} \n";
}
# Uploaded into
if (!(($::popular_flag eq 2) && ($mode eq 2)))
{
$object_html.="$::S{196} $::shortdesc \n";
}
$object_html.="$uploadtime\n";
}
else
# Display object info for "normal" viewing
{
# Display description
if ($::descloc!=2)
{
if ($::descloc eq 1)
{
$object_html.=" ";
}
else
{
$object_html.=" ";
}
$object_html.="$::shortdesc";
# Is there a long description too?
if ($::founddesc && $::longdesc)
{
$object_html.=" $::S{120}";
}
}
$object_html.="\n";
# Increment counter
$::searchresults++;
}
}
# Close off tag for randompic
if ($::randompic)
{
$object_html.="\n";
}
if ($::ssi || $mode)
{
$object_html.="
\n";
}
# if (!$::ssi)
# {
# $object_html.=" \n";
# }
# Close table
if ($mode)
{
$object_html.="
\n";
}
# Close page
if ($::ssi eq 2)
{
$object_html.="\n";
}
}
elsif (!-r "$::album_dir/$myobject")
{
debug("Warning: $::album_dir/$myobject is not readable",4,__LINE__);
}
# Restore vars
$::album=$albumtemp;
$::middle=$middletemp;
debug("Leaving subroutine: showObject($myobject,$mode);",4,__LINE__);
return ($object_html);
}
##########################################################################
=head3 updateComment()
$retcode=updateComment($myobject,$comment);
$retcode - Return value: 0 = Success; 1 = Failure.
$myobject - The path to the photo, relative to album_dir.
$comment - The comment to add to the photo.
Adds/Updates the comment in $myobject to be $comment. Uses jhead to actually insert the comments into the photo.
=cut
sub updateComment
{
my $retcode;
my $output;
my $system_call;
my $myobject=shift;
my $comment=shift;
my $tempname;
debug("Entering subroutine: updateComment($myobject,$comment);",4,__LINE__);
$myobject="$::album_dir/$myobject";
# Temp filename
$tempname="$myobject.$$";
# Check for base requirements
if (!$::jhead || !$comment || !-e $myobject || !$::jhead_comments)
{
debug("Not happening: Jhead: [$::jhead] Comment: [$comment] MyObject: [$myobject] JheadComments: [$::jhead_comments]",4,__LINE__);
debug("Leaving subroutine: updateComment($myobject,$comment);",4,__LINE__);
return(1);
}
# Strip out HTML from the comments
$comment=~s/<([^>]|\n)*>//g;
# Write out comments
open (FILE,">$tempname") || return(1);
print FILE "$comment";
close (FILE);
$system_call="\"$::jhead\" -ci \"$tempname\" \"$myobject\"";
# Add comments
debug("JHEAD: $system_call",2,__LINE__);
$output=`$system_call 2>&1`;
debug("JHEAD RETURNED: $output",2,__LINE__);
# Output is normal for jhead
# if ($output)
# {
# print "$::S{214} $output
";
# $retcode=1;
# }
# Clean up
unlink($tempname);
debug("Leaving subroutine: updateComment($myobject,$comment);",4,__LINE__);
return($retcode);
}
##########################################################################
=head3 detectBrowser()
$type=detectBrowser();
$type - The browser type: 0 = IE variant; 1 = Mozilla (Opera, Netscape, Phoenix, etc) variant
Detects the browser type, and returns the appropriate value
=cut
sub detectBrowser
{
my $type=$ENV{HTTP_USER_AGENT};
debug("Entering subroutine: detectBrowser();",4,__LINE__);
debug("Browser is: $type",2,__LINE__);
if ($type=~/MSIE/)
{
$type=0;
}
else
{
$type=1;
}
debug("Returning: $type",2,__LINE__);
debug("Leaving subroutine: detectBrowser();",4,__LINE__);
return ($type);
}
##########################################################################
=head3 printHTMLHeader()
printHTMLHeader();
Prints the HTML header if it hasn't already been printed.
=cut
sub printHTMLHeader
{
if (!$::header_printed)
{
require $::display_module;
display($::html_header);
$::header_printed=1;
debug("\$::header_printed is now set to 1",4,__LINE__);
}
}
##########################################################################
=head3 DBICheck()
$dbi_fail=DBICheck();
$dbi_fail - 0 = DBI package was found, 1 = DBI package not found
Checks to see if the DBI Perl package was installed and returns a status accordingly.
=cut
sub DBICheck
{
my $dbi_fail;
my $eval_error;
if ($::authentication_type eq 4)
{
# Check for DBI package, include if present
my $pkg="DBI";
my $method="available_drivers";
eval("use ".$pkg.";\n".$pkg."::".$method."(1)");
$eval_error=$@;
if ($eval_error)
{
$::warning.="$::S{26} $eval_error";
}
debug("DBI Fail: [$eval_error]",2,__LINE__);
if ($eval_error=~/Can't/i || $eval_error=~/no database driver/i)
{
$dbi_fail=1;
}
# If you're having "no database driver specified and DBI_DSN env var not set" errors, uncomment the line below:
# $dbi_fail=1;
}
else
{
$dbi_fail=1;
}
debug("DBI Fail: [$dbi_fail]",2,__LINE__);
return($dbi_fail);
}
##########################################################################
=head3 upgradeCfg()
upgradeCfg();
Upgrade the album.pl configuration, if possible.
=cut
sub upgradeCfg
{
use Cwd;
# Download vars
my $oldCFG=$form->param('oldconfig');
my $newCFG=$form->param('newconfig');
my $updatedCFG=$oldCFG.".new";
my $adminCode=$form->param('adminCode');
my $fullpath;
#################################
# Open and read in the old Parms
# keep all the old variables and
# values into an array .
#################################
printHTMLHeader();
print<$::S{95} $::S{319}
HTML
print printHeader();
print<$::S{95} $::S{319}
HTML
$fullpath=cwd;
# Append trailing slash if there wasn't one
if ($fullpath!~/\/$/)
{
$fullpath.="/";
}
# Move album.cfg.new to album.cfg
if ($form->param('actuallyupgradecfg'))
{
use File::Copy;
if (!copy($oldCFG.".new",$oldCFG))
{
error(__LINE__,"not_writable","Could not copy $oldCFG.new to $oldCFG: $!");
}
else
{
print<$S{335}
$S{334}
$S{336} $::S{170}
HTML
}
print showFooter(0);
exit(0);
}
if (!$oldCFG)
{
print<
$S{320} $S{321} $fullpath$S{226}
$S{327}
HTML
print showFooter(0);
exit(0);
}
checkFile($oldCFG);
checkFile($newCFG);
checkFile($updatedCFG);
$oldCFG=$fullpath.$oldCFG;
$newCFG=$fullpath.$newCFG;
$updatedCFG=$fullpath.$updatedCFG;
if ($::admin ne $adminCode)
{
print <
HTML
debug("$$::admin/$adminCode",3,__LINE__);
exit(1);
}
print<
HTML
open(OLDCFG, "$oldCFG") or error(__LINE__,"not_readable","Could not open file: $oldCFG ($!)");
while ($line=)
{
$line=~s/[
\r\n]//g;
chomp($line);
# Skip any line that starts with a comment
# or is empty
if ($line=~/^$/ || $line=~/^#/)
{
##################################################
# Usefull to output to HTML for debugging
##################################################
debug("$line",3,__LINE__);
}
else
{
##################################################
# If this is a parm, load the parm name/value
# pair into an array.
##################################################
#
($cfgParmName, $cfgParmValue) = split(/=/,$line);
debug("[$cfgParmName - $cfgParmValue]",3,__LINE__);
$config{$cfgParmName} = $cfgParmValue;
debug("The parm is " . $cfgParmName . " = " . $cfgParmValue."",3,__LINE__);
}
}
close(OLDCFG); # Close the file";
debug("Done loading $oldCFG",3,__LINE__);
##################################################
# Now cycle thru the new file and look for common
# Parms. If there is a match , replace the default
# value with the value in memory
##################################################
#
print <
$S{329}
$S{330}
$S{331}
HTML
open(NEWCFG, "$newCFG") or error(__LINE__,"not_readable","Could not open file: $newCFG ($!)");
open(NEWCFGOUT, ">$updatedCFG") or error(__LINE__,"not_writable","Could not open file: $updatedCFG ($!)");
while ( $line = )
{
$line=~s/[
\r\n]//g;
chomp($line);
##################################################
# Skip any line that does not have a = in it
##################################################
#
if ($line=~/^$/ || $line=~/^#/)
{
print NEWCFGOUT "$line\n";
}
else
{
##################################################
# If this is a Parm Line (=) and the
# parm corresponds to a parm from the Old file
# then print the OldParmValue
# Otherwise, just keep the new stuff
##################################################
#
($cfgParmName, $cfgParmValue) = split(/=/,$line);
$colour="";
if (!defined $config{$cfgParmName})
{
$colour="green";
$config{$cfgParmName}="";
}
# Update the version from the "clean" file
if ($cfgParmName=~/^cfgver$/)
{
$colour="red";
$config{$cfgParmName}=$cfgParmValue;
}
if (($config{$cfgParmName} ne $cfgParmValue))
{
$colour="red";
print NEWCFGOUT "$cfgParmName=$config{$cfgParmName}\n";
}
else
{
print NEWCFGOUT "$line\n";
}
print "
HTML
print showFooter(0);
exit(0);
}
##########################################################################
=head3 checkFile()
checkFile($filename);
$filename - File name to check.
Confirms that the file name does not contain spaces or slashes. Used to keep upgradeCfg filenames clean.
=cut
sub checkFile
{
my $filename=shift;
if ($filename=~/[\/\\ @]/ || $filename=~/%20/ || $filename=~/%2f/ || $filename=~/%5c/)
{
error(__LINE__,"sanity","Invalid filename ($filename)...");
}
}
##########################################################################
=head3 isAJp2()
isAJp2($photo_name);
$photo_name - name of picture file
Returns 1 if the filename passed in is that of a valid "JPEG 2000 photo", 2 if it is a link, 0 otherwise.
=cut
sub isAJp2
{
my $flag=0;
my $photo_name=shift;
my $jp2ext;
debug("Checking to see if $photo_name is a JPEG 2000...",4,__LINE__);
# *** I may want to add a test to see if $photo_name is a readable file as well, but that might cause problems for relative paths, if they're used
if ($photo_name=~/^$::thumbprefix/i)
{
$flag=0;
}
else
{
foreach $jp2ext (@::jp2exts)
{
if ($photo_name=~/.*\.$jp2ext$/i)
{
$flag=1;
debug("Yep, it's a JPEG 2000.",4,__LINE__);
}
}
# Check for link files
if ($photo_name=~/.*\.$::linkext$/i)
{
$flag=2;
debug("Yep, it's a photo (actually, a link to a photo).",4,__LINE__);
}}
return($flag);
}
##########################################################################
=head3 isViewable() isViewable($viewdir,$viewfile,$mode);
$viewdir - directory where we are checking permissions
$viewfile - file on which to ckeck permissions
Checks the user level needed to view this an album/photo/movie against permissions of user who is logged in.
If building static pages, all objects are viewable.
=cut
sub isViewable
{
my $flag=0;
my $viewdir=shift;
my $viewfile=shift;
my $mode=shift;
my $pic_lev;
my $user_lev;
debug("Entering subroutine isViewable for $viewdir/$viewfile...\$mode=$mode",4,__LINE__);
if ($create_html_flag ge 1 || $authentication_type lt 1 || isAdmin() eq 1)
{
$flag=1;
return $flag;
}
else
{
close(INFO);
if($mode eq "1")
{
$infofilename=$viewdir."/".$::descname;
}
elsif ($mode eq "2")
{
$infofilename=$::album_dir."/".$viewdir.$::descname;
}
else
{
$infofilename=$::album_dir."/".$viewdir."/".$::descname;
}
debug("Looking for InfoFile: [$infofilename]
",3,__LINE__);
if (-r $infofilename)
{
$::useinfo=1;
open(INFO,"$infofilename");
debug("Using InfoFile: [$infofilename]
",3,__LINE__);
}
# Get Viewlevel
getViewlevel($viewfile);
close(INFO);
if (!$::info_level || $::info_level eq "anyone" || $::info_level eq 0)
{
$flag=1;
debug("Anyone has permission $flag.",4,__LINE__);
}
else
{
if (!$::authenticated)
{
$flag="";
debug("No one has permission, not logged in. flag is \"$flag\" ",4,__LINE__);
}
else
{
if ($::mem_level eq 0 || $::mem_level eq 1)
{
$user_lev=1;
}
else
{
$user_lev=2;
}
if ($::info_level eq "Family" || $::info_level eq 1)
{
$pic_lev=1;
}
elsif ($::info_level eq "Friend" || $::info_level eq 2)
{
$pic_lev=2;
}
elsif ($::info_level eq "owner" || $::info_level eq 3)
{
$pic_lev=3;
}
if (($user_lev ge $pic_lev) || ($pic_lev eq 3 && $::owner eq $::loggedin))
{
$flag=1;
debug("Permission granted on pic_lev $pic_lev with user_lev $user_lev flag $flag.",4,__LINE__);
}
}
}
return($flag);
}
debug("Leaving subroutine isViewable for $viewdir/$viewfile...\$mode=$mode...\$flag=$flag",4,__LINE__);
}
##########################################################################
=head3 getViewlevel()
getViewlevel($leveltoget);
$leveltoget - Photo or album to get view level for
Retrieves the view permission level in $::info_level (if present).
=cut
sub getViewlevel
{
my $leveltoget=shift;
my $infoline;
my $prevline;
my $filename;
my $temp_file;
my $leveltosearch;
my $owner;
my $foundinfo;
debug("Entering subroutine: getViewlevel($leveltoget)",4,__LINE__);
debug("Getting View permission level for [$leveltoget] --> \$::useinfo=[$::useinfo]",3,__LINE__);
# Clear variables, in case they're being re-used
$::owner=$::info_level="";
# Haven't found a description yet.
$foundinfo=0;
# See if description exists
if ($::useinfo && $leveltoget)
{
# Clear $leveltoget if it was just set as a placeholder
if ($leveltoget eq "./")
{
$leveltoget="";
}
$leveltosearch=quotemeta($leveltoget);
# Rewind description file
seek(INFO,0,0);
# Reset for search
$prevline=$::desc_delim;
while ($infoline=)
{
chomp($infoline);
# Block codes
$infoline=~s/####/#\/###/sg;
# Found the description we're looking for (not via the search screen)
if ($infoline=~/^$leveltosearch$/i || $infoline=~/^$leveltosearch:.*$/i)
{
# Pull out owner and view level
($temp_file,$::owner,$::info_level)=split(":",$infoline);
debug("$::owner owns $infoline",2,__LINE__);
debug("object level is $::info_level",2,__LINE__);
$foundinfo=1;
return();
}
}
if (!$foundinfo)
{
$::info_level="anyone";
debug("No view level found.",3,__LINE__);
}
}
debug("Leaving subroutine: getViewlevel($leveltoget)",4,__LINE__);
}
##########################################################################
=head3 convertImg()
$status=convertImg($myobject,$filetype);
$status - 0 = Success, 1 = Failure
$myobject - The full file system path to the object to be converted from one file type to jpg
$filetype - (jp2, tif, etc.) = The input image file type
Converts image files, using ImageMagick from input image file type to jpg. Output is always "$::temp_loc/converted.jpg";
=cut
sub convertImg
{
my $myobject=shift;
my $filetype=shift;
my $system_call;
my $output;
my $retcode;
my $count;
debug("Entering subroutine: convertImg($myobject,$filetype)",4,__LINE__);
if (-e "$::temp_loc/converted.jpg")
{
unlink("$::temp_loc/converted.jpg")
}
$system_call="\"$::imagemagick/convert\" ";
$system_call.="\"$filetype\:";
$system_call.="$myobject\" \"$::temp_loc/converted.jpg\"";
debug("IMAGEMAGICK: $system_call",2,__LINE__);
$output=`$system_call 2>&1`;
debug("IMAGEMAGICK RETURNED: $output",2,__LINE__);
if ($output)
{
print "$::S{214} $output
";
}
$retcode=1;
# Keep checking for conversion, for 15 seconds
for($count=0;$count ge 150;$count++)
{
if (!$retcode)
{
next;
}
sleep(.1);
if (-r $::temp_loc/converted.jpg)
{
$retcode=0;
}
}
if ($output)
{
$retcode=$output;
}
debug("Leaving subroutine: convertImg($myobject,$filetype)",4,__LINE__);
return($retcode);
}
##########################################################################
=head3 isAPhotoOrJp2()
isAPhotoOrJp2($photo_name);
$photo_name - name of picture file
Returns 1 if the filename passed in is that of a valid photo or "JPEG 2000 photo", 2 if it is a link, 0 otherwise.
=cut
sub isAPhotoOrJp2
{
my $flag=0;
my $photo_name=shift;
$flag=isAPhoto($photo_name);
if (!$flag)
{
$flag=isAJp2($photo_name);
}
return($flag);
}
##########################################################################
=head3 translateLevel()
translateLevel($item_level,$mode);
$item_level - The string passed as a parameter when choosing a view level
$mode - if 0 then translate string value to digit. If 1 then translate digit to string.
Returns the alternate representation of a photo's view level.
=cut
sub translateLevel
{
my $flag="";
my $item_level=shift;
my $mode=shift;
debug("Entering subroutine: translateLevel($item_level,$mode)",4,__LINE__);
if (!$mode)
{
if ($item_level eq $S{341})
{
$flag=0;
}
elsif ($item_level eq $S{299})
{
$flag=3;
}
}
else
{
if ($item_level eq 0 || !$item_level)
{
$flag=$S{341};
}
elsif ($item_level eq 3)
{
$flag=$S{299};
}
}
if ($::authentication_type eq 1 || $::authentication_type eq 2 || $::authentication_type eq 3 || $::authentication_type eq 4)
{
if (!$mode)
{
if ($item_level eq $S{345})
{
$flag=2;
}
}
else
{
if ($item_level eq 2)
{
$flag=$S{345};
}
}
}
if ($::authentication_type eq 2)
{
if (!$mode)
{
if ($item_level eq $S{346})
{
$flag=1;
}
}
else
{
if ($item_level eq 1)
{
$flag=$S{346};
}
}
}
if ($::authentication_type eq 5)
{
if (!$mode)
{
if ($item_level eq $S{342})
{
$flag=1;
}
elsif ($item_level eq $S{343})
{
$flag=2;
}
}
else
{
if ($item_level eq 1)
{
$flag=$S{342};
}
elsif ($item_level eq 2)
{
$flag=$S{343};
}
}
}
debug("Exiting subroutine: translateLevel. \$flag=$flag",4,__LINE__);
return($flag);
}
######################## END OF SUBROUTINES ########################
######################## END OF FILE ########################