#/*
# *  Copyright 2007-2008 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 1645 2008-02-06 15:40:18Z hikarin $
#

package Img0ch::Upload;

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

sub new {
    my ( $iClass, $iBBS, $key ) = @_;
    my $iKernel   = $iBBS->get_kernel();
    my $repos_tag = $iBBS->get_repos_path('tag');
    my $iReposTag = $iKernel->get_repos($repos_tag);
    my $bbs       = $iBBS->get_name();

    my $repos_upload = '';
    $key
        and $repos_upload
        = Img0ch::Maple::create_repository_subdirs( $key, 'upload', $iBBS );

    my ( $iReposUpload, $count ) = ( '', 0 );
    if ($repos_upload) {
        $iReposUpload = $iKernel->get_repos($repos_upload);
        $count        = $iReposUpload->get_int("I:U:I.${bbs}.${key}._");
    }
    if ( $iKernel->get_config()->get('compatible.upload') ) {
        require Img0ch::Compat::Upload;
        Img0ch::Compat::Upload::load( $iReposUpload, $iBBS, $key );
    }

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

sub load {
    my ($iUpload) = @_;
    my $iReposUpload = $iUpload->{_rs};
    $iReposUpload and $iReposUpload->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 ) {
        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;

    defined $File::Copy::VERSION or require File::Copy;
    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 = join '.', $iUpload->{_prefix}, $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( join( '.', $iUpload->{_prefix}, '_' ),
        ++$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;
    $iUpload->{__url} = $iUpload->url( $resno, $ext );
    $iReposUpload->save();
    return 1;
}

sub update_csv {
    my ( $iUpload, $max ) = @_;
    $iUpload->count() or return 0;
    $max = Img0ch::Kernel::intval($max);

    my $iKernel = $iUpload->{_kernel};
    my $path    = $iUpload->path() . '/upload.csv';
    my $temp    = $path . '.tmp';

    eval {
        my $fh    = $iKernel->get_write_file_handle($temp);
        my $count = 0;
        for ( my $i = 0; $i <= $max; $i++ ) {
            $iUpload->is_freezed($i) and next;
            my $info = $iUpload->get($i);
            if ( my $ext = $info->[0] ) {
                my ( $w, $h ) = ( 0, 0 );
                $iUpload->get_thumbnail_size( $i, \$w, \$h );
                print ${fh} $i, ',', $ext, ',', $info->[1], ',', $info->[2],
                    ',', $info->[3], ',', $w, ',', $h, "\n"
                    or $iKernel->throw_io_exception($path);
            }
        }
        close $fh or $iKernel->throw_io_exception($path);
        rename $temp, $path or $iKernel->throw_io_exception($path);
    };
    if ( my $exception = $@ ) {
        if ( -e $temp ) {
            unlink $temp or $iKernel->throw_io_exception($temp);
        }
        die $exception, "\n";
    }

    return 1;
}

sub get {
    my ( $iUpload, $resno, $decode_base64 ) = @_;
    my $prefix = join '.', $iUpload->{_prefix}, $resno;
    my $iReposUpload = $iUpload->{_rs};

    if ( my $hash = $iReposUpload->get("${prefix}.hash") ) {
        my $ext    = $iReposUpload->get("${prefix}.extension");
        my $width  = $iReposUpload->get_int("${prefix}.width");
        my $height = $iReposUpload->get_int("${prefix}.height");
        $decode_base64
            and $hash = unpack( 'H*', $iUpload->_decode_base64($hash) );
        return [ $ext, $width, $height, $hash ];
    }
    else {
        return [ '', 0, 0, '' ];
    }
}

sub get_thumbnail_size {
    my ( $iUpload, $resno, $ref_width, $ref_height ) = @_;
    my $prefix = join '.', $iUpload->{_prefix}, $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 $bbs  = $iUpload->{_dir};
    my $repos_upload
        = Img0ch::Maple::create_repository_subdirs( $key, 'upload', $iBBS );

    my $prefix = join '.', 'I:U:I', $iUpload->{_dir}, $key;
    my $iReposUpload = $iUpload->{_kernel}->get_repos($repos_upload);

    $iUpload->{_count}  = $iReposUpload->get_int("${prefix}._");
    $iUpload->{_key}    = $key;
    $iUpload->{_path}   = $iBBS->path( 'img', $key );
    $iUpload->{_rs}     = $iReposUpload;
    $iUpload->{_url}    = $iBBS->url( 'img', $key );
    $iUpload->{_prefix} = $prefix;
    return;
}

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

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

sub have_download_password {
    my ( $iUpload, $resno ) = @_;
    my $iReposUpload = $iUpload->{_rs};
    return $iReposUpload->get( join '.', $iUpload->{_prefix}, $resno,
        'download.pass' ) ? 1 : 0;
}

sub set_thumbnail_size {
    my ( $iUpload, $resno, $width, $height ) = @_;
    my $iReposUpload = $iUpload->{_rs};
    my $prefix = join '.', $iUpload->{_prefix}, $resno;
    $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 ) = @_;
    $iUpload->is_freezed($resno) and return 0;

    my $key_by_type = join '.', $iUpload->{_prefix}, $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_raw { _get_digest( 'digest', @_ ) }

sub get_digest_hex { _get_digest( 'hexdigest', @_ ) }

sub get_digest { _get_digest( 'b64digest', @_ ) }

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

    -r $path or return '';
    -z $path and return '';

    my $fh = $iKernel->get_read_file_handle($path);
    binmode $fh;

    my $md5 = Digest::MD5->new();
    while ( read $fh, my $buffer, 32768 ) {
        $md5->add($buffer);
    }

    my $digest = $md5->$md5_method();
    close $fh or $iKernel->throw_io_exception($path);

    return $digest;
}

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

    if ($path =~ /\.jpg\z/xms
        and ( defined $Image::Epeg::VERSION
            or eval 'use Image::Epeg qw(); 1' )
        )
    {
        my $epeg = Image::Epeg->new($path);
        if ($epeg) {
            $width  = $epeg->get_width();
            $height = $epeg->get_height();
        }
    }
    elsif ( defined $Imager::VERSION or eval 'use Imager qw(); 1' ) {
        my $image = Imager->new();
        $image->read( file => $path );
        $width  = $image->getwidth();
        $height = $image->getheight();
    }
    elsif ( defined $GD::VERSION or eval 'use GD qw(); 1' ) {
        my $gd = 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;
            }
            ->();
        if ($gd) {
            ( $width, $height ) = $gd->getBounds();
        }
    }
    elsif ( defined $Image::Magick::VERSION
        or 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 is_removed {
    my ( $iUpload, $hash ) = @_;
    $hash ||= $iUpload->get_digest( $iUpload->{__upload}->[0] );

    require Img0ch::Upload::Removed;
    my $iURemoved = Img0ch::Upload::Removed->new( $iUpload->{_i0_bbs} );
    return $iURemoved->is_removed($hash) ? 1 : 0;
}

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

sub get_uploaded_file_url { $_[0]->{__url} }

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_int("${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 get_tag_count_utf8 {
    my ($iUpload) = @_;
    my $iKernel   = $iUpload->{_kernel};
    my $ret       = $iUpload->get_tag_count();
    my $encoding  = $iKernel->get_encoding();
    my $new_ret   = {};

    while ( my ( $data, $count ) = each %$ret ) {
        $data = $iKernel->get_encoded_str( $data, 'utf8', $encoding );
        $new_ret->{$data} = $count;
    }

    return $new_ret;
}

sub set_tags {
    my ( $iUpload, $comment, $max, $resno, $no_commit ) = @_;
    $$comment =~ /<br>/xms or return 0;
    $max = Img0ch::Kernel::intval($max) || 3;
    $resno ||= $iUpload->{__upload}->[1];

    my $iReposTag = $iUpload->{_tag};
    my $bbs       = $iUpload->{_dir};
    my $key       = $iUpload->{_key};
    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 );
    }

    !$no_commit and $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 freeze { _freeze_or_release( [ 0600, 0700 ], 1, @_ ) }

