#/*
# *  Copyright 2007 hkrn <hikarin@users.sourceforge.jp>
# *
# *  Licensed under the Apache License, Version 2.0 (the "License");
# *  you may not use this file except in compliance with the License.
# *  You may obtain a copy of the License at
# *
# *      http://www.apache.org/licenses/LICENSE-2.0
# *
# *  Unless required by applicable law or agreed to in writing, software
# *  distributed under the License is distributed on an "AS IS" BASIS,
# *  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# *  See the License for the specific language governing permissions and
# *  limitations under the License.
# */
#
# $Id: Upload.pm 363 2007-03-16 15:11:10Z hikarin $
#

package Img0ch::Upload;

use strict;
use Digest::MD5 qw();

sub new {
    my ( $iClass, $iBBS, $key ) = @_;
    my $bbs     = $iBBS->get_name();
    my $iKernel = $iBBS->get_kernel();

    my $repos_tag = $iBBS->get_repos_path('tag');
    my $iReposTag = $iKernel->get_repos($repos_tag);

    my ( undef, undef, undef, $day, $month, $year ) = localtime($key);
    $year  += 1900;
    $month += 1;
    my $repos_upload
        = $iBBS->get_repos_path( $year, $month, $day, $key, 'upload' );
    my $repos_upload_dir = $repos_upload;
    $repos_upload_dir =~ s{/upload.\w+\z}{}xms;
    if ( !-d $repos_upload_dir ) {
        require File::Path;
        File::Path::mkpath($repos_upload_dir)
            or $iKernel->throw_io_exception($repos_upload_dir);
    }

    my $iReposUpload = $iKernel->get_repos($repos_upload);
    if ( $iKernel->get_config()->get('compatible.upload') ) {
        require Img0ch::Compat::Upload;
        Img0ch::Compat::Upload::load( $iReposUpload, $iBBS, $key );
    }

    bless {
        _i0_bbs  => $iBBS,
        _count   => $iReposUpload->get_int("I:U:I.${bbs}.${key}._"),
        _dir     => $bbs,
        __dlpass => '',
        _kernel  => $iKernel,
        _key     => $key,
        _path    => $iBBS->path( 'img', $key ),
        __rmpass => '',
        _rs      => $iReposUpload,
        _tag     => $iReposTag,
        __upload => [],
        __url    => $iBBS->url( 'img', $key ),
        __path   => '',
    }, $iClass;
}

sub load {
    my ($iUpload) = @_;
    $iUpload->{_rs}->load();
    $iUpload->{_tag}->load();
    return 1;
}

sub save {
    my ($iUpload)    = @_;
    my $iReposUpload = $iUpload->{_rs};
    my $line         = $iUpload->{__upload};
    if ( !@$line ) {
        $iReposUpload->save();
        return 1;
    }

    my $iKernel = $iUpload->{_kernel};
    my $dir     = $iUpload->path();
    if ( !-d $dir ) {
        local $!;
        mkdir $dir, 0755 or $iKernel->throw_io_exception($dir);
    }

    my ( $bbs, $key ) = ( $iUpload->{_dir}, $iUpload->{_key} );
    my ( $src, $resno, $ext ) = ( $line->[0], $line->[1], $line->[2] );
    my $path = $iUpload->path( $resno, $ext );
    my $file_not_uploaded = -r $path ? 0 : 1;

    require File::Copy;
    local $!;
    if ( !File::Copy::copy( $src, $path ) ) {
        my $file = !-e $src ? $src : $path;
        $iKernel->throw_io_exception($file);
    }

    my ( $width, $height ) = $iUpload->get_dimensions($src);
    my $prefix = "I:U:I.${bbs}.${key}.${resno}";
    $iReposUpload->set( "${prefix}.extension", $ext );
    $iReposUpload->set( "${prefix}.width",     $width );
    $iReposUpload->set( "${prefix}.height",    $height );
    $iReposUpload->set( "${prefix}.hash",      $iUpload->get_digest($src) );
    $file_not_uploaded
        and
        $iReposUpload->set( "I:U:I.${bbs}.${key}._", ++$iUpload->{_count} );

    if ( my $dlkey = $iUpload->{__dlpass} ) {
        chmod 0600, $path;
        $iReposUpload->set( "${prefix}.download.pass",
            Digest::MD5::md5_base64($dlkey) );
        $iUpload->{__dlpass} = '';
    }
    if ( my $rmkey = $iUpload->{__rmpass} ) {
        $iReposUpload->set( "${prefix}.remove.pass",
            Digest::MD5::md5_base64($rmkey) );
        $iUpload->{__rmpass} = '';
    }

    @{ $iUpload->{__upload} } = ();
    $iUpload->{__path} = $path;
    $iReposUpload->save();
    return 1;
}

