#!/usr/bin/perl

# CGI to allow users to submit new faces via the web.
# Requires ImageMagick in the path.

use strict;

#
# Configuration.  Change these cariables to suit your installation.
#

# faces will be stored in the faces/ subdirectory relative to this path
my $file_base = "/home/ginda/public_html/chatzilla/motifs";

# plublic equivilant of $file_base, used to create urls for preview images.
my $web_base = "http://www.hacksrus.com/~ginda/chatzilla/motifs";

# place where uploaded images should be stored.  These are *not* deleted by the script.
my $tmp_path = "/home/ginda/public_html/chatzilla/tmp_faces";

# max size of final image in either direction.
my $max_extent = 48;

# maximum number of faces to allow before disabling script
my $max_users = 125;


use CGI;
use CGI::Carp qw(fatalsToBrowser);

my $p = new CGI;

print $p->header;

print <<EOM;
<HTML>
<HEAD>
<TITLE>face facts</TITLE>
</HEAD>
<BODY>

EOM
my $nick = $p->param('nick');
$nick =~ s/[^A-Za-z0-9_]//g;
$nick = lc($nick);

if($nick && $p->param('image_file')) {
    system("rm -f $file_base/$nick.png");
    my $text;
    my $base_file;
    {
        my $fh = $p->param("image_file");
        $fh =~ /(\.[^.]*)$/;
        my $ext = $1;
        $ext =~ /[^A-Za-z0-9_]/;
        $base_file = "$tmp_path/$nick$ext";
        open OUTFILE, ">$base_file" or
          die "Could not create file $base_file: $!";
        while(<$fh>) {
            print OUTFILE $_;
        }
        close OUTFILE;
    }
    my ($width, $height);
    {
        open IDENTIFY, "identify -format '\%w:\%h' $base_file|" or
          die "Could not start identify: $!";
        while(<IDENTIFY>) {
           chomp;
           ($width, $height) = split(":", $_);
        }
        close IDENTIFY;
        print "<p>Image size was $width x $height...\n";
    }

    if ($width > 1 && $height > 1) {
        if ($width > $max_extent || $height > $max_extent) {
            my $multiplier = ($width > $height) ?
              ($max_extent / $width) : ($max_extent / $height);
            $width  = int($width * $multiplier);
            $height = int($height * $multiplier);
            print "<p>Resizing to $width x $height pixels...\n";
            system("convert -scale $width" .
                   "x$height $base_file $file_base/faces/$nick.png");
        } else {
            print "<p>Image is already within size bounds...\n";
            system("convert $base_file $file_base/faces/$nick.png");
        }
        system ("chmod a+w $file_base/faces/$nick.png");
        print "<p>Remaking css files...\n";
        system("/usr/bin/perl makefaces.pl");
        print "<P>Successfully uploaded file for ``<tt>$nick</tt>''...<br>\n" .
              "<IMG SRC='$web_base/faces/$nick.png'></TD></TR>\n";
    } else {
        print "<p>No image.\n";
    }
    print "<p>Click <a href='faces.pl'>here</a> to see the list again</p>\n";
}

my @users = get_files("$file_base/faces/");
@users = sort (@users);

print <<EOM;
<h2>Add your mug...</h2>

<p><b>PLEASE DO NOT ADD YOURSELF IF YOU ARE NOT ACTUALLY A MOZNET REGULAR.  THIS
SCRIPT WILL BE DISABLED IF/WHEN IT IS ABUSED.  DO NOT POST POINTERS TO THIS PAGE
ON THE WEB, AND DO NOT GIVE THIS URL OUT TO PEOPLE WHO MIGHT DO SO.  THANK YOU
AND HAVE A GOOD DAY.</b>

<P>Please note that you only need to upload your picture for your main nick.
If you enter <CODE>IRCMonkey</CODE> as your nick, ChatZilla will use your
picture on <CODE>IRCMonkey_sleep</CODE>, <CODE>IRCMonkey_work</CODE>, etc.
No need to overload the server.</P>

<P>These pictures will be resized to have a max extent (in either direction) of
48 pixels, and will be converted to png.  You will need to crop them before you
send them in.  For best results, upload a png 48 pixels square.</P>

<P>Please try to keep to <b>actual</b> faces, phoney faces or cartoon avatars
aren't nearly as useful (or fun.)  If you'd like to make your own CSS files
with or without faces, see the
<a href="http://www.mozilla.org/projects/rt-messaging/chatzilla/style.html">Stylin' ChatZilla</a> document.
The scripts used here are available from
<a href="http://www.hacksrus.com/~ginda/chatzilla/facesrv/">http://www.hacksrus.com/~ginda/chatzilla/facesrv/</a>
<hr>

EOM

if ($#users < $max_users) {

print <<EOM;

<FORM NAME=mainform METHOD=post
 ENCTYPE=multipart/form-data>
<P>To submit a face, enter your nickname and the image file you wish to use:</P>
<P>Nickname: @{[$p->textfield(-name => "nick")]}<BR>
Image File: <INPUT TYPE=file NAME=image_file></P>
<P><INPUT TYPE=submit></P>
</FORM>

EOM

} else {
    print "<b>More than $max_users users, upload disabled</b>\n";
}

print <<EOM;

</body></html>
EOM

#
# given a directory, return an array of all the files that are in it.
#
sub get_files {
    my ($subdir) = @_;
    my (@file_array, @subdir_files);

    opendir (SUBDIR, $subdir) || die ("couldn't open directory $subdir: $!");
    @subdir_files = readdir(SUBDIR);
    closedir(SUBDIR);

    foreach (@subdir_files) {
        my $file = $_;
        if (!($file =~ /[\#~]$/) && -f "$subdir$file") {
            $file_array[$#file_array+1] = $file;
        }
    }

    return @file_array;
}