sub release { _freeze_or_release( [ 0644, 0755 ], 0, @_ ) }

sub _freeze_or_release {
    my ( $permission, $is_freeze, $iUpload, $resno ) = @_;
    my ( $iRepos, $extension, $prefix );

    $resno = Img0ch::Kernel::intval($resno);
    if ($resno) {
        $prefix    = join '.', $iUpload->{_prefix}, $resno;
        $iRepos    = $iUpload->{_rs};
        $extension = $iRepos->get("${prefix}.extension") || return 0;
    }

    my $path = $iUpload->path( $resno, $extension );
    if ( -e $path ) {
        -f $path and chmod $permission->[0], $path;
        -d $path and chmod $permission->[1], $path;
        if ($iRepos) {
            my $thumbnail = $iUpload->path( "t${resno}", $extension );
            -f $thumbnail and chmod $permission->[0], $thumbnail;
            $iRepos->set( "${prefix}.protected", $is_freeze );
            $iRepos->save();
        }
        return 1;
    }
    return 0;
}

sub is_freezed {
    my ( $iUpload, $resno ) = @_;
    if ($resno) {
        my $prefix = join '.', $iUpload->{_prefix}, $resno;
        return $iUpload->{_rs}->get("${prefix}.protected") ? 1 : 0;
    }
    else {
        my $path = $iUpload->path();
        if ( -e $path ) {
            my $permission = ( stat($path) )[2] & 07777;
            return ( $permission == 0600 or $permission == 0700 ) ? 1 : 0;
        }
        return 0;
    }
}

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

    defined $File::Spec::VERSION or require File::Spec;
    opendir my $fh, $path or $iKernel->throw_io_exception($path);
    my @file_list = readdir $fh;
    @file_list = File::Spec->no_upwards(@file_list);
    closedir $fh or $iKernel->throw_io_exception($path);

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

