File Coverage

blib/lib/Wurm.pm

Criterion	Covered	Total	%
statement	74	83	89.1
branch	32	52	61.5
condition	4	13	30.7
subroutine	18	24	75.0
pod	3	3	100.0
total	131	175	74.8

package Wurm;

use strict;
use warnings;
use v5.20;

use Scalar::Util qw();

our $VERSION = '0.0.7';

sub import {
  my ($class, @symbols) = @_;

  my %symbols = map {$_ => 1} @symbols;

  require $class. '/mob.pm' if $symbols{mob};
  require $class. '/let.pm' if $symbols{let};
}

sub wrapp {
  my ($wurm, $mind) = @_;

  $wurm        //= { };
  $wurm->{mob} //= exists $INC{'Wurm/mob.pm'};

  my $case = _ncase($wurm->{case}, $wurm->{mob});
  my $pore = _upore($wurm->{pore});
  my $app  = sub {
    my $env  = shift;
    my $log  = defined $env->{'psgix.logger'}
      ? $env->{'psgix.logger'}
      : sub { }
    ;
    my $meal = $case->({
      env  => $env,
      log  => $log,
      tube => $env->{PATH_INFO},
      mind => $mind,
      seen => '',
      grit => { },
      vent => { },
      view => undef,
    });
    return $pore->(fold($meal, $wurm), $meal);
  };

  return wantarray ? ($app, $wurm) : $app;
}

sub _ncase {
  my $wrap = shift;
  my $mob  = shift;

  return defined $wrap
  ? sub {
      my $meal = shift;
      $meal->{tube} =~ s#\A/##;
      return $wrap->($mob ? Wurm::mob->new($meal) : $meal);
    }
  : sub {
      my $meal = shift;
      $meal->{tube} =~ s#\A/##;
      return $mob ? Wurm::mob->new($meal) : $meal;
    }
  ;
}

sub _upore {
  my $wrap = shift;

  return defined $wrap
  ? sub {
      my $cast = $wrap->(@_) // _404();
      return Scalar::Util::blessed($cast) ? $cast->finalize : $cast;
    }
  : sub {
      my $cast = shift // _404();
      return Scalar::Util::blessed($cast) ? $cast->finalize : $cast;
    }
  ;
}

# Guild and its navigators, who the spice has mutated over 4,000 years,
# use the orange spice gas, which gives them the ability to fold space.
# We, however, are just folding tubes.
sub fold {
  my ($meal, $wurm) = @_;

  die "unable to fold (imaginary wurm)\n" unless defined $wurm;
  die "unable to fold (mangled wurm)\n"   unless 'HASH' eq ref $wurm;

  if(defined $wurm->{gate}) {
    my $res = $wurm->{gate}->($meal);
    return $res
      if defined $res;
  }

  if(($meal->{tube} // '') ne '') {
    my $atom = bend($meal);
    return _404()
      unless defined $atom;

    my $tube = $wurm->{tube}{$atom};
    return _404()
      unless defined $tube;

    # malkovich?
    my $res = fold($meal, $tube);
    return $res
      if defined $res;
  }

  if(defined $wurm->{neck}) {
    my $res = $wurm->{neck}->($meal);
    return $res
      if defined $res;
  }

  if(defined $wurm->{body}) {
    my $method = lc $meal->{env}{REQUEST_METHOD};
    my $body   = $wurm->{body}{$method};
    if(defined $body) {
      my $res = $body->($meal);
      return $res
        if defined $res;
    }
  }

  if(defined $wurm->{tail}) {
    my $res = $wurm->{tail}->($meal);
    return $res
      if defined $res;
  }

  return _404();
}

# There is no spoon.  There are a series of tubes.  Bendy ones.
sub bend {
  my ($meal) = @_;

  $meal->{tube} =~ s#\A(?[^/]+)(?:/|\z)##
    or return;
  $meal->{seen} .= "$+{atom}/";
  return $+{atom};
}

# Happy, happy.  Joy, joy.
sub _200 {[200, ['Content-Type' => $_[0]], [$_[1]]]}

#
sub _201 {[201, ['Location' => $_[0]], []]}

# There can be only none!
sub _204 {[204, [], []]}

# One pluseth two verily to thus be thine six hundreds and three, sir.
sub _301 {[301, ['Location' => $_[0]], []]}
sub _302 {[302, ['Location' => $_[0]], []]}

# Down in a hole.  Losing my soul.
sub _400 {[400, ['Content-Type', 'text/plain'], ['.oOo.']]}

# Istanbul is Constantinople.
sub _404 {[404, ['Content-Type' => 'text/plain'], ['Not Found']]}

# My eyes.  The goggles do nothing.
sub _500 {[500, ['Content-Type' => 'text/plain'], ['Internal Server Error']]}

'.oOo.' # in wurm i trust
__END__