sub get {
    my ( $iUpload, $resno ) = @_;
    my ( $bbs, $key ) = ( $iUpload->{_dir}, $iUpload->{_key} );
    my $prefix       = "I:U:I.${bbs}.${key}.${resno}";
    my $iReposUpload = $iUpload->{_rs};

    if ( my $ext = $iReposUpload->get("${prefix}.extension") ) {
        my $width  = $iReposUpload->get_int("${prefix}.width");
        my $height = $iReposUpload->get_int("${prefix}.height");
        my $hash   = $iReposUpload->get("${prefix}.hash");
        return [ $ext, $width, $height, $hash ];
    }
    else {
        return [ '', 0, 0, '0000000000000000000000' ];
    }
}

sub get_thumbnail_size {
    my ( $iUpload, $resno, $ref_width, $ref_height ) = @_;
    my ( $bbs, $key ) = ( $iUpload->{_dir}, $iUpload->{_key} );
    my $prefix       = "I:U:I.${bbs}.${key}.${resno}";
    my $iReposUpload = $iUpload->{_rs};

    if ( my $width = $iReposUpload->get_int("${prefix}.width.thumbnail") ) {
        my $height = $iReposUpload->get_int("${prefix}.height.thumbnail");
        ${$ref_width}  = $width;
        ${$ref_height} = $height;
        return 1;
    }
    return 0;
}

sub set {
    my ( $iUpload, $src, $resno, $ext ) = @_;
    @{ $iUpload->{__upload} } = ( $src, $resno, $ext );
    return;
}

sub set_key {
    my ( $iUpload, $key ) = @_;
    my $iBBS    = $iUpload->{_i0_bbs};
    my $iKernel = $iUpload->{_kernel};
    my $bbs     = $iUpload->{_dir};
    $iUpload->{_key} = $key;

    my ( undef, undef, undef, $day, $month, $year ) = localtime($key);
    $year  += 1900;
    $month += 1;
    my $repos_upload
        = $iBBS->get_repos_path( $year, $month, $day, $key, 'upload' );
    my $repos_upload_dir = $repos_upload;
    $repos_upload_dir =~ s{/upload.\w+\z}{}xms;
    if ( !-d $repos_upload_dir ) {
        require File::Path;
        File::Path::mkpath($repos_upload_dir)
            or $iKernel->throw_io_exception($repos_upload_dir);
    }

    my $iReposUpload = $iKernel->get_repos($repos_upload);
    $iUpload->{_count} = $iReposUpload->get_int("I:U:I.${bbs}.${key}._");
    $iUpload->{_path}  = $iBBS->path( 'img', $key );
    $iUpload->{_rs}    = $iReposUpload;
    $iUpload->{_url}   = $iBBS->url( 'img', $key );
    return;
}

sub set_download_password { $_[0]->{__dlpass} = $_[1]; return; }

sub set_remove_password { $_[0]->{__rmpass} = $_[1]; return; }

sub set_thumbnail_size {
    my ( $iUpload, $resno, $width, $height ) = @_;
    my ( $bbs, $key ) = ( $iUpload->{_dir}, $iUpload->{_key} );
    my $prefix       = "I:U:I.${bbs}.${key}.${resno}";
    my $iReposUpload = $iUpload->{_rs};

    $iReposUpload->set( "${prefix}.width.thumbnail",  $width );
    $iReposUpload->set( "${prefix}.height.thumbnail", $height );
    return;
}

