Perly/Action/Upload.pm

use warnings;
use strict;

=head1 NAME

Perly::Action::Upload

=cut

package Perly::Action::Upload;
use base qw/Perly::Action::CreateCode Jifty::Action/;

use Perly::Model::Code;
use Perly::Model::Input;
use Data::UUID;

=head2 arguments

The fields for C<Upload> are:

=over 4

=item file: The uploaded file

=back

=cut

sub arguments {
        {
                filename => { label => 'Filename', hints => 'Optional for file upload' },
                content => { label => 'The text version', render_as => 'Textarea', hints => 'Copy/paste content or upload file' },
                file    => {
                        label     => '',
                        render_as => 'Upload',
                },
                format => {
                        label         => 'Textfile format',
                        valid_values  => [qw(input perl)],
                        default_value => 'auto',
                        render_as     => 'select',
                        hints         => 'Automatic detection of perl code is available',
                }
        }
}

=head2 take_action

Import the textfile dump

=cut

sub take_action {
    my $self = shift;
    unless( $self->argument_value('file') || $self->argument_value('content') ) {
        $self->result->failure('You must upload something!');
        return 1;
    }

    my $content;
        my $filename;

    if ( my $fh = $self->argument_value('file') ) {
        local $/;
        $content = <$fh>;

        # This kills the filehandle from the action, so Apache::Session
        # doesn't try to save it away (and fail) when we do the redirect

        $self->argument_value( 'file', "" );
                $filename = scalar( $fh );
                $filename =~ s/^.*([\/\\])([^\1]+)$/$2/;
    } else {
        $content = $self->argument_value('content');
                my $uuid = Data::UUID->new();
                $filename = $self->argument_value( 'filename' );
                $filename ||= $uuid->create_str;
    }


        my $format = $self->argument_value( 'format' );
        $format = 'perl' if ($content =~ m/perl/si || $filename =~ m/\.p[lm]$/i);

        my $id;
        if ( $format eq 'input' ) {
                my $input = Perly::Model::Input->new();
                eval {
                        $id = $input->create(
                                name => $filename,
                                content => $content,
                        );
                };
                die "$@" if ($@);
        } else {
                my $code = Perly::Model::Code->new();
                eval {
                        $id = $code->create(
                                name => $filename,
                                source => $content,
                        );
                };
                die "$@" if ($@);
        }

        my $message = "Created $filename ($format) " . length( $content ) . " bytes [$id]";

#       $self->result->content( $_ => $outcome->{$_} ) for keys %{$outcome};
        $self->result->message($message);
        warn "## $message";
        delete Jifty->handler->stash->{RECORD_ARGUMENTS};
}

1;
1	use warnings;
2	use strict;
3
4	=head1 NAME
5
6	Perly::Action::Upload
7
8	=cut
9
10	package Perly::Action::Upload;
11	use base qw/Perly::Action::CreateCode Jifty::Action/;
12
13	use Perly::Model::Code;
14	use Perly::Model::Input;
15	use Data::UUID;
16
17	=head2 arguments
18
19	The fields for C<Upload> are:
20
21	=over 4
22
23	=item file: The uploaded file
24
25	=back
26
27	=cut
28
29	sub arguments {
30	{
31	filename => { label => 'Filename', hints => 'Optional for file upload' },
32	content => { label => 'The text version', render_as => 'Textarea', hints => 'Copy/paste content or upload file' },
33	file => {
34	label => '',
35	render_as => 'Upload',
36	},
37	format => {
38	label => 'Textfile format',
39	valid_values => [qw(input perl)],
40	default_value => 'auto',
41	render_as => 'select',
42	hints => 'Automatic detection of perl code is available',
43	}
44	}
45	}
46
47	=head2 take_action
48
49	Import the textfile dump
50
51	=cut
52
53	sub take_action {
54	my $self = shift;
55	unless( $self->argument_value('file') \|\| $self->argument_value('content') ) {
56	$self->result->failure('You must upload something!');
57	return 1;
58	}
59
60	my $content;
61	my $filename;
62
63	if ( my $fh = $self->argument_value('file') ) {
64	local $/;
65	$content = <$fh>;
66
67	# This kills the filehandle from the action, so Apache::Session
68	# doesn't try to save it away (and fail) when we do the redirect
69
70	$self->argument_value( 'file', "" );
71	$filename = scalar( $fh );
72	$filename =~ s/^.*([\/\\])([^\1]+)$/$2/;
73	} else {
74	$content = $self->argument_value('content');
75	my $uuid = Data::UUID->new();
76	$filename = $self->argument_value( 'filename' );
77	$filename \|\|= $uuid->create_str;
78	}
79
80
81	my $format = $self->argument_value( 'format' );
82	$format = 'perl' if ($content =~ m/perl/si \|\| $filename =~ m/\.p[lm]$/i);
83
84	my $id;
85	if ( $format eq 'input' ) {
86	my $input = Perly::Model::Input->new();
87	eval {
88	$id = $input->create(
89	name => $filename,
90	content => $content,
91	);
92	};
93	die "$@" if ($@);
94	} else {
95	my $code = Perly::Model::Code->new();
96	eval {
97	$id = $code->create(
98	name => $filename,
99	source => $content,
100	);
101	};
102	die "$@" if ($@);
103	}
104
105	my $message = "Created $filename ($format) " . length( $content ) . " bytes [$id]";
106
107	# $self->result->content( $_ => $outcome->{$_} ) for keys %{$outcome};
108	$self->result->message($message);
109	warn "## $message";
110	delete Jifty->handler->stash->{RECORD_ARGUMENTS};
111	}
112
113	1;