sub remove {
    my ( $iUpload, $resno_or_path, $save_removed_hash ) = @_;
    my $iReposUpload = $iUpload->{_rs};

    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_top = $iUpload->{_prefix};
    my $prefix     = join '.', $prefix_top, $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 $iBBS = $iUpload->{_i0_bbs};
        my $key  = $iUpload->{_key};
        if ($save_removed_hash) {
            defined &{'Img0ch::Upload::Removed::new'}
                or require Img0ch::Upload::Removed;
            my $iURemoved = $iUpload->{__removed}
                ||= Img0ch::Upload::Removed->new($iBBS);
            $iURemoved->set( $iUpload->get_digest($uploaded_file_path),
                $key, $resno );
            $iURemoved->save();
        }
        defined &{'Img0ch::Upload::Tag::new'}
            or require Img0ch::Upload::Tag;
        my $iUTag = $iUpload->{__tag} ||= Img0ch::Upload::Tag->new($iBBS);
        $iUTag->remove( $key, $resno );
        $iUTag->save();
        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.pass");
    $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( "${prefix_top}._", --$iUpload->{_count} );
    return 1;
}

sub _decode_base64 {
    my ( $iUpload, $str ) = @_;
    local $SIG{__WARN__} = sub { };
    if ( defined $MIME::Base64::VERSION or eval 'require MIME::Base64; 1' ) {
        return MIME::Base64::decode_base64($str);
    }
    else {
        defined $MIME::Base64::Perl::VERSION or require MIME::Base64::Perl;
        return MIME::Base64::Perl::decode_base64($str);
    }
}

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 update_csv

=over 4

=item Arguments

$count_of_reses

=item Return Value

1(saved) or 0

=back

現在のファイルデータベースからCSVを生成します。
何もアップロードされていない場合を除いて1を返します。

=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 is_removed

=over 4

=item Arguments

$hash_of_uploaded_file

=item Return Value

1 or 0

=back

ファイルのハッシュから過去に削除されたファイルのハッシュであるかどうかをテストします。
一致したならば1を、そうでない場合は0を返します。

=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 get_tag_count_utf8

=over 4

=item Arguments

none

=item Return Value

$array_reference_of_found

=back

タグ名がそれぞれutf8で返される点以外はI<get_tag_count()>と同様です。

=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 freeze

=over 4

=item Arguments

$resno?

=item Return Value

1 or 0(none)

=back

ファイルの凍結を行います。凍結されたファイルは削除及びダウンロードが不可能になります。
凍結を解除するにはI<release()>を利用してください。
引数が無い場合はオブジェクト内部のスレッドキーのディレクトリ全体に凍結を行います。
成功した場合は1を、失敗した場合(ファイルが存在しないまたはデータに登録されていない)は0を返します。

=head2 release

=over 4

=item Arguments

$resno?

=item Return Value

1 or 0(none)

=back

ファイルの凍結の凍結解除を行います。
引数が無い場合はオブジェクト内部のスレッドキーのディレクトリ全体に凍結解除を行います。
成功した場合は1を、失敗した場合(ファイルが存在しないまたはデータに登録されていない)は0を返します。

=head2 is_freezed

=over 4

=item Arguments

$resno?

=item Return Value

1 or 0

=back

ファイルの凍結が行われているかをテストします。
引数が無い場合はオブジェクト内部のスレッドキーのディレクトリ全体をテストします。
凍結状態にある場合は1、そうで無い場合は0を返します。

=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