sub count { $_[0]->{_count} }

sub path {
    my ( $iUpload, $resno, $ext ) = @_;
    my $path = $iUpload->{_path};
    ( $resno and $ext ) ? "${path}/${resno}.${ext}" : $path;
}

sub url {
    my ( $iUpload, $resno, $ext ) = @_;
    my $path = $iUpload->{__url};
    ( $resno and $ext ) ? "${path}/${resno}.${ext}" : $path;
}

sub removed_mark {'0000000000000000000000'}

sub can_download { shift->_can( 'download', @_ ) }

sub can_remove { shift->_can( 'remove', @_ ) }

sub _can {
    my ( $iUpload, $type, $resno, $pass ) = @_;
    my ( $bbs, $key ) = ( $iUpload->{_dir}, $iUpload->{_key} );
    my $key_by_type  = "I:U:I.${bbs}.${key}.${resno}.${type}.pass";
    my $iReposUpload = $iUpload->{_rs};

    if ( my $pass_md5 = $iReposUpload->get($key_by_type) ) {
        return Digest::MD5::md5_base64($pass) eq $pass_md5;
    }
    return 0;
}

sub get_digest {
    my ( $iUpload, $path ) = @_;
    my $iKernel = $iUpload->{_kernel};

    -r $path or return '';
    -z $path and return '';
    local ( $!, *FH );

    open *FH, "<${path}" or $iKernel->throw_io_exception($path);  ## no critic
    binmode *FH;
    my $md5 = Digest::MD5->new();
    while ( read *FH, my $buffer, 32768 ) {
        $md5->add($buffer);
    }
    my $digest = $md5->b64digest();
    close *FH or $iKernel->throw_io_exception($path);
    $digest;
}

sub get_dimensions {
    my ( $iClass, $path ) = @_;
    my ( $width, $height ) = ( 0, 0 );

    if ( $path =~ /\.jpg\z/xms and eval 'use Image::Epeg qw(); 1' ) {
        my $epeg = Image::Epeg->new($path);
        if ($epeg) {
            $width  = $epeg->get_width();
            $height = $epeg->get_height();
        }
    }

    #    elsif ($path !~ /\.gif$/ and eval 'use Image::Imlib2 qw(); 1') {
    #        my $imlib = Image::Imlib2->new;
    #        $imlib->load($path);
    #        if ($imlib) {
    #            $width = $imlib->get_width;
    #            $height = $imlib->get_height;
    #        }
    #    }
    elsif ( eval 'use GD qw(); 1' ) {
        ( $width, $height ) = sub {
            return GD::Image->newFromJpeg($path) if $path =~ /\.jpg\z/xms;
            return GD::Image->newFromPng($path)  if $path =~ /\.png\z/xms;
            if ( $path =~ /\.gif\z/xms and GD->VERSION() >= 2.15 ) {
                return GD::Image->newFromGif($path) || GD::Image->new( 0, 0 );
            }
            return GD::Image->new( 0, 0 );
            }
            ->()->getBounds();
    }
    elsif ( eval 'use Image::Magick qw(); 1' ) {
        my $image = Image::Magick->new;
        ( $width, $height ) = $image->Ping($path);
    }

    if ( !$width and !$height ) {
        require Image::Info;
        my $ii = Image::Info::image_info($path);
        ( $width, $height ) = Image::Info::dim($ii);
    }

    $width  ||= 0;
    $height ||= 0;
    ( $width, $height );
}

sub get_uploaded_file_path { $_[0]->{__path} }

sub get_tags {
    my ( $iUpload, $tag ) = @_;
    my $iReposTag  = $iUpload->{_tag};
    my $tag_md5    = Digest::MD5::md5_base64($tag);
    my $count      = $iReposTag->get_int("I:U:T.${tag_md5}._");
    my $prefix_top = "I:U:T.${tag_md5}";
    my $ret        = [];

    for ( my $i = 1; $i <= $count; $i++ ) {
        my $prefix = join '.', $prefix_top, $i;
        push @$ret,
            [
            $iReposTag->get("${prefix}.bbs"),
            $iReposTag->get("${prefix}.key"),
            $iReposTag->get("${prefix}.resno"),
            $tag,
            ];
    }
    return $ret;
}

