AxKit2

 view release on metacpan or  search on metacpan

lib/AxKit2/Plugin.pm  view on Meta::CPAN

read is performed as soon as possible before the API call returns. This may take
very little CPU time because the OS has to wait until the disk head is in the
correct position to perform the actions requested. But it does take "clock" time
which can be put to better use responding to other requests.

In asynchronous I/O the action is requested and a callback is provided to
be called when the action has occured. This allows the event loop to continue
processing other requests while we are waiting for the disk.

This is better explained with a simple example. For this example we'll take the
C<stat()> system call in an attempt to find out if the filename we are
requesting is a directory or not. In perl we would normally perform this with
the following code:

    sub hook_response {
        my $self = shift;
        my $filename = $self->client->headers_in->filename;
        if (-d $filename) {
            ....
        }
        $self->do_something_else();

plugins/aio/serve_file  view on Meta::CPAN

    
    my $client = $self->client;
    
    if ($hd->request_method eq 'GET' || $hd->request_method eq 'HEAD') {
        # and once we have it, start serving
        $self->client->watch_read(0);
        
        my $file = $hd->filename;
        $self->log(LOGINFO, "Serving file: $file");
        
        IO::AIO::aio_stat($file, sub {
            #print "STAT returned\n";
            if (!-e _) {
                $client->notes('serve_file_retcode', NOT_FOUND);
                return $client->finish_continuation;
            }
            
            # we only serve files here...
            if (!-f _) {
                $client->notes('serve_file_retcode', BAD_REQUEST);
                return $client->finish_continuation;
            }
            
            my $mtime = http_date((stat(_))[9]);
            my $ifmod = $client->headers_in->header('If-Modified-Since') || "";
            
            my $ifmod_len = 0;
            if ($ifmod =~ s/; length=(\d+)//) {
                $ifmod_len = $1;
            }
            
            my $modified = $ifmod ? ($ifmod ne $mtime) : 1;
            
            my $size = -s _;

plugins/aio/uri_to_file  view on Meta::CPAN

    my @path = (splitdir($dir),split(/\//,$uri));

    my $i = -1;

    # save these so they get locked in for the closure.
    my $client   = $self->client;
    my $config   = $self->config;
    my $dirindex = $self->config('dirindex');

# $self->log(LOGCRIT, __LINE__ . " ...");
    IO::AIO::aio_stat(catpath($volume,catdir(@path),''), sub {
        if (-d _) {
            $i = @path-1;
            if ($original_uri =~ m/\/$/) {
                if (defined $dirindex) {
                    my $filepath = catpath($volume, catdir(@path), $dirindex);
                    IO::AIO::aio_stat($filepath, sub {
                        if (-f _) {
                            push @path, $dirindex;
                        }
                        $self->setup_paths($hd, $volume, \@path, $i, $uri, $original_uri);
                        return $client->finish_continuation;
                    });
                }
            }
            else {
                $client->notes('need_redirect', 1);

plugins/aio/uri_to_file  view on Meta::CPAN

                    return $client->finish_continuation;
                }
                if ($path && -e _) {
                    # entity exists
                    $i++ if -d _;
                    $self->setup_paths($hd, $volume, \@path, $i, $uri, $original_uri);
                    return $client->finish_continuation;
                }
                $i--;
                $path = catdir(@path[0..$i+1]);
                IO::AIO::aio_stat(catpath($volume, $path, ''), $sub);
            };
            $sub->();
        }
    });
    
    return CONTINUATION;
}

sub setup_paths {
    my $self = shift;

plugins/demo/gallery  view on Meta::CPAN

    
    if ($size eq 'thumb') {
        $size = $sizes[0];
    }
    else {
        $size = $sizes[1] unless grep { $_ eq $size } @sizes;
    }
    
    my $cache = $self->cache;
    if (my $cache_obj = $cache->get_object("$file+$size")) {
        if ($cache_obj->get_created_at() >= (stat($file))[9]) {
            my $out = $cache->get("$file+$size");
            $self->log(LOGINFO, "Serving cached image");
            $client->headers_out->header('Content-Length', bytelength($out));
            $client->headers_out->header('Content-Type', $ct);
            $client->send_http_headers;
            # using ->get here makes sure Cache::Cache expires stuff
            $client->write(\$out);
            return OK;
        }
    }

plugins/demo/gallery  view on Meta::CPAN

        or die "Cannot write to scalar: ", $thumb->errstr;
}

sub serve_image_page {
    my ($self, $input, $ct) = @_;
    
    $self->log(LOGINFO, "Serving Imagesheet");
    
    my $file = $self->client->headers_in->filename;
    
    my $filesize = (stat($file))[7];
    my $mod  = (stat(_))[9];
    
    my $path;
    ($path, $file) = $file =~ /(.*)\/(.*)/;    # Extract the path/file info
    
    my $mm = File::MMagic->new;
    
    opendir(DIR, $path);
    my ($prev, $next);
    my $found = 0;
    for my $entry (sort readdir(DIR)) {

plugins/dir_to_xml  view on Meta::CPAN

    
    opendir(DIR, $dir) || die "opendir($dir): $!";
    
    my $output = '<?xml version="1.0" encoding="UTF-8"?>
<filelist xmlns="http://axkit.org/2002/filelist">
';
    for my $line (sort readdir(DIR)) {
        my $xmlline = _to_utf8($enc, $line);
        $xmlline =~ s/&/&amp;/;
        $xmlline =~ s/</&lt;/;
        my @stat = stat(catfile($dir,$line));
        no warnings 'uninitialized';
        my $attr = "size=\"$stat[7]\" atime=\"$stat[8]\" mtime=\"$stat[9]\" ctime=\"$stat[10]\"";
        $attr .= ' readable="1"' if (-r _);
        $attr .= ' writable="1"' if (-w _);
        $attr .= ' executable="1"' if (-x _);
        
        if (-f _) {
            $output .= "<file $attr>$xmlline</file>\n";
        } elsif (-d _) {
            $output .= "<directory $attr>$xmlline</directory>\n";

plugins/serve_dir  view on Meta::CPAN

    $uri =~ s/\/$//;
    my $parent = $uri;
    $parent =~ s/[^\/]*$//;
    
    $uri = '/' unless length($uri);
    
    $self->log(LOGINFO, "Attempting to serve dir: $file");
    if (!-d $file) {
        return DECLINED;
    }
    my $mtime = http_date((stat(_))[9]);
    
    if (!opendir(DIR, $file)) {
        $self->log(LOGERROR, "opendir($file) failed: $!");
        return FORBIDDEN;
    }
    
    $client->headers_out->header('Content-Type', "text/html");
    $client->headers_out->header("Last-Modified", $mtime);
    $client->send_http_headers;
    

plugins/serve_dir  view on Meta::CPAN

    }
}

use File::Spec::Functions qw(catfile);

sub augment {
    my $self = shift;
    my $dir  = shift;
    
    if (@_ == 1 && $_[0] eq '..') {
        stat($dir);
        return [ '..', (stat(_))[9], -s _, $self->describe('..'), -d _ ];
    }
    
    return 
        map { my $f = catfile($dir, $_); stat($f);
              [ $_, (stat(_))[9], -s _, $self->describe($f), -d _ ]; }
        grep { !/^\./ } 
        grep { !$self->ignored($_) } @_;
}

sub ignored {
    my ($self, $file) = @_;
    
    # TODO: Decide what files are ignored.
    return 0;
}

plugins/serve_file  view on Meta::CPAN

    my $ct = $hd->mime_type;
    my $client = $self->client;
    
    if ($hd->request_method eq 'GET' || $hd->request_method eq 'HEAD') {
        # and once we have it, start serving
        $client->watch_read(0);
        
        my $file = $hd->filename;
        $self->log(LOGINFO, "Serving file: $file");
        if (open(my $fh, $file)) {
            stat($fh);
            
            if (!-f _) {
                return BAD_REQUEST;
            }
            
            my $mtime = http_date((stat(_))[9]);
            my $ifmod = $client->headers_in->header('If-Modified-Since') || "";
            
            my $ifmod_len = 0;
            if ($ifmod =~ s/; length=(\d+)//) {
                $ifmod_len = $1;
            }
            
            my $modified = $ifmod ? ($ifmod ne $mtime) : 1;
            
            my $size = -s _;