Semece.psgi.orig

   1 #!/usr/bin/env perl
   2 #
   3 # Copyright (c) 2010 Abel Abraham Camarillo Ojeda <acamari@verlet.org>
   4 #
   5 # Permission to use, copy, modify, and distribute this software for any
   6 # purpose with or without fee is hereby granted, provided that the above
   7 # copyright notice and this permission notice appear in all copies.
   8 #
   9 # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
  10 # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
  11 # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
  12 # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
  13 # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
  14 # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
  15 # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  16 #
  17
  18 # PSGI entry point and configuration file.
  19 # Please copy this file as 'Semece.psgi', and edit it!.
  20
  21 my $semece      = undef;
  22 my $conf        = undef;
  23
  24 sub setconf;
  25 sub grow_inc;
  26
  27 ######################
  28 # USER CONFIGURATION #
  29 ######################
  30 sub setconf {
  31 # About filesystem paths.
  32 $conf = {
  33         # Absolute filesystem path to the current dir. (No default value)
  34         srcd            => "",
  35         # Absolute filesystem path to the data dir. (No default value)
  36         postd           => "",
  37         # Absolute filesystem path to the user dir. (Default: /home/)
  38         userd           => '/home/'
  39 };
  40
  41 # About content.
  42 $conf = { %$conf,
  43         # Suffix for markdown files (default: ".mkd")
  44         mkd_sufx        => ".mkd",
  45         # Index file: file to parse when a user request the parent directory.
  46         # (default: "index.mkd")
  47         mkd_idx         => "index.mkd",
  48         #  Markdown content type: default content-type for markdown.
  49         mkd_ct          => "text/plain; charset=UTF-8;",
  50         # Content-Type for plain text: Content-Type header to show when we are
  51         # returning plain text to the user. (default: "text/plain;
  52         # charset=UTF-8")
  53         plain_ct        => "text/plain; charset=UTF-8;",
  54         # Content-Type for HTML: Content-Type header to show when we are
  55         # returning HTML to the user. (default: "text/html; charset=UTF-8")
  56         html_ct         => "text/html; charset=UTF-8;",
  57         # Fallback Content-Type: when I cannot determine which one to use.
  58         fb_ct           => "application/octect-stream",
  59 };
  60
  61 # URI to filesystem resolution "table"; this _must_ be an array ref. We travel
  62 # this array using it as a hash (getting a key and value pair (so this array ref
  63 # _must_ have an even number of elements)). First, we match an URI against the
  64 # "key" of this "hash", if it matches, then we look into the hash "value" (which
  65 # must be a true hash ref) for a key named "fs" which declares an anonymous
  66 # subroutine which is run with two arguments: the original URI, and the regex
  67 # that matched it; this subroutine must return an string value, and it must be
  68 # the filesystem path corresponding to that URI.
  69 #   You are free to implement your URI to filesystem translation
  70 # however you like (but be sure to not insert any '..', or any other insecure
  71 # shit).
  72 $conf->{uri2fs}         = [
  73                 qr!^/static$|^/static/! => {
  74                         name    => "static",
  75                         fs      => sub {
  76                                 my ($uri, $regex) = @_;
  77                                 return $conf->{srcd}. $uri;
  78                         }
  79                 },
  80                 qr!^/~([[:alnum:]_]+)!  => {
  81                         name    => "userdir",
  82                         fs      => sub {
  83                                 my ($uri, $regex) = @_;
  84                                 my ($user) = $uri =~ $regex;
  85                                 die "\$user mustn't be undef!, stopped"
  86                                     unless $user;
  87                                 $uri =~ s/$regex//;
  88                                 return $conf->{userd}. "/". $user.
  89                                        "/".  "public_html/".  $uri;
  90                         }
  91                 },
  92                 qr!^/.*$!       => {
  93                         name    => "postd",
  94                         fs      => sub {
  95                                 my ($uri, $regex) = @_;
  96                                 return $conf->{postd}. "/". $uri;
  97                         }
  98                 },
  99 ];
 100
 101 $conf;
 102 }
 103
 104 ##############
 105 # DON'T EDIT #
 106 ##############
 107 sub checkconf {
 108         my $conf = shift;
 109         if (not defined($conf->{srcd})) {
 110                 die "ERROR: \$conf->{srcd} mustn't be undef!, stopped";
 111         } elsif (not $conf->{srcd}) {
 112                 die "ERROR: \$conf->{srcd} mustn't be empty!, stopped";
 113         }
 114         return $conf;
 115 }
 116
 117
 118 # Adds $conf->{srcd} to the search path for libraries, this must be done at
 119 # compiling time.
 120 sub grow_inc {unshift(@INC, $conf->{srcd}. "/lib")}
 121 BEGIN {$conf = checkconf(setconf()); grow_inc();}
 122
 123 # PSGI entry point.
 124 $semece = sub {
 125         my $env         = shift;
 126
 127         # XXX: The $conf set in the BEGIN is lost for unknown reasons...
 128         $conf = setconf();
 129
 130         use Semece;
 131         $env->{"semece.conf"} = $conf;
 132         return &Semece::serv($env);
 133 }
 134