App-Dochazka-REST
view release on metacpan or search on metacpan
config/sql/component_Config.pm view on Meta::CPAN
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
# *************************************************************************
#
# sql/component_Config.pm
#
# SQL statements related to components
#
set( 'SQL_COMPONENT_SELECT_ALL', q/
SELECT cid, path, source, acl, validations
FROM components
/ );
#
set( 'SQL_COMPONENT_SELECT_ALL_NO_SOURCE', q/
SELECT cid, path, acl, validations
FROM components
/ );
#
set( 'SQL_COMPONENT_SELECT_BY_CID', q/
SELECT cid, path, source, acl, validations
FROM components WHERE cid = ?
/ );
#
set( 'SQL_COMPONENT_SELECT_BY_PATH', q/
SELECT cid, path, source, acl, validations
FROM components WHERE path = ?
/ );
#
set( 'SQL_COMPONENT_INSERT', q/
INSERT INTO components
(path, source, acl, validations)
VALUES (?, ?, ?, ?)
RETURNING cid, path, source, acl, validations
/ );
set( 'SQL_COMPONENT_UPDATE', q/
UPDATE components
SET path = ?, source = ?, acl = ?, validations = ?
WHERE cid = ?
RETURNING cid, path, source, acl, validations
/ );
set( 'SQL_COMPONENT_DELETE', q/
DELETE FROM components
WHERE cid = ?
RETURNING cid, path, source, acl, validations
/ );
# -----------------------------------
# DO NOT EDIT ANYTHING BELOW THIS LINE
# -----------------------------------
use strict;
use warnings;
1;
config/sql/dbinit_Config.pm view on Meta::CPAN
q/CREATE TRIGGER code_to_upper BEFORE INSERT OR UPDATE ON activities
FOR EACH ROW EXECUTE PROCEDURE code_to_upper()/,
q/CREATE TRIGGER disabled_to_zero BEFORE INSERT OR UPDATE ON activities
FOR EACH ROW EXECUTE PROCEDURE disabled_to_zero()/,
# the 'components' table
q#-- components
CREATE TABLE components (
cid serial PRIMARY KEY,
path varchar(2048) UNIQUE NOT NULL,
source text NOT NULL,
acl varchar(16) NOT NULL,
validations text,
CONSTRAINT kosher_path CHECK (path ~* '^[[:alnum:]_.][[:alnum:]_/.-]+$')
)#,
q/-- trigger function to make 'cid' field immutable
CREATE OR REPLACE FUNCTION cid_immutable() RETURNS trigger AS $IMM$
BEGIN
IF OLD.cid <> NEW.cid THEN
RAISE EXCEPTION 'components.cid field is immutable';
END IF;
RETURN NEW;
END;
$IMM$ LANGUAGE plpgsql/,
q/-- trigger the trigger
CREATE TRIGGER no_cid_update BEFORE UPDATE ON components
FOR EACH ROW EXECUTE PROCEDURE cid_immutable()/,
# the 'intervals' table
q/-- intervals
CREATE TABLE IF NOT EXISTS intervals (
iid serial PRIMARY KEY,
eid integer REFERENCES employees (eid) NOT NULL,
aid integer REFERENCES activities (aid) NOT NULL,
intvl tstzrange NOT NULL,
long_desc text,
lib/App/Dochazka/REST/Dispatch.pm view on Meta::CPAN
# first pass
return 1 if $pass == 1 ;
# second pass
return App::Dochazka::REST::Model::Component::get_all_components(
$self->context->{'dbix_conn'},
);
}
=head3 handler_post_component_cid
Handler for 'POST component/cid' resource.
=cut
sub handler_post_component_cid {
my ( $self, $pass ) = @_;
$log->debug( "Entering " . __PACKAGE__ . "::handler_post_component_cid" );
# first pass
return 1 if $pass == 1;
# second pass
# - check that entity is kosher
my $status = shared_entity_check( $self, 'cid' );
return $status unless $status->ok;
my $context = $self->context;
my $entity = $context->{'request_entity'};
# - get cid and look it up
my $cid = $entity->{'cid'};
my $comp = shared_first_pass_lookup( $self, 'CID', $cid );
return $fail unless $cid;
# - perform the update
return shared_update_component( $self, $comp, $entity );
}
=head3 handler_post_component_path
Handler for 'POST component/path' resource. This is a little more complicated
because it can be either create or modify.
lib/App/Dochazka/REST/Dispatch.pm view on Meta::CPAN
if ( $comp ) {
return shared_update_component( $self, $comp, $entity );
} else {
my $status = shared_entity_check( $self, 'path', 'source', 'acl' );
return $status unless $status->ok;
return shared_insert_component( $self, $path, $entity );
}
}
=head3 handler_component_cid
Handler for the 'component/cid/:cid' resource.
=cut
sub handler_component_cid {
my ( $self, $pass ) = @_;
$log->debug( "Entering " . __PACKAGE__ . "::handler_component_cid" );
my $context = $self->context;
# first pass
if ( $pass == 1 ) {
my $comp = shared_first_pass_lookup( $self, 'cid', $context->{'mapping'}->{'cid'} );
return 0 unless $comp;
$context->{'stashed_component_object'} = $comp;
return 1;
}
# second pass
if ( $context->{'method'} eq 'GET' ) {
return $CELL->status_ok( 'DISPATCH_COMPONENT_FOUND',
payload => $context->{'stashed_component_object'}
);
lib/App/Dochazka/REST/Docs/Resources.pm view on Meta::CPAN
=over
Allowed methods: GET
Retrieves all component objects in the database.
=back
=head2 C<< component/cid >>
=over
Allowed methods: POST
Enables existing component objects to be updated by sending a POST request to
the REST server. Along with the properties to be modified, the request body
must include an 'cid' property, the value of which specifies the cid to be
updated.
=back
=head2 C<< component/cid/:cid >>
=over
Allowed methods: DELETE, GET, PUT
This resource allows the user to GET, PUT, or DELETE an component object by its
cid.
=over
=item * GET
Retrieves an component object by its cid.
=item * PUT
Updates the component object whose cid is specified by the ':cid' URI parameter.
The fields to be updated and their new values should be sent in the request
body, e.g., like this:
{ "path" : "new/path", "source" : "new source", "acl" : "inactive" }
=item * DELETE
Deletes the component object whose cid is specified by the ':cid' URI parameter.
This will work only if nothing in the database refers to this component.
=back
=back
=head2 C<< component/path >>
lib/App/Dochazka/REST/Model/Component.pm view on Meta::CPAN
...
=head1 DATA MODEL
=head2 Components in the database
CREATE TABLE components (
cid serial PRIMARY KEY,
path varchar(2048) UNIQUE NOT NULL,
source text NOT NULL,
acl varchar(16) NOT NULL,
validations textj
)
=head2 Components in the Perl API
=over
=item * constructor (L<spawn>)
=item * basic accessors (L<cid>, L<path>, L<source>, L<acl>, L<validations>)
=item * L<reset> (recycles an existing object by setting it to desired state)
=item * L<TO_JSON> (returns 'unblessed' version of an Activity object)
=item * L<compare> (compare two objects)
=item * L<clone> (clone an object)
=item * L<insert> (inserts object into database)
=item * L<update> (updates database to match the object)
=item * L<delete> (deletes record from database if nothing references it)
=item * L<load_by_cid> (loads a single activity into an object)
=item * L<load_by_path> (loads a single activity into an object)
=back
L<App::Dochazka::REST::Model::Component> also exports some convenience
functions:
=over
=item * L<cid_exists> (boolean function)
=item * L<path_exists> (boolean function)
=item * L<cid_by_path> (given a path, returns CID)
=item * L<get_all_components> (self-explanatory)
=back
For basic C<component> object workflow, see the unit tests in
C<t/model/component.t>.
=cut
use Exporter qw( import );
our @EXPORT_OK = qw( cid_exists path_exists cid_by_path get_all_components );
=head1 METHODS
=head2 insert
Instance method. Takes the object, as it is, and attempts to insert it into
lib/App/Dochazka/REST/Model/Component.pm view on Meta::CPAN
Returns status object.
=cut
sub update {
my $self = shift;
my ( $context ) = validate_pos( @_, { type => HASHREF } );
return $CELL->status_err( 'DOCHAZKA_MALFORMED_400' ) unless
(
$self->{'cid'} and
(
$self->{'path'} or $self->{'source'} or $self->{'acl'}
)
);
return $CELL->status_err( 'DOCHAZKA_MALFORMED_400' ) if
(
$self->{'acl'} and not scalar(
grep { $self->{'acl'} eq $_ } ( 'admin', 'active', 'inactive', 'passerby' )
)
);
my $status = cud(
conn => $context->{'dbix_conn'},
eid => $context->{'current'}->{'eid'},
object => $self,
sql => $site->SQL_COMPONENT_UPDATE,
attrs => [ 'path', 'source', 'acl', 'validations', 'cid' ],
);
$self->create_file if $status->ok;
return $status;
}
=head2 delete
lib/App/Dochazka/REST/Model/Component.pm view on Meta::CPAN
sub delete {
my $self = shift;
my ( $context ) = validate_pos( @_, { type => HASHREF } );
my $status = cud(
conn => $context->{'dbix_conn'},
eid => $context->{'current'}->{'eid'},
object => $self,
sql => $site->SQL_COMPONENT_DELETE,
attrs => [ 'cid' ],
);
if ( $status->ok ) {
$self->delete_file;
$self->reset( cid => $self->{cid} );
}
return $status;
}
=head2 load_by_cid
Loads component from database, by the CID provided in the argument list,
into a newly-spawned object. The CID must be an exact match. Returns a
status object: if the object is loaded, the status code will be
'DISPATCH_RECORDS_FOUND' and the object will be in the payload; if
the CID is not found in the database, the status code will be
'DISPATCH_NO_RECORDS_FOUND'. A non-OK status indicates a DBI error.
=cut
sub load_by_cid {
my $self = shift;
my ( $conn, $cid ) = validate_pos( @_,
{ isa => 'DBIx::Connector' },
{ type => SCALAR },
);
return load(
conn => $conn,
class => __PACKAGE__,
sql => $site->SQL_COMPONENT_SELECT_BY_CID,
keys => [ $cid ],
);
}
=head2 load_by_path
Analogous method to L<"load_by_cid">.
=cut
sub load_by_path {
my $self = shift;
my ( $conn, $path ) = validate_pos( @_,
{ isa => 'DBIx::Connector' },
{ type => SCALAR },
);
lib/App/Dochazka/REST/Model/Component.pm view on Meta::CPAN
return $interp->run($path, %ARGS)->output;
}
=head1 FUNCTIONS
The following functions are not object methods.
=head2 cid_exists
Boolean function
=head2 path_exists
Boolean function
=cut
BEGIN {
no strict 'refs';
*{'cid_exists'} = App::Dochazka::REST::Model::Shared::make_test_exists( 'cid' );
*{'path_exists'} = App::Dochazka::REST::Model::Shared::make_test_exists( 'path' );
}
=head2 cid_by_path
Given a path, attempt to retrieve the corresponding CID.
Returns CID or undef on failure.
=cut
sub cid_by_path {
my ( $conn, $path ) = validate_pos( @_,
{ isa => 'DBIx::Connector' },
{ type => SCALAR },
);
my $status = __PACKAGE__->load_by_path( $conn, $path );
return $status->payload->{'cid'} if $status->code eq 'DISPATCH_RECORDS_FOUND';
return;
}
=head2 get_all_components
Returns a reference to a hash of hashes, where each hash is one component object.
=cut
lib/App/Dochazka/REST/ResourceDefs.pm view on Meta::CPAN
acl_profile => 'admin',
cli => 'component all',
description => 'Retrieve all component objects',
documentation => <<'EOH',
=pod
Retrieves all component objects in the database.
EOH
},
# /component/cid
'component/cid' =>
{
parent => 'component',
handler => {
POST => 'handler_post_component_cid',
},
acl_profile => 'admin',
cli => 'component cid',
description => 'Update an existing component object via POST request (cid must be included in request body)',
documentation => <<'EOH',
=pod
Enables existing component objects to be updated by sending a POST request to
the REST server. Along with the properties to be modified, the request body
must include an 'cid' property, the value of which specifies the cid to be
updated.
EOH
},
# /component/cid/:cid
'component/cid/:cid' =>
{
parent => 'component',
handler => {
GET => 'handler_component_cid',
PUT => 'handler_component_cid',
DELETE => 'handler_component_cid',
},
acl_profile => 'admin',
cli => 'component cid $cid',
validations => {
'cid' => 'Int',
},
description => 'GET, PUT, or DELETE an component object by its cid',
documentation => <<'EOH',
=pod
This resource allows the user to GET, PUT, or DELETE an component object by its
cid.
=over
=item * GET
Retrieves an component object by its cid.
=item * PUT
Updates the component object whose cid is specified by the ':cid' URI parameter.
The fields to be updated and their new values should be sent in the request
body, e.g., like this:
{ "path" : "new/path", "source" : "new source", "acl" : "inactive" }
=item * DELETE
Deletes the component object whose cid is specified by the ':cid' URI parameter.
This will work only if nothing in the database refers to this component.
=back
EOH
},
# /component/path
'component/path' =>
{
parent => 'component',
handler => {
POST => 'handler_post_component_path',
},
acl_profile => 'admin',
cli => 'component cid',
description => 'Update an existing component object via POST request (component path must be included in request body)',
documentation => <<'EOH',
=pod
This resource enables existing component objects to be updated, and new
component objects to be inserted, by sending a POST request to the REST server.
Along with the properties to be modified/inserted, the request body must
include an 'path' property, the value of which specifies the component to be
updated.
EOH
lib/App/Dochazka/REST/Shared.pm view on Meta::CPAN
my ( $status, $thing );
if ( uc($key) eq 'AID' ) {
$thing = 'activity';
$status = App::Dochazka::REST::Model::Activity->load_by_aid( $conn, $value );
} elsif ( $key eq 'code' ) {
$thing = 'activity';
$status = App::Dochazka::REST::Model::Activity->load_by_code( $conn, $value );
} elsif ( uc($key) eq 'CID' ) {
$thing = 'component';
$status = App::Dochazka::REST::Model::Component->load_by_cid( $conn, $value );
} elsif ( $key eq 'path' ) {
$thing = 'component';
$status = App::Dochazka::REST::Model::Component->load_by_path( $conn, $value );
} elsif ( uc($key) eq 'EID' ) {
$thing = 'employee';
$status = App::Dochazka::REST::Model::Employee->load_by_eid( $conn, $value );
} elsif ( $key eq 'nick' ) {
$thing = 'employee';
$status = App::Dochazka::REST::Model::Employee->load_by_nick( $conn, $value );
} elsif ( $key eq 'sec_id' ) {
lib/App/Dochazka/REST/Shared.pm view on Meta::CPAN
- $comp is a component object (blessed hashref)
- $over is a hashref with zero or more component properties and new values
The values from $over replace those in $comp
=cut
sub shared_update_component {
my ( $d_obj, $comp, $over ) = @_;
$log->debug("Entering " . __PACKAGE__ . "::shared_update_component" );
delete $over->{'cid'} if exists $over->{'cid'};
if ( pre_update_comparison( $comp, $over ) ) {
my $status = $comp->update( $d_obj->context );
return $status unless $status->level eq 'ERR' and $status->code eq 'DOCHAZKA_MALFORMED_400';
}
$d_obj->mrest_declare_status( code => 400, explanation => "DISPATCH_ILLEGAL_ENTITY" );
return $fail;
}
=head2 shared_update_history
lib/App/Dochazka/REST/Test.pm view on Meta::CPAN
}
=head2 delete_testing_component
Tests will need to set up and tear down testing components
=cut
sub delete_testing_component {
my $cid = shift;
my $status = App::Dochazka::REST::Model::Component->load_by_cid( $dbix_conn, $cid );
is( $status->level, 'OK', 'delete_testing_component 1' );
my $act = $status->payload;
$status = $act->delete( $faux_context );
is( $status->level, 'OK', 'delete_testing_component 2' );
return;
}
=head2 test_schedule_model
t/dispatch/component.t view on Meta::CPAN
note( '=============================' );
my $base = 'component/all';
docu_check($test, $base);
note( 'insert an component' );
my $foobar = create_testing_component(
path => 'FOOBAR',
source => 'source code of FOOBAR',
acl => 'passerby'
);
my $cid_of_foobar = $foobar->cid;
ok( path_exists_by_dispatch( "FOOBAR" ) );
ok( path_exists( $dbix_conn, "FOOBAR" ) );
ok( -o File::Spec->catfile( $comp_root, $foobar->path ) );
note( "GET on $base" );
req( $test, 403, 'demo', 'GET', $base );
my $status = req( $test, 200, 'root', 'GET', $base );
is( $status->level, 'OK', "GET $base 2" );
is( $status->code, 'DISPATCH_RECORDS_FOUND', "GET $base 3" );
ok( $status->{count} );
ok( exists $status->{payload}, "GET $base 5" );
ok( scalar @{ $status->payload } );
note( 'testing component is present' );
ok( scalar( grep { $_->{path} eq 'FOOBAR'; } @{ $status->payload } ), "GET $base 7" );
note( 'delete the testing component' );
delete_testing_component( $cid_of_foobar );
ok( ! path_exists_by_dispatch( "FOOBAR" ) );
ok( ! path_exists( $dbix_conn, "FOOBAR" ) );
note( "PUT, POST, DELETE on $base" );
foreach my $method ( 'PUT', 'POST', 'DELETE' ) {
foreach my $user ( 'demo', 'active', 'piggy', 'root' ) {
req( $test, 405, $user, $method, $base );
}
}
note( '========================' );
note( '"component/cid" resource' );
note( '========================' );
$base = 'component/cid';
docu_check($test, "$base");
note( "GET, PUT on $base" );
foreach my $method ( 'GET', 'PUT' ) {
foreach my $user ( 'demo', 'active', 'root', 'WOMBAT5', 'WAMBLE owdkmdf 5**' ) {
req( $test, 405, $user, $method, $base );
}
}
note( "POST on $base" );
my $foowop = create_testing_component( path => 'FOOWOP', source => 'nada', acl => 'passerby' );
my $cid_of_foowop = $foowop->cid;
my $full_path_of_foowop = File::Spec->catfile( $comp_root, $foowop->path );
ok( -o $full_path_of_foowop );
is( "nada", read_file( $full_path_of_foowop ) );
note( 'test if expected behavior behaves as expected (update)' );
my $component_obj = '{ "cid" : ' . $cid_of_foowop . ', "source" : "wop wop ng", "acl" : "inactive" }';
req( $test, 403, 'demo', 'POST', $base, $component_obj );
$status = req( $test, 200, 'root', 'POST', $base, $component_obj );
is( $status->level, 'OK', "POST $base 4" );
is( $status->code, 'DOCHAZKA_CUD_OK', "POST $base 5" );
ok( defined $status->payload );
is( $status->payload->{'acl'}, 'inactive', "POST $base 6" );
is( $status->payload->{'source'}, 'wop wop ng', "POST $base 7" );
ok( -o File::Spec->catfile( $comp_root, $status->payload->{path} ) );
is( $full_path_of_foowop, File::Spec->catfile( $comp_root, $status->payload->{path} ) );
is( "wop wop ng", read_file( $full_path_of_foowop ) );
note( 'non-existent cid and also out of range' );
$component_obj = '{ "cid" : 3434342342342, "source" : 3434341, "acl" : "passerby" }';
dbi_err( $test, 500, 'root', 'POST', $base, $component_obj, qr/out of range for type integer/ );
note( 'non-existent cid' );
$component_obj = '{ "cid" : 342342342, "source" : 3434341, "acl" : "passerby" }';
req( $test, 404, 'root', 'POST', $base, $component_obj );
note( 'throw a couple curve balls' );
my $weirded_object = '{ "copious_turds" : 555, "source" : "wang wang wazoo", "acl" : "passerby" }';
req( $test, 400, 'root', 'POST', $base, $weirded_object );
my $no_closing_bracket = '{ "copious_turds" : 555, "source" : "wang wang wazoo", "acl" : "passerby"';
req( $test, 400, 'root', 'POST', $base, $no_closing_bracket );
$weirded_object = '{ "cid" : "!!!!!", "source" : "down it goes" }';
dbi_err( $test, 500, 'root', 'POST', $base, $weirded_object, qr/invalid input syntax for type integer/ );
my $illegal_acl = '{ "cid" : ' . $cid_of_foowop . ', "path" : "library/machinations.mc", "source" : "wang wang wazoo", "acl" : "puppy" }';
req( $test, 400, 'root', 'POST', $base, $illegal_acl );
note( 'delete the testing component' );
ok( -e $full_path_of_foowop );
delete_testing_component( $cid_of_foowop );
ok( ! -e $full_path_of_foowop );
note( "DELETE on $base" );
req( $test, 405, 'demo', 'DELETE', $base );
req( $test, 405, 'root', 'DELETE', $base );
req( $test, 405, 'WOMBAT5', 'DELETE', $base );
note( '=============================' );
note( '"component/cid/:cid" resource' );
note( '=============================' );
$base = 'component/cid';
docu_check($test, "$base/:cid");
note( 'insert an component and disable it here' );
$foobar = create_testing_component( path => 'FOOBAR', source => 'wombat', acl => 'passerby' );
$cid_of_foobar = $foobar->cid;
my $full_path_of_foobar = File::Spec->catfile( $comp_root, $foobar->path );
ok( -o $full_path_of_foobar );
is( "wombat", read_file( $full_path_of_foobar ) );
note( "GET on $base/:cid" );
note( "fail as demo 403" );
req( $test, 403, 'demo', 'GET', "$base/$cid_of_foobar" );
note( "succeed as root cid_of_foobar" );
$status = req( $test, 200, 'root', 'GET', "$base/$cid_of_foobar" );
ok( $status->ok, "GET $base/:cid 2" );
is( $status->code, 'DISPATCH_COMPONENT_FOUND', "GET $base/:cid 3" );
is_deeply( $status->payload, {
cid => $cid_of_foobar,
path => 'FOOBAR',
source => 'wombat',
acl => 'passerby',
validations => undef,
}, "GET $base/:cid 4" );
note( "fail invalid (non-integer) cid" );
req( $test, 400, 'root', 'GET', "$base/jj" );
note( "fail non-existent cid" );
req( $test, 404, 'root', 'GET', "$base/444" );
note( "PUT on $base/:cid" );
$component_obj = '{ "path" : "FOOBAR", "source" : "The bar of foo", "acl" : "inactive" }';
# - test with demo fail 403
req( $test, 403, 'demo', 'PUT', "$base/$cid_of_foobar", $component_obj );
note( 'test with root (successful update)' );
$status = req( $test, 200, 'root', 'PUT', "$base/$cid_of_foobar", $component_obj );
is( $status->level, 'OK', "PUT $base/:cid 3" );
is( $status->code, 'DOCHAZKA_CUD_OK', "PUT $base/:cid 4" );
is( ref( $status->payload ), 'HASH', "PUT $base/:cid 5" );
is( $status->payload->{path}, 'FOOBAR' );
is( $status->payload->{source}, 'The bar of foo' );
is( $status->payload->{acl}, 'inactive' );
is( "The bar of foo", read_file( $full_path_of_foobar ) );
note( 'change ACL to active' );
$status = req( $test, 200, 'root', 'PUT', "$base/$cid_of_foobar", '{ "acl":"active" }' );
is( $status->level, 'OK' );
is( $status->code, 'DOCHAZKA_CUD_OK' );
is( ref( $status->payload ), 'HASH' );
is( $status->payload->{path}, 'FOOBAR' );
is( $status->payload->{source}, 'The bar of foo' );
is( $status->payload->{acl}, 'active' );
is( "The bar of foo", read_file( $full_path_of_foobar ) );
note( 'attempt ot change ACL to an illegal value' );
req( $test, 400, 'root', 'PUT', "$base/$cid_of_foobar", '{ "acl":"puppy" }' );
note( 'make an component object out of the payload' );
$foobar = App::Dochazka::REST::Model::Component->spawn( $status->payload );
is( $foobar->source, "The bar of foo", "PUT $base/:cid 5" );
is( $foobar->acl, "active", "PUT $base/:cid 6" );
note( 'test with root no request body' );
req( $test, 400, 'root', 'PUT', "$base/$cid_of_foobar" );
note( 'test with root fail invalid JSON' );
req( $test, 400, 'root', 'PUT', "$base/$cid_of_foobar", '{ asdf' );
note( 'test with root fail invalid cid' );
req( $test, 400, 'root', 'PUT', "$base/asdf", '{ "legal":"json" }' );
note( 'with valid JSON that is not what we are expecting' );
req( $test, 400, 'root', 'PUT', "$base/$cid_of_foobar", '0' );
note( 'with valid JSON that has some bogus properties' );
req( $test, 400, 'root', 'PUT', "$base/$cid_of_foobar", '{ "legal":"json" }' );
req( $test, 400, 'root', 'PUT', "$base/$cid_of_foobar", '{ "aid":"json" }' );
note( "POST on $base/:cid" );
req( $test, 405, 'demo', 'POST', "$base/$cid_of_foobar" );
req( $test, 405, 'root', 'POST', "$base/$cid_of_foobar" );
note( "DELETE on $base/:cid" );
note( 'demo fail 403' );
req( $test, 403, 'demo', 'DELETE', "$base/$cid_of_foobar" );
note( 'root success' );
note( "DELETE $base/$cid_of_foobar" );
ok( -e $full_path_of_foobar );
$status = req( $test, 200, 'root', 'DELETE', "$base/$cid_of_foobar" );
is( $status->level, 'OK', "DELETE $base/:cid 3" );
is( $status->code, 'DOCHAZKA_CUD_OK', "DELETE $base/:cid 4" );
note( 'really gone' );
req( $test, 404, 'root', 'GET', "$base/$cid_of_foobar" );
ok( ! -e $full_path_of_foobar );
note( 'root fail invalid cid' );
req( $test, 400, 'root', 'DELETE', "$base/asd" );
note( "=============================" );
note( "'component/path' resource" );
note( "=============================" );
$base = 'component/path';
docu_check($test, "$base");
note( "GET, PUT on $base" );
t/dispatch/component.t view on Meta::CPAN
}
note( "POST on $base" );
note( "insert: expected behavior" );
$component_obj = '{ "path" : "library/foowang.mc", "source" : "wang wang wazoo", "acl" : "passerby" }';
req( $test, 403, 'demo', 'POST', $base, $component_obj );
$status = req( $test, 200, 'root', 'POST', $base, $component_obj );
is( $status->level, 'OK', "POST $base 4" );
is( $status->code, 'DOCHAZKA_CUD_OK', "POST $base 5" );
my $cid_of_foowang = $status->payload->{'cid'};
ok( path_exists_by_dispatch( 'library/foowang.mc' ) );
ok( path_exists( $dbix_conn, 'library/foowang.mc' ) );
my $full_path_of_foowang = File::Spec->catfile( $comp_root, $status->payload->{path} );
ok( -o $full_path_of_foowang );
is( "wang wang wazoo", read_file( $full_path_of_foowang ) );
note( "update: expected behavior" );
$component_obj = '{ "path" : "library/foowang.mc", "source" : "this is only a test", "acl" : "inactive" }';
req( $test, 403, 'demo', 'POST', $base, $component_obj );
$status = req( $test, 200, 'root', 'POST', $base, $component_obj );
t/dispatch/component.t view on Meta::CPAN
$weirded_object = '{ "path" : "!!!!!", "source" : "down it goes", "acl" : "inactive" }';
#$status = req( $test, 400, 'root', 'POST', $base, $weirded_object );
#like( $status->text, qr/check constraint "kosher_path"/ );
dbi_err( $test, 500, 'root', 'POST', $base, $weirded_object, qr/check constraint "kosher_path"/ );
$illegal_acl = '{ "path" : "library/machinations.mc", "source" : "wang wang wazoo", "acl" : "puppy" }';
req( $test, 400, 'root', 'POST', $base, $illegal_acl );
note( "delete the testing component" );
ok( -e $full_path_of_foowang );
delete_testing_component( $cid_of_foowang );
ok( ! path_exists_by_dispatch( 'library/foowang.mc' ) );
ok( ! path_exists( $dbix_conn, 'library/foowang.mc' ) );
ok( ! -e $full_path_of_foowang );
note( "DELETE on $base" );
foreach my $user ( qw( demo active puppy root ) ) {
req( $test, 405, $user, 'DELETE', $base );
}
done_testing;
t/model/component.t view on Meta::CPAN
#
#!perl
use 5.012;
use strict;
use warnings;
#use App::CELL::Test::LogToFile;
use App::CELL qw( $meta $site );
use Data::Dumper;
use App::Dochazka::REST::ConnBank qw( $dbix_conn );
use App::Dochazka::REST::Model::Component qw( cid_by_path cid_exists path_exists );
use App::Dochazka::REST::Test;
use Test::Fatal;
use Test::More;
use Test::Warnings;
note( "initialize, connect to database, and set up a testing plan" );
initialize_regression_test();
note( 'spawn two component objects' );
t/model/component.t view on Meta::CPAN
ok( $comp->compare( $comp2 ) ); # still the same
ok( $comp2->compare( $comp ) );
$comp2->source( "jine fody" );
ok( ! $comp->compare( $comp2 ) ); # different
note( 'reset the activities' );
$comp->reset;
$comp2->reset;
ok( $comp->compare( $comp2 ) );
foreach my $prop ( qw( cid path source acl ) ) {
is( $comp->{$prop}, undef );
is( $comp2->{$prop}, undef );
}
note( 'test existence and viability of initial set of components' );
note( 'this also conducts positive tests of load_by_path and load_by_cid' );
foreach my $compdef ( @{ $site->DOCHAZKA_COMPONENT_DEFINITIONS } ) {
my $status = App::Dochazka::REST::Model::Component->load_by_path( $dbix_conn, $compdef->{path} );
is( $status->code, 'DISPATCH_RECORDS_FOUND' );
is( $status->level, 'OK' );
$comp = $status->payload;
is( $comp->path, $compdef->{path} );
is( $comp->source, $compdef->{source} );
is( $comp->acl, $compdef->{acl} );
$status = App::Dochazka::REST::Model::Component->load_by_cid( $dbix_conn, $comp->cid );
is( $status->level, 'OK' );
is( $status->code, 'DISPATCH_RECORDS_FOUND' );
$comp2 = $status->payload;
is_deeply( $comp, $comp2 );
}
note( 'test some bad parameters' );
like( exception { $comp2->load_by_cid( $dbix_conn, undef ) },
qr/not one of the allowed types/ );
like( exception { $comp2->load_by_path( $dbix_conn, undef ) },
qr/not one of the allowed types/ );
like( exception { App::Dochazka::REST::Model::Component->load_by_cid( $dbix_conn, undef ) },
qr/not one of the allowed types/ );
like( exception { App::Dochazka::REST::Model::Component->load_by_path( $dbix_conn, undef ) },
qr/not one of the allowed types/ );
note( 'load non-existent component' );
my $status = App::Dochazka::REST::Model::Component->load_by_path( $dbix_conn, 'orneryFooBarred' );
is( $status->level, 'NOTICE' );
is( $status->code, 'DISPATCH_NO_RECORDS_FOUND' );
ok( ! exists( $status->{'payload'} ) );
ok( ! defined( $status->payload ) );
note( 'load existent component' );
$status = App::Dochazka::REST::Model::Component->load_by_path( $dbix_conn, 'sample/local_time.mc' );
is( $status->level, 'OK' );
is( $status->code, 'DISPATCH_RECORDS_FOUND' );
my $sample_component = $status->payload;
ok( $sample_component->cid );
ok( $sample_component->path );
is( $sample_component->path, 'sample/local_time.mc' );
my $sample_component_cid = cid_by_path( $dbix_conn, 'sample/local_time.mc' );
is( $sample_component_cid, $sample_component->cid );
like ( exception { $sample_component_cid = cid_by_path( $dbix_conn, ( 1..6 ) ); },
qr/but 2 were expected/ );
is( cid_by_path( $dbix_conn, 'orneryFooBarred' ), undef, 'cid_by_path returns undef if path does not exist' );
note( 'insert a component (success)' );
my $non_bogus_component = App::Dochazka::REST::Model::Component->spawn(
path => 'non/bogus',
source => 'An componnennt',
acl => 'passerby',
);
note( "About to insert non_bogus_component" );
$status = $non_bogus_component->insert( $faux_context );
if ( $status->not_ok ) {
diag( Dumper $status );
BAIL_OUT(0);
}
is( $status->level, 'OK' );
ok( defined( $non_bogus_component->cid ) );
ok( $non_bogus_component->cid > 0 );
is( $non_bogus_component->path, 'non/bogus' );
is( $non_bogus_component->source, "An componnennt" );
is( $non_bogus_component->acl, 'passerby' );
note( 'try to insert the same component again (fail with DOCHAZKA_DBI_ERR)' );
$status = $non_bogus_component->insert( $faux_context );
ok( $status->not_ok );
is( $status->level, 'ERR' );
is( $status->code, 'DOCHAZKA_DBI_ERR' );
like( $status->text, qr#Key \(path\)\=\(non/bogus\) already exists# );
t/model/component.t view on Meta::CPAN
is( $status->code, 'DOCHAZKA_CUD_OK' );
note( 'load it and compare it' );
$status = App::Dochazka::REST::Model::Component->load_by_path( $dbix_conn, $non_bogus_component->path );
is( $status->code, 'DISPATCH_RECORDS_FOUND' );
my $bc2 = $status->payload;
is( $bc2->path, 'bogosITYVille' );
is( $bc2->source, "A bogus component that doesn't belong here" );
is( $bc2->acl, 'inactive' );
my $cid_of_non_bogus_component = $non_bogus_component->cid;
my $path_of_non_bogus_component = $non_bogus_component->path;
ok( cid_exists( $dbix_conn, $cid_of_non_bogus_component ) );
ok( path_exists( $dbix_conn, $path_of_non_bogus_component ) );
note( 'CLEANUP: delete the bogus component' );
#diag( "About to delete non_bogus_component" );
$status = $non_bogus_component->delete( $faux_context );
if ( $status->not_ok ) {
diag( Dumper $status );
BAIL_OUT(0);
}
is( $status->level, 'OK' );
ok( ! cid_exists( $dbix_conn, $cid_of_non_bogus_component ) );
ok( ! path_exists( $dbix_conn, $path_of_non_bogus_component ) );
note( 'attempt to load the bogus component - no longer there' );
$status = App::Dochazka::REST::Model::Component->load_by_cid( $dbix_conn, $cid_of_non_bogus_component );
is( $status->level, 'NOTICE' );
is( $status->code, 'DISPATCH_NO_RECORDS_FOUND' );
$status = App::Dochazka::REST::Model::Component->load_by_path( $dbix_conn, $path_of_non_bogus_component );
is( $status->level, 'NOTICE' );
is( $status->code, 'DISPATCH_NO_RECORDS_FOUND' );
$status = App::Dochazka::REST::Model::Component->load_by_path( $dbix_conn, 'boguS' );
is( $status->level, 'NOTICE' );
is( $status->code, 'DISPATCH_NO_RECORDS_FOUND' );
$status = App::Dochazka::REST::Model::Component->load_by_path( $dbix_conn, 'bogosITYVille' );
is( $status->level, 'NOTICE' );
( run in 0.686 second using v1.01-cache-2.11-cpan-de7293f3b23 )