view release on metacpan or  search on metacpan

lib/Net/PhotoBackup/Server.pm  view on Meta::CPAN

                    # Port is just digits.
                    elsif ( $line =~ m{ \A \s* Port \s* = \s* (\d+) \s* \z }xms ) {
                        $config->{Port} = $1;
                    } 
                }
                elsif ( $line =~ m{ \A \s* \[ photobackup \] \s* \z }xms ) {
                    $in_section = 1;
                    next LINE;
                }
                else {
                    next LINE;
                }
            }
            foreach my $key (@required_keys) {
                die "config() config hashref from file '$self->{config_file}' missing '$key'. Got " . Dumper($config) unless $config->{$key};
            }
        }
    }
    return $config;
}

=head2 run()

Launch the PhotoBackup web service using config from the conf file.

=cut

sub run {
    my $self = shift;

    $self->init unless $self->config;

    my $config = $self->config;

    my $runner = Plack::Runner->new(
        daemonize  => $self->{daemonize},
        env        => $self->{env},
        server     => 'Starman',
        version_cb => \&version
    );
    $runner->parse_options(
        '--port'      => $config->{Port},
        '--workers'   => $self->{workers},
        '--pid'       => $self->{pid},
    );
    $runner->run( $self->app );
     
}

=head2 stop()

Kill any running PhotoBackup web service.

=cut

sub stop {
    my $self = shift;

    return unless -f $self->{pid};

    my $pid = do { local( @ARGV, $/ ) = $self->{pid} ; <> };
    chomp $pid;

    kill 'TERM', $pid if $pid;

    unlink $self->{pid};
}

=head2 app()

Return the PSGI application subref.

=cut

sub app {
    my $self = shift;
    my $config = shift || $self->config;

    return sub {
        my $env = shift; # PSGI env
 
        my $req       = Plack::Request->new($env);
        my $path_info = $req->path_info;
        my $method    = $req->method;
        my $post_vars = $req->body_parameters;

        if ( $path_info eq '' || $path_info eq '/' ) {
            if ( $method eq 'GET' ) {
                # GET / : Redirect to https://photobackup.github.io/
                return [301, [ Location => 'https://photobackup.github.io/' ], []];
            }
            elsif ( $method eq 'POST' ) {
                # POST / : Store new image file in MediaRoot. Needs password.
                if ( ! length $post_vars->{password} || $post_vars->{password} ne $config->{Password} ) {
                    return [ 403, [], [ "403 - wrong password!" ] ];
                }
                my $upload = $req->uploads->{upfile};
                if ( ! $upload || ! -f $upload->path ) {      
                    return [ 401, [], [ "401 - no file in the request!" ] ];
                }
                my $filesize = $req->body_parameters->{filesize};
                if ( ! $filesize ) {
                    return [ 400, [], [ "400 - missing file size in the request!" ] ];
                }
                my $store_path = File::Spec->catfile($config->{MediaRoot}, $upload->basename);
                File::Copy::move $upload->path, $store_path; 

                return [ 200, [], [ "200 - file stored" ] ];

            }
        }
        elsif ( $path_info eq '/test' ) {
            # POST /test : Check password, then attempt to write test file to MediaRoot.
            if ( ! length $post_vars->{password} || $post_vars->{password} ne $config->{Password} ) {
                return [ 403, [], [ "403 - wrong password!"]];
            }
            if ( ! -d $config->{MediaRoot} ) {
                return [ 500, [], [ "500 - MediaRoot '$config->{MediaRoot}' does not exist" ]];
            }
            my $tmp_file = File::Spec->catfile($config->{MediaRoot}, '__photobackup_test_file_' . $$);
            try {