sub get_tag_count {
    my ($iUpload) = @_;
    my $all_tag_info = {};

    $iUpload->{_tag}->iterate(
        sub {
            my ( $key, $value, $all_tag_info ) = @_;
            if ( $key =~ /\AI:U:T\.(.+?)\._\z/xms ) {
                my $tag = $1;
                $all_tag_info->{$tag} ||= [];
                $all_tag_info->{$tag}->[1] = $$value;
                return 0;
            }
            if ( $key =~ /\AI:U:T\.(.+?)\.name\z/xms ) {
                my $tag = $1;
                $all_tag_info->{$tag} ||= [];
                $all_tag_info->{$tag}->[0] = $$value;
                return 0;
            }
        },
        $all_tag_info
    );

    my $ret = {};
    while ( my ( $md5, $tag_info ) = each %{$all_tag_info} ) {
        $ret->{ $tag_info->[0] } = $tag_info->[1];
    }
    return $ret;
}

sub set_tags {
    my ( $iUpload, $comment, $max ) = @_;
    $$comment =~ /<br>/xms or return 0;
    $max = Img0ch::Kernel::intval($max) || 3;

    my $iReposTag = $iUpload->{_tag};
    my $bbs       = $iUpload->{_dir};
    my $key       = $iUpload->{_key};
    my $resno     = $iUpload->{__upload}->[1];
    my $line      = [ split '<br>', $$comment ]->[1] || '';
    my %seen      = ();
    my $i         = 0;

    for ( ; $i < $max and $line =~ /\[(.{1,32}?)\]/gxms; $i++ ) {
        my $tag = $1;
        my $id = Digest::MD5::md5_base64( $bbs, $key, $resno, $tag );
        exists $seen{$id} and next;
        $seen{$id} = 1;
        my $tag_md5    = Digest::MD5::md5_base64($tag);
        my $prefix_top = "I:U:T.${tag_md5}";
        my $count      = $iReposTag->get_int("${prefix_top}._") + 1;
        my $prefix     = join '.', $prefix_top, $count;
        $iReposTag->set( "${prefix_top}._",    $count );
        $iReposTag->set( "${prefix_top}.name", $tag );
        $iReposTag->set( "${prefix}.bbs",      $bbs );
        $iReposTag->set( "${prefix}.key",      $key );
        $iReposTag->set( "${prefix}.resno",    $resno );
    }

    $iReposTag->save();
    return $i;
}

sub scale {
    my ( $iClass, $width, $height, $mx, $my ) = @_;
    my $p = 0;
    if ( $width > $mx or $height > $my ) {
        my $width2  = $mx / $width;
        my $height2 = $my / $height;
        ( $width2 < $height2 ) ? ( $p = $width2 ) : ( $p = $height2 );
        $width  = int( $width * $p );
        $height = int( $height * $p );
    }
    ( $width, $height );
}

sub traverse {
    my ($iUpload) = @_;
    my $iKernel   = $iUpload->{_kernel};
    my $path      = $iUpload->path();
    -d $path or return 0;

    local ( $!, *DH );
    opendir *DH, $path or $iKernel->throw_io_exception($path);
    my @file_list = readdir *DH;
    require File::Spec;
    @file_list = File::Spec->no_upwards(@file_list);
    closedir *DH or $iKernel->throw_io_exception($path);

    return [ map { File::Spec->catfile( $path, $_ ) } @file_list ];
}

