############################################################################### # BizDesign ImageFolio Lite Edition 4.2 (Four-dot-Two) ############################################################################### # # ## ### VERSION : 4.2 # #### ## ## RELEASED ON : 02/15/2007 # ## ## ## LAST MODIFIED : 02/15/2007 # ########## ## # ## ### ## # ## ### ######## # ############################################################################### # Released by BizDesign, Inc. # written by Dirk Koppers and Greg Raaum of BizDesign # # Purchasing : http://imagefolio.com/purchase/ # Support : http://imagefolio.com/support/ # Phone : (214) 642-9787 # Email : sales@bizdesign.com ############################################################################### # COPYRIGHT AND LICENSE INFORMATION : # # Copyright (c) 1999-2007 BizDesign, Inc. All rights reserved. # # Selling or distributing the code for this program without prior written # consent is expressly forbidden. # # One licensed copy of the program may reside on a single server, in use by a # single domain. For each installed instance of the program, a separate # license is required. # # Licensed users may alter or modify this software, at their own risk, of # course. They may also hire others to modify their own copy of the code, as # long as the code is not transferred to or retained by the individual who is # hired (unless he/she is also a license holder). Although license-holders # may modify the code for their use, modified code may NOT be resold or # distributed. # # THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED WARRANTIES, # INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND # FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL BIZDESIGN, # INC. OR ITS CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, # SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, # PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR # BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER # IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) # ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE # POSSIBILITY OF SUCH DAMAGE. # # BizDesign, Inc. is not liable for any conduct associated with image gallery # activity, nor for any binary media posted using this program, including but # not imited to images, photographs, movies, and clipart. # # The user must assume the entire risk of using the program. Although this # program has been thoroughly tested on BizDesign's servers, BizDesign does not # warrant that it works on all servers and will not be held liable for anything, # including but not limited to, misusage, error, or loss of data. ANY # LIABILITY OF THE SELLER WILL BE LIMITED EXCLUSIVELY TO PRODUCT REPLACEMENT # OR REFUND OF PURCHASE PRICE. Use at your own risk! ############################################################################### # Do not modify below this line unless you know what you are doing. ############################################################################### # INSTRUCTIONS : # # 1. Rename this file 'serverinfo.cgi' or 'serverinfo.pl' # 2. Set the path to Perl at the top of the script # 3. Place this file in a executable directory on your server # 4. Set permissions on this file to 755 (if applicable) # 5. Call from any Web browser ############################################################################### $| = 1; #flush output &get_info; &find_module; &print_html; exit; ############################################################################### # GET INFO # Gets some information about this server ############################################################################### sub get_info { $font = 'font face="Verdana,Arial,Helvetica" size=1'; $bigfont = 'font face="Verdana,Arial,Helvetica" size=2'; # let's get the current directory path if ($0=~m#^(.*)(\\|/)#) { $currdir = $1; } else { $currdir = `pwd`; chomp $currdir; } $currdir =~ s/\\/\//ig; # determine the mail program $mail = "/usr/lib/sendmail"; $result = get_mail($mail); if (! $result) { $mail = "/usr/sbin/sendmail"; $result = get_mail($mail); if (!$result) { $mail = "/var/qmail/bin/qmail-inject"; $result = get_mail($mail); if (! $result) { $mail = "Mail Program Unknown"; } } } $perlversion = $]; # get the perl version $time=localtime; # get the time $perlloc = `whereis perl`; # get the perl location if (!$perlloc) { $perlloc = $^X; } else { $perlloc =~ s/perl: //g; $perlloc =~ s/ /
/g; } # get the environmental variables foreach $item (sort keys %ENV) { $legitem = uc $item; $legitem =~ s/_/ /g; if ($legitem eq "PATH") { $ENV{$item} =~ s/;/
\n/g; } if ($legitem eq "HTTP ACCEPT") { $ENV{$item} =~ s/, /
\n/g; } if ($legitem eq "PATHEXT") { $ENV{$item} =~ s/;/
\n/g; } $variables .= qq| <$font>| . $legitem . qq|: | . $ENV{$item} . qq| |; } } ############################################################################### # PRINT HTML # Displays the results ############################################################################### sub print_html { print qq|Content-type: text/html Server Info
$variables
<$bigfont color="#ffffff">Server Info
<$bigfont>Please Note...
<$bigfont>If you are using this program to configure paths for a Perl script configuration file, on a Windows server, you MUST substitute all instances of backslashes "\\" with forward slashes "/" in your paths. Failure to do so may result in Internal Server Errors.
<$bigfont>Miscellaneous Information...
<$font>SERVER TIME: $time
<$font>CURRENT DIRECTORY PATH: $currdir
<$font>PERL VERSION: $perlversion
<$font>PATH(S) TO PERL: $perlloc
<$font>PATH TO MAIL: $mail
<$bigfont>Installed CPAN Modules...
<$font>IMAGE::MAGICK: $im
<$font>COMPRESS::ZLIB: $cz
<$bigfont>Environmental Variables...

<$font>Copyright 2000 BizDesign, Inc. All rights reserved.
Send email to: gregraaum\@bizdesign.com

|; } ############################################################################### # FIND MAIL # helps to find the server mail program ############################################################################### sub get_mail { my $mailpath = shift (@_); if (-e "$mailpath") { return 1; } else { return 0; } } ######################################################## # Get Module ######################################################## sub get_module { /^.*\.pm$/ && /$ARGV[0]/i && push @mod, $File::Find::name; } ######################################################## # Find Module ######################################################## sub find_module { $curr_dir = `pwd`; use File::Find; find (\&get_module, grep { -r and -d } @INC); @mod = grep (!$done{$_}++, @mod); foreach $dir (sort { length $b <=> length $a } @INC) { foreach (@mod) { next if s,^\Q$dir,,; } } foreach (@mod) { s,^/(.*)\.pm$,$1,; s,/,::,g; if ($_ =~ /Image::Magick/i){ $im = qq|Installed (Needed for Picture Post Mod and Batch Thumbnail Mod)|; } elsif ($_ =~ /Compress::ZLib/i){ $cz = qq|Installed (Needed for Lightbox Mod zipping and IFC downloads)|; } } if (! $im) { $im = qq|NOT installed (Needed for Picture Post Mod and Batch Thumbnail Mod)|; } if (! $cz) { $cz = qq|NOT installed (Needed for Lightbox Mod zipping and IFC downloads)|; } }