Ark

 view release on metacpan or  search on metacpan

lib/Ark/Models.pm  view on Meta::CPAN

    }
    else {
        if ($pkg eq __PACKAGE__) {
            die q[Don't use Ark::Model directly. You must create your own subclasses];
        }

        $pkg->initialize;
    }

    unshift @_, $pkg, $flag;
#    goto $pkg->can('SUPER::import');
    goto &Object::Container::import; # Some perl does not run avobe code, this is a quick fix for it.
}

sub initialize {
    my $pkg = shift;

    # build-in models: home, conf
    $pkg->register(
        home => sub {
            return dir($ENV{ARK_HOME}) if $ENV{ARK_HOME};

lib/Ark/Models.pm  view on Meta::CPAN

    while (my ($name, $ns) = each %namespaces) {
        $self->registered_namespaces->{ $name } = $ns;
    }
}

sub get {
    my $self = shift;
    $self    = $self->instance unless ref $self;

    my $obj  = eval { $self->SUPER::get(@_) };
    my $err  = $@;

    return $obj if $obj;

    my $target = $_[0];
    if ($target =~ /::/) {
        my ($ns, @classes);
        while ($target =~ s/::(.*?)$//) {
            unshift @classes, $1;
            $ns = $self->registered_namespaces->{$target} and last;

lib/Ark/Request.pm  view on Meta::CPAN

sub wrap {
    my ($class, $req) = @_;

    warn 'Ark::Request#wrap is deprecated. use new() directory instead';
    return $class->new( $req->env );
}

sub uri {
    my $self = shift;

    $self->{uri} ||= $self->SUPER::uri;
    $self->{uri}->clone; # avoid destructive opearation
}

sub base {
    my $self = shift;

    $self->{base} ||= $self->SUPER::base;
    $self->{base}->clone; # avoid destructive operation
}

sub uri_with {
    my ($self, $args) = @_;

    my $uri = $self->uri;

    my %params = $uri->query_form;
    while (my ($k, $v) = each %$args) {

lib/Ark/Response.pm  view on Meta::CPAN

    is  => 'rw',
    isa => 'CodeRef',
);

no Mouse;

sub finalize {
    my $self = shift;

    if (!$self->is_deferred && !$self->is_streaming) {
        return $self->SUPER::finalize;
    }

    my $headers = $self->headers->clone;
    $self->_finalize_cookies($headers);

    if ($self->is_deferred) {
        if (my $cb = $self->deferred_response) {
            my $body = $self->_body;

            my $response = [

t/form/lib/T/Form/Login.pm  view on Meta::CPAN

        password => $form->param('password'),
    );

    unless ($user) {
        $form->set_error( login => 'failed' );
    }
}

sub messages {
    return {
        %{ shift->SUPER::messages },
        'login.failed' => 'username or password is wrong',
    };
}

1;