view release on metacpan or  search on metacpan

lib/App/Dochazka/REST/Shared.pm  view on Meta::CPAN

    return $CELL->status_ok( 'DISPATCH_EMPLOYEE_FOUND',
        payload => $d_obj->context->{'stashed_employee_object'},
    );
}


=head2 shared_update_employee

Takes three arguments:

    - $d_obj is the App::Dochazka::REST::Dispatch object
    - $emp is an employee object (blessed hashref)
    - $over is a hashref with zero or more employee properties and new values

The values from $over replace those in $emp

=cut

sub shared_update_employee {
    my ( $d_obj, $emp, $over ) = @_;
    $log->debug("Entering " . __PACKAGE__ . "::shared_update_employee" );
    $log->debug("Updating employee: " . Dumper( $emp ) );
    $log->debug("With key:value pairs " . Dumper( $over ) );

    ACL: {
        my $explanation = "Update operations require at least one key:value pair in the request entity";
        if ( ref( $over ) ne 'HASH' ) {
            $d_obj->mrest_declare_status( code => 400, explanation => $explanation );
            return $fail;
        }
        delete $over->{'eid'};
        if ( $over == {} ) {
            $d_obj->mrest_declare_status( code => 400, explanation => $explanation );
            return $fail;
        } 
    }

    # for password hashing, we will assume that $over might contain
    # a 'password' property, which is converted into 'passhash' + 'salt' via 
    # Authen::Passphrase
    hash_the_password( $over );

    return $emp->update( $d_obj->context ) if pre_update_comparison( $emp, $over );
    $log->notice( "Update operation would not change database; skipping it" );
    return $CELL->status_ok( 'DISPATCH_UPDATE_NO_CHANGE_OK' );
}


=head2 shared_insert_employee

Called from handlers in L<App::Dochazka::REST::Dispatch>. Takes three arguments:

    - $d_obj is the App::Dochazka::REST::Dispatch object
    - $ignore_me will be undef
    - $new_emp_props is a hashref with employee properties and their values (guaranteed to contain 'nick')

=cut

sub shared_insert_employee {
    $log->debug( "Entered " . __PACKAGE__ . "::shared_insert_employee" );
    my ( $d_obj, $ignore_me, $new_emp_props ) = validate_pos( @_,
        { isa => 'App::Dochazka::REST::Dispatch' },
        { type => UNDEF },
        { type => HASHREF },
    );
    $log->debug( "Arguments are OK, about to insert new employee: " . Dumper( $new_emp_props ) );

    # If there is a "password" property, transform it into "passhash" + "salt"
    hash_the_password( $new_emp_props );

    # spawn an object, filtering the properties first
    my @filtered_args = App::Dochazka::Common::Model::Employee::filter( %$new_emp_props );
    my %proplist_after = @filtered_args;
    $log->debug( "Properties after filter: " . join( ' ', keys %proplist_after ) );
    my $emp = App::Dochazka::REST::Model::Employee->spawn( @filtered_args );

    # execute the INSERT db operation
    return $emp->insert( $d_obj->context );
}


=head2 shared_update_schedule

Takes three arguments:

    - $d_obj is the dispatch (App::Dochazka::REST::Dispatch) object
    - $sched is a schedule object (blessed hashref)
    - $over is a hashref with zero or more schedule properties and new values

The values from C<$over> replace those in C<$emp>.

=cut

sub shared_update_schedule {
    my ( $d_obj, $sched, $over ) = validate_pos( @_,
        { isa => 'App::Dochazka::REST::Dispatch' },
        { isa => 'App::Dochazka::REST::Model::Schedule' },
        { type => HASHREF },
    );
    $log->debug("Entering " . __PACKAGE__ . "::shared_update_schedule" );

    delete $over->{'sid'} if exists $over->{'sid'};
    delete $over->{'schedule'} if exists $over->{'schedule'};
    if ( pre_update_comparison( $sched, $over ) ) {
        $log->debug( "After pre_update_comparison: " . Dumper $sched );
        return $sched->update( $d_obj->context );
    }

    $d_obj->mrest_declare_status( 
        code => 400, 
        explanation => "Cannot update schedule due to invalid input",
    );
    return $fail;
}


=head2 shared_get_class_prop_id

For 'priv' and 'schedule' resources. Given the request context, extract the
first component, which will always be either 'priv' or 'schedule'. Based on
that, generate the object class, property name, and ID property name for 
use in the resource handler.

=cut