sub remove {
    my ( $iUpload, $resno_or_path ) = @_;
    my $iReposUpload = $iUpload->{_rs};
    my ( $bbs, $key ) = ( $iUpload->{_dir}, $iUpload->{_key} );

    my $resno;
    if ( Img0ch::Kernel::intval($resno_or_path) ) {
        $resno = $resno_or_path;
    }
    else {
        -r $resno_or_path or return 0;
        ($resno) = $resno_or_path =~ m{/t?(\d+)\.[\w\.]+\z}xms;
    }
    my $prefix    = "I:U:I.${bbs}.${key}.${resno}";
    my $extension = $iReposUpload->get("${prefix}.extension");

    my $uploaded_file_path = $iUpload->path( $resno, $extension );
    if ( ( -f $uploaded_file_path or -l $uploaded_file_path )
        and -w $uploaded_file_path )
    {
        my $iKernel = $iUpload->{_kernel};
        unlink $uploaded_file_path
            or $iKernel->throw_io_exception($uploaded_file_path);
    }
    my $thumbnail = $iUpload->path( "t${resno}", $extension );
    if ( ( -f $thumbnail or -l $thumbnail ) and -w $thumbnail ) {
        my $iKernel = $iUpload->{_kernel};
        unlink $thumbnail or $iKernel->throw_io_exception($thumbnail);
    }

    $iReposUpload->remove("${prefix}.remove");
    $iReposUpload->remove("${prefix}.extension");
    $iReposUpload->remove("${prefix}.width");
    $iReposUpload->remove("${prefix}.height");
    $iReposUpload->remove("${prefix}.width.thumbnail");
    $iReposUpload->remove("${prefix}.height.thumbnail");
    $iReposUpload->remove("${prefix}.download.pass");
    $iReposUpload->set( "${prefix}.hash",        $iUpload->removed_mark() );
    $iReposUpload->set( "I:U:I.${bbs}.${key}._", --$iUpload->{_count} );
    return 1;
}

1;
__END__

=head1 NAME

Img0ch::Upload - アップロードされたファイルを管理するクラス

=head1 SYNOPSYS

  use Img0ch::Upload

  my $iUpload = Img0ch::Upload->new($iBBS, $key);
  $iThread->load();

  my ($extension, $width, $height, $digest) = @{ $iUpload->get(1) };
  my $count = $iUpload->count();
  my $path = $iUpload->path();

  $iUpload->set([ $src, $resno, $extension ]);
  $iUpload->save();

=head1 DESCRIPTION

1つのスレッドのアップロード情報を1つのオブジェクトとするクラスです。

=head2 new

=over 4

=item Arguments

$iBBS(Img0ch::Setting), $key

=item Return Value

$iUpload (Img0ch::Upload itself)

=back

I<Img0ch::Upload>のオブジェクトを作成します。

=head2 load

=over 4

=item Arguments

none

=item Return Value

1

=back

アップロードされたファイルのリストを読み込みます。

=head2 save

=over 4

=item Arguments

none

=item Return Value

1(saved) or 0

=back

I<set()>で指定された場所にファイルをアップロードし、保存します。
I<set()>が一度も呼び出されていなければ0を返します。

=head2 get

=over 4

=item Arguments

$resno

=item Return Value

$array_reference

=back

指定されたファイルのアップロード情報を配列のリファレンスとして取り出します。
拡張子名、画像の奥行、画像の幅、ファイルのダイジェストの順番に値が返されます。

=head2 get_thumbnail_size

=over 4

=item Arguments

$resno, $reference_to_width, $reference_to_height

=item Return Value

1(thumbnail has) or 0

=back

指定されたレス番号のサムネイル情報があるかどうかを返します。
存在した場合はI<$reference_to_width>とI<$reference_to_height>に
サムネイル画像の大きさを格納して1を返します。存在しない場合は0を返します。

=head2 set

=over 4

=item Arguments

$arrray_reference

=item Return Value

none

=back

順番からファイルのアップロードする元のファイルとレス番号、拡張子名を指定します。
二回目に呼び出すと前の内容が消去されます。

=head2 set_key

=over 4

=item Arguments

$key

=item Return Value

none

=back

オブジェクト内部に保存されているスレッドキーを変更します。
別のスレッドのアップロード情報を読み込む、
または別のスレッドににファイルをアップロードするときに使います。

=head2 set_download_password

=over 4

=item Arguments

$download_key

=item Return Value

none

=back

