#!/usr/local/bin/perl
# -*- mode: cperl; coding: euc-up; -*-

# ================================================================================
# global
# ================================================================================

my $UPLOAD_BASEPATH="/virtual/k2310/public_html/images";
my $IMAGEDIR_URL="http://blog.2310.net/images";
my $CMD_DEFAULT = "";
my $CMD_UPLOAD  = "upload";
my $THUMB_PREFIX = "thumb_";

# 画像の縦横のいずれかが下の値(px)を超えると作業を開始。
#  縦横いずれか長い方を下の値にするよう縮小する。
my $THUMB_SCALE_CONST = 250;


# 実行
&mainsub();


# ================================================================================
# main
# ================================================================================

use CGI;
use Image::Magick;
use strict;

sub mainsub () {
  my $query = new CGI;
  my $cmd = $query->param('cmd');

  # cmdの内容により分ける
  if ($cmd eq  $CMD_UPLOAD) {
    my $filename = saveUploadFile(\$query);
    my $thumb_filename = makeThumb($filename);
    print $query->header(-charset=>'EUC-JP');
    print $query->start_html(-lang=>'ja', -encoding=>'EUC-JP', -title=>'Upload');
    print $query->h1($thumb_filename);
  }
  else {
    &printUploadHtml(\$query);
  }
}


sub printUploadHtml () {
  my $query = ${$_[0]};

  print $query->header(-charset=>'EUC-JP');
  print $query->start_html(-lang=>'ja', -encoding=>'EUC-JP', -title=>'Upload');
  print $query->h1('画像アップロード用フォーム');
  print $query->start_form('post','./iuploader.cgi','multipart/form-data');

  ## form ##
  print $query->start_form(-method=>'post',-action=>'./iuploader.cgi',-enctype=>'multipart/form-data');
  print $query->filefield(-name=>'filename');
  print $query->br;
   print $query->submit(-value=>'送信');
  print $query->hidden(-name=>'cmd', -default=>$CMD_UPLOAD);
  print $query->endform;

  print $query->end_html;

}

sub saveUploadFile () {
  my $query = ${$_[0]};
  my $mime_type;
  my $filename = $query->upload('filename');
  my $filename_with_path = "$UPLOAD_BASEPATH/$filename";
  my $buffer;


# ファイル保存
  open (OUT, ">$filename_with_path") || return "";
  binmode (OUT);
  while(read($filename, $buffer, 1024)){
    print OUT $buffer;
  }
  if ($CGI::OS ne 'UNIX') {
    close ($filename);
  }
  close (OUT);

  return $filename;
}


sub makeThumb () {
  my $filename = $_[0];
  my $filename_with_path = "$UPLOAD_BASEPATH/$filename";

  my $thumbnail_file = "${THUMB_PREFIX}$filename";
  my $thumbnail_file_with_dir = "$UPLOAD_BASEPATH/$thumbnail_file";;

  my $img = Image::Magick->new;
  my $img_width;
  my $img_height;

  $img->Read($filename_with_path);
  $img_width  =$img->get('width');
  $img_height =$img->get('height');

  if ($img_height > $THUMB_SCALE_CONST || $img_width > $THUMB_SCALE_CONST) {
    if ($img_height > $img_width) {
      $img->Scale(width=>$THUMB_SCALE_CONST,height=>($THUMB_SCALE_CONST/$img_width)*$img_height);
    }
    else {
      $img->Scale(width=>($THUMB_SCALE_CONST/$img_height)*$img_width,height=>$THUMB_SCALE_CONST);
    }
  }

  $img->Write($thumbnail_file_with_dir);

  return $thumbnail_file;

}