/usr/local/CPAN/Foorum/Foorum/ResultSet/Upload.pm

• package Foorum::ResultSet::Upload
  • get
  • remove_for_forum
  • remove_for_user
  • remove_file_by_upload_id
  • remove_by_upload
  • add_file
  • change_for_forum
• EOF

package Foorum::ResultSet::Upload;

use strict;
use warnings;
our $VERSION = '1.001000';
use base 'DBIx::Class::ResultSet';

use File::Remove qw(remove);
use File::Path;
use File::Spec;
use File::Copy ();
use Foorum::Utils qw/generate_random_word/;
use Scalar::Util ();

sub get {
    my ( $self, $upload_id ) = @_;

    return unless ( $upload_id =~ /^\d+$/ );

    my $schema = $self->result_source->schema;
    my $cache  = $schema->cache();

    my $cache_key = "upload|upload_id=$upload_id";
    my $cache_val = $cache->get($cache_key);
    return $cache_val if ($cache_val);

    my $upload = $self->find( { upload_id => $upload_id } );
    return unless ($upload);

    $cache_val = $upload->{_column_data};
    $cache->set( $cache_key, $cache_val, 7200 );    # two hours

    return $cache_val;
}

sub remove_for_forum {
    my ( $self, $forum_id ) = @_;

    my $rs = $self->search( { forum_id => $forum_id },
        { columns => [ 'upload_id', 'filename' ], } );
    while ( my $u = $rs->next ) {
        $self->remove_by_upload($u);
    }
    return 1;
}

sub remove_for_user {
    my ( $self, $user_id ) = @_;

    my $rs = $self->search( { user_id => $user_id, },
        { columns => [ 'upload_id', 'filename' ], } );
    while ( my $u = $rs->next ) {
        $self->remove_by_upload($u);
    }
    return 1;
}

sub remove_file_by_upload_id {
    my ( $self, $upload_id ) = @_;

    my $upload = $self->get($upload_id);
    return unless ($upload);
    remove_by_upload( $self, $upload );
    return 1;
}

sub remove_by_upload {
    my ( $self, $upload ) = @_;

    if ( Scalar::Util::blessed($upload) ) {
        $upload = $upload->{_column_data};
    }

    my $schema    = $self->result_source->schema;
    my $cache     = $schema->cache();
    my $base_path = $schema->base_path();

    my $directory_1 = int( $upload->{upload_id} / 3200 / 3200 );
    my $directory_2 = int( $upload->{upload_id} / 3200 );
    my $file
        = File::Spec->catfile( $base_path, 'root', 'upload', $directory_1,
        $directory_2, $upload->{filename} );
    remove($file);
    $self->search( { upload_id => $upload->{upload_id} } )->delete;

    $cache->remove( 'upload|upload_id=' . $upload->{upload_id} );
}

sub add_file {
    my ( $self, $upload, $info ) = @_;

    my $schema    = $self->result_source->schema;
    my $config    = $schema->config();
    my $base_path = $schema->base_path();

    my @valid_types = @{ $config->{upload}->{valid_types} };
    my $max_size    = $config->{upload}->{max_size};
    my ( $basename, $filesize ) = ( $upload->basename, $upload->size );
    $filesize /= 1024;    # I want K
    if ( $filesize > $max_size ) {
        return 'EXCEED_MAX_SIZE';
    }
    ($filesize) = ( $filesize =~ /^(\d+\.?\d{0,1})/ );    # float(6,1)

    my ( $filename_no_postfix, $filetype )
        = ( $basename =~ /^(.*?)\.(\w+)$/ );
    $filetype = lc($filetype);
    unless ( grep { $filetype eq $_ } @valid_types ) {
        return 'UNSUPPORTED_FILETYPE';
    }

    if ( length($filename_no_postfix) > 30 ) {
        $filename_no_postfix
            = substr( $filename_no_postfix, 0, 30 );      # varchar(36)
        $basename = $filename_no_postfix . ".$filetype";
    }
    my $upload_rs = $self->create(
        {   user_id  => $info->{user_id},
            forum_id => $info->{forum_id} || 0,
            filename => $basename,
            filesize => $filesize,
            filetype => $filetype,
        }
    );

    my $upload_id = $upload_rs->upload_id;

    my $directory_1 = int( $upload_id / 3200 / 3200 );
    my $directory_2 = int( $upload_id / 3200 );
    my $upload_dir
        = File::Spec->catdir( $base_path, 'root', 'upload', $directory_1,
        $directory_2 );

    unless ( -e $upload_dir ) {
        my @created = mkpath( [$upload_dir], 0, 0777 );    ## no critic
        ## no critic (ProhibitLeadingZeros)
        # copy index.html to protect dir from Options Indexes
        my $indexfile = File::Spec->catfile( $base_path, 'root', 'upload',
            'index.html' );
        foreach my $dir (@created) {
            File::Copy::copy( $indexfile, $dir );
        }
    }

    my $target
        = File::Spec->catfile( $base_path, 'root', 'upload', $directory_1,
        $directory_2, $basename );

    # rename if exist
    if ( -e $target ) {
        my $random_filename;
        while ( -e $target ) {
            $random_filename = generate_random_word(15) . ".$filetype";
            $target = File::Spec->catfile( $base_path, 'root', 'upload',
                $directory_1, $directory_2, $random_filename );
        }
        $upload_rs->update( { filename => $random_filename } );
    }

    unless ( $upload->link_to($target) || $upload->copy_to($target) ) {
        return 'SYSTEM_ERROR';
    }

    return $upload_id;
}

sub change_for_forum {
    my ( $self, $info ) = @_;

    my $from_id = $info->{form_id} or return 0;
    my $to_id   = $info->{to_id}   or return 0;

    $self->search( { forum_id => $from_id, } )
        ->update( { forum_id => $to_id, } );
}

1;