アップロードファイルのダウンロードキーをオブジェクト内に設定します。
save()を呼び出すとアップロードされたファイルが保存時にchmod()により
0600に設定されます。二回目に呼び出すと前の内容が消去されます。

=head2 set_remove_password

=over 4

=item Arguments

$remove_key

=item Return Value

none

=back

アップロードファイルの削除キーをオブジェクト内に設定します。
二回目に呼び出すと前の内容が消去されます。

=head2 set_thumbnail_size

=over 4

=item Arguments

$resno, $width, $height

=item Return Value

none

=back

サムネイルファイルのレス番号、大きさを指定してレポジトリに保存します。
実際にファイルに保存するにはsave()を使ってください。

=head2 count

=over 4

=item Arguments

none

=item Return Value

$count

=back

現在のスレッドにアップロードされているファイル数を返します。

=head2 path

=over 4

=item Arguments

$resno, $extension

=item Return Value

$path_to_uploading_to

=back

レス番号と拡張子からアップロードするパスを作成します。

=head2 url

=over 4

=item Arguments

$resno, $extension

=item Return Value

$url_to_uploading_to

=back

レス番号と拡張子からアップロード先のURLを作成します。

=head2 removed_mark

=over 4

=item Arguments

none

=item Return Value

$removed_mark_string

=back

アップロードされたファイルが削除された印の文字列を返します。

=head2 get_digest

=over 4

=item Arguments

$path

=item Return Value

$digest_string_from_file

=back

指定されたファイルのパスからダイジェストを計算します。

=head2 get_uploaded_file_path

=over 4

=item Arguments

none

=item Return Value

$path_to_uploaded_file

=back

アップロードされたファイルのパスを返します。

=head2 get_dimensions

=over 4

=item Arguments

$path

=item Return Value

( $width, $height )

=back

指定された画像ファイルの奥行と幅の配列を返します。
使用されるモジュールの順番は以下の通りです。
一番最初に発見されたモジュールを使って大きさを求めます。

=over 4

=item Image::Epeg (jpg画像のみ)

Image::Epegはjpgはjpgのみ他のモジュールよりも高速に処理します。

=item GD

GDは汎用的な画像処理ライブラリです。

=item Image::Magick

Image::Magick(PerlMagick)は多くの画像を扱う画像処理ライブラリです。

=item Image::Info

Image::Infoはpureperlの画像情報処理ライブラリです。

=back

=head2 get_tags

=over 4

=item Arguments

$tag_name

=item Return Value

$array_reference_of_found

=back

指定されたタグ名からタグの検索をします。
検索結果はそれぞれ掲示板のID、スレッドキー、レス番号、タグ名の
順番で構成された配列のリファレンスのリファレンスを返します。

=head2 get_tag_count

=over 4

=item Arguments

none

=item Return Value

$array_reference_of_found

=back

全てのタグの数を調べます。それぞれタグ名、タグの発見数の順番で
構成された配列のリファレンスのリファレンスを返します。

=head2 set_tags

=over 4

=item Arguments

$comment_reference, $max?

=item Return Value

1

=back

$comment_referenceの最初の行から[]で囲まれた文字列を
抽出し、タグとして登録します。$maxが指定されない場合は
3がデフォルトとして代入されます。

=head2 scale

=over 4

=item Arguments

$width, $height, $max_width, $max_height

=item Return Value

($scaled_width, $scaled_height)

=back

$max_widthと$max_heightから画像の大きさを縮小した結果を返します。

=head2 traverse

=over 4

=item Arguments

none

=item Return Value

$all_uploaded_files

=back

オブジェクト内部のスレッドキーのアップロードされたファイルを格納する
ディレクトリのを走査し、その中のファイルパスを絶対パスにした
配列リファレンスを返します。ディレクトリを示すI<.>とI<..>は取り除かれます。

=head2 remove

=over 4

=item Arguments

$resno

=item Return Value

1

=back

指定されたレス番号のアップロードされているファイルとレポジトリ上の
アップロード情報を削除します。

=head1 AUTHOR

hkrn E<lt>hikarin@users.sourceforge.jpE<gt>

=cut