sub shared_get_class_prop_id {
    my ( $context ) = @_;
    my $class = 'App::Dochazka::REST::Model::';
    my ( $prop, $id );
    if ( $context->{'components'}->[0] eq 'priv' ) {
        $class .= 'Privhistory';
        $prop = 'priv';
        $id = 'phid';
    } elsif ( $context->{'components'}->[0] eq 'schedule' ) {
        $class .= 'Schedhistory';
        $prop = 'sid';
        $id = 'shid';
    } else {
        die "AGAGAGAGGAGGGGGAAAAAAAHHHH!!!!!";
    }
    return ( $class, $prop, $id );
}


=head2 shared_history_init

For 'priv/history' and 'schedule/history' resources. Given the request context, 
extract or generate values needed by the resource handler.

=cut

sub shared_history_init {
    my $context = shift;

    my $method = $context->{'method'};

lib/App/Dochazka/REST/Shared.pm  view on Meta::CPAN

    $log->notice( "Update operation would not change database; skipping it" );
    return $CELL->status_ok( 'DISPATCH_UPDATE_NO_CHANGE_OK' );
}


=head2 shared_update_component

Takes three arguments:

  - $d_obj is the dispatch object
  - $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

Takes three arguments:

  - $d_obj is the dispatch object
  - $obj is a (priv/schedule) history object (blessed hashref)
  - $over is a hashref with zero or more history properties and new values

The values from $over replace those in $obj

=cut

sub shared_update_history {
    my ( $d_obj, $obj, $over ) = @_;
    $log->debug("Entering " . __PACKAGE__ . "::shared_update_history" );
    delete $over->{'eid'} if exists $over->{'eid'};
    return $obj->update( $d_obj->context ) if pre_update_comparison( $obj, $over );
    $log->notice( "Update operation would not change database; skipping it" );
    return $CELL->status_ok( 'DISPATCH_UPDATE_NO_CHANGE_OK' );
}


=head2 shared_insert_activity

Takes two arguments: the dispatch object and the properties that are supposed
to be an activity object to be inserted.

=cut

sub shared_insert_activity {
    my ( $d_obj, $code, $props ) = validate_pos( @_,
        { isa => 'App::Dochazka::REST::Dispatch' },
        { type => SCALAR },
        { type => HASHREF },
    );
    $log->debug("Reached " . __PACKAGE__ . "::shared_insert_activity" );

    my %proplist_before = %$props;
    $proplist_before{'code'} = $code; # overwrite whatever might have been there
    $log->debug( "Properties before filter: " . join( ' ', keys %proplist_before ) );
        
    # spawn an object, filtering the properties first
    my @filtered_args = App::Dochazka::Common::Model::Activity::filter( %proplist_before );
    my %proplist_after = @filtered_args;
    $log->debug( "Properties after filter: " . join( ' ', keys %proplist_after ) );
    my $act = App::Dochazka::REST::Model::Activity->spawn( @filtered_args );

    # execute the INSERT db operation
    return $act->insert( $d_obj->context );
}


=head2 shared_insert_component

Takes two arguments: the dispatch object and the properties that are supposed
to be a component object to be inserted.

=cut

sub shared_insert_component {
    my ( $d_obj, $path, $props ) = validate_pos( @_,
        { isa => 'App::Dochazka::REST::Dispatch' },
        { type => SCALAR },
        { type => HASHREF },
    );
    $log->debug("Reached " . __PACKAGE__ . "::shared_insert_component" );

    my %proplist_before = %$props;
    $proplist_before{'path'} = $path; # overwrite whatever might have been there
    $log->debug( "Properties before filter: " . join( ' ', keys %proplist_before ) );

    # spawn an object, filtering the properties first
    my @filtered_args = App::Dochazka::Common::Model::Component::filter( %proplist_before );
    my %proplist_after = @filtered_args;
    $log->debug( "Properties after filter: " . join( ' ', keys %proplist_after ) );
    my $comp = App::Dochazka::REST::Model::Component->spawn( @filtered_args );

    # execute the INSERT db operation
    my $status = $comp->insert( $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_insert_interval

Shared routine for inserting attendance intervals.

=cut

sub shared_insert_interval {
    my ( $d_obj ) = @_;
    $log->debug("Reached " . __PACKAGE__ . "::shared_insert_interval" );

    return shared_insert_intlock( $d_obj, 'Interval' );
}


=head2 shared_insert_lock

Shared routine for inserting lock intervals.

=cut

sub shared_insert_lock {
    my ( $d_obj ) = @_;
    $log->debug("Reached " . __PACKAGE__ . "::shared_insert_lock" );

    return shared_insert_intlock( $d_obj, 'Lock' );
}


=head2 shared_insert_intlock

=cut

sub shared_insert_intlock {
    my ( $d_obj, $intlock ) = @_;
    $log->debug("Reached " . __PACKAGE__ . "::shared_insert_intlock with $intlock" );