From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

NYAKNYAN / HTTP-Server-EV-0.41 / EV / IO / Blocking.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
—
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106

              
package HTTP::Server::EV::IO::Blocking;
use strict;
use File::Copy;
use File::Util qw/escape_filename/;
sub _use_me { # i'm not using ISA for performance
        *HTTP::Server::EV::MultipartFile::save = *save;
        *HTTP::Server::EV::MultipartFile::fh = *fh;
        *HTTP::Server::EV::MultipartFile::DESTROY = *DESTROY;
         
        *HTTP::Server::EV::MultipartFile::_new = *_new;
        *HTTP::Server::EV::MultipartFile::_flush = *_flush;
         
        *HTTP::Server::EV::MultipartFile::_done = *_done;
}
our $VERSION = '0.41';
=head1 NAME
HTTP::Server::EV::IO::Blocking - Implments L<HTTP::Server::EV::MultipartFile> using perlio functions.
=cut
sub save {
        my ($self, $dest, $cb) = @_;
        close delete $self->{fh} if $self->{fh};
         
        my $status = 1;
        if($self->{moved}){
                copy($self->{path}, $dest ) or (warn __PACKAGE__." failed to copy file to $dest - $! \n" and $status = 0);
        }else{
                move($self->{path}, $dest ) or (warn __PACKAGE__." failed to move file to $dest - $! \n" and $status = 0);
                $self->{path} = $dest;
                $self->{moved} = 1;
        }
         
        $cb->($status) if $cb;
         
        return $status;
}
sub fh {
        my ($self, $cb) = @_;
         
        unless($self->{fh}){
                unless( open ($self->{fh}, '<', $self->{path}) ){
                        warn __PACKAGE__." failed to open file - $! \n";
                        $cb->(undef) if $cb;
                        return undef;
                }
                 
                binmode $self->{fh};
        }
         
        $cb->($self->{fh}) if $cb;
        return $self->{fh};
}
sub DESTROY {
        close delete $_[0]->{fh} if $_[0]->{fh};
        unlink delete $_[0]->{path} if ($_[0]->{path} and !($_[0]->{moved}));
}
my @chars = ('A'..'Z', 'a'..'z', 0..9);
sub _new {
        my ($self) = @_;
         
        $self->{path} = $HTTP::Server::EV::tmp_path.'/';
        $self->{path} .= @chars[rand @chars] for 1..50;
         
        $self->{name} = escape_filename($self->{name});
        $self->{name} =~s/\x{0}//g;
         
        unless( open ($self->{fh}, '+>', $self->{path}) ){
                warn __PACKAGE__." failed to create file - $! \n";
                $self->{parent_req}->drop;
                return;
        }
                 
        $self->{parent_req}{parent_listener}{on_file_open}->( $self->{parent_req}, $self) 
                if $self->{parent_req}{parent_listener}{on_file_open};
}
sub _flush {
        my ($self, $data) = @_;
         
        $self->{size} += (syswrite($self->fh , $data ) or ($self->{parent_req}->drop and return));
         
        $self->{parent_req}{parent_listener}{on_file_write}->( $self->{parent_req}, $self, $data) 
                                if $self->{parent_req}{parent_listener}{on_file_write};
}
sub _done {
        $_[0]->{parent_req}{parent_listener}{on_file_received}->($_[0]->{parent_req}, $_[0]) if $_[0]->{parent_req}{parent_listener}{on_file_received};
         
        $_[0]->{parent_req}->start;
         
        seek $_[0]->{fh},0,0;
}