Arh/Action/UploadPicture.pm

use strict;
use warnings;

=head1 NAME

Arh::Action::UploadPicture

=cut

package Arh::Action::UploadPicture;
use base qw/Arh::Action::CreatePicture/;

use Data::Dump qw/dump/;

=head2 take_action

=cut

sub take_action {
    my $self = shift;

    if ( my $fh = $self->argument_value('content') ) {

                my $filename = scalar( $fh );
                $filename =~ s/^.*([\/\\])([^\1]+)$/$2/;

                local $/;
                binmode $fh;
                my $content = scalar <$fh>;

                if ( $filename !~ m/\.(jpg|jpeg|png|gif|tif|tiff)$/i ) {
                        $self->result->error("unknown file type $filename");
                        return;
                }

                warn "## $self take_action filename: $filename (", length($content), " bytes)\n";

                $self->argument_value( 'filename' => $filename );       # needed for report_success
                $self->argument_value( 'content' => $content );

                my $id = $self->SUPER::take_action( @_ );

                # update database with correct filename (why do I need this?)
                $self->record->set_filename( $filename );

                return $id;

        } else {
                $self->result->error("No file uploaded!");
        }

}

=head2 report_success

=cut

sub report_success {
        my $self = shift;
        $self->result->message( 'Created ' . $self->argument_value('filename') . ' with ' . length( $self->argument_value('content') ) . ' bytes' );
        warn "## report_success ", dump( $self->result );
}

1;

1	dpavlin	44	use strict;
2			use warnings;
3
4			=head1 NAME
5
6			Arh::Action::UploadPicture
7
8			=cut
9
10			package Arh::Action::UploadPicture;
11			use base qw/Arh::Action::CreatePicture/;
12
13			use Data::Dump qw/dump/;
14
15			=head2 take_action
16
17			=cut
18
19			sub take_action {
20			my $self = shift;
21
22			if ( my $fh = $self->argument_value('content') ) {
23
24			my $filename = scalar( $fh );
25			$filename =~ s/^.*([\/\\])([^\1]+)$/$2/;
26
27			local $/;
28			binmode $fh;
29			my $content = scalar <$fh>;
30
31	dpavlin	48	if ( $filename !~ m/\.(jpg\|jpeg\|png\|gif\|tif\|tiff)$/i ) {
32			$self->result->error("unknown file type $filename");
33			return;
34			}
35
36	dpavlin	44	warn "## $self take_action filename: $filename (", length($content), " bytes)\n";
37
38	dpavlin	48	$self->argument_value( 'filename' => $filename ); # needed for report_success
39	dpavlin	44	$self->argument_value( 'content' => $content );
40
41	dpavlin	48	my $id = $self->SUPER::take_action( @_ );
42
43			# update database with correct filename (why do I need this?)
44			$self->record->set_filename( $filename );
45
46			return $id;
47
48			} else {
49			$self->result->error("No file uploaded!");
50	dpavlin	44	}
51
52			}
53
54			=head2 report_success
55
56			=cut
57
58			sub report_success {
59			my $self = shift;
60			$self->result->message( 'Created ' . $self->argument_value('filename') . ' with ' . length( $self->argument_value('content') ) . ' bytes' );
61			warn "## report_success ", dump( $self->result );
62			}
63
64			1;
65