lib/Semece/Tool.pm

   1 package Semece::Tool;
   2
   3 # Copyright (c) 2010 Abel Abraham Camarillo Ojeda <acamari@the00z.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 # Stores common functions
  18
  19 use Carp;
  20 # get short uri
  21 # get $q->uri minus $q->location
  22 sub
  23 g_suri
  24 {
  25         my $q           = shift;
  26
  27         my $uri         = undef;        # stores short uri
  28
  29         $uri = substr $q->uri, (length &g_location($q));
  30         $uri =~ s!/+!/!g;       # normalization
  31
  32         print STDERR "g_suri: da suri (", $uri, ")\n";
  33
  34         return $uri;
  35 }
  36
  37 # returns the postd (fs directory where the posts are)
  38 sub
  39 g_postd
  40 {
  41         my $q           = shift;
  42
  43         # reads SemecePostd from apache configuration
  44         if (my $tmp = $q->dir_config('SemecePostd')) {
  45                 # sends directory names without final slash
  46                 $tmp =~ s!/+$!!;
  47                 return $tmp;
  48         } else {
  49                 print STDERR "keys:", (join(',', keys %ENV)), "\n";
  50                 croak "I cannot get SemecePostd, stopped";
  51                 return undef;   # NOTREACHED
  52         }
  53         # NOTREACHED
  54 }
  55
  56
  57 # returns the <Location > from the apache conf
  58 sub
  59 g_location
  60 {
  61         my $q           = shift;
  62
  63
  64         # reads Current Working Dir from apache configuration
  65         if (my $tmp = $q->location) {
  66                 print STDERR "g_location: location ($tmp)\n";
  67                 # sends directory names without final slash
  68                 $tmp =~ s!/+$!!;
  69                 return $tmp;
  70         } else {
  71                 croak "I cannot get Location, stopped";
  72                 return undef;
  73                 # NOTREACHED
  74         }
  75         # NOTREACHED
  76 }
  77
  78 1;