view release on metacpan or  search on metacpan

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

# *************************************************************************
# Copyright (c) 2014-2017, SUSE LLC
#
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# 1. Redistributions of source code must retain the above copyright notice,
# this list of conditions and the following disclaimer.
#
# 2. Redistributions in binary form must reproduce the above copyright
# notice, this list of conditions and the following disclaimer in the
# documentation and/or other materials provided with the distribution.
#
# 3. Neither the name of SUSE LLC nor the names of its contributors may be
# used to endorse or promote products derived from this software without
# specific prior written permission.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
# LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
# CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
# SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
# INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
# CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
# ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.
# *************************************************************************

# ------------------------
# Shared dispatch functions
# ------------------------

package App::Dochazka::REST::Shared;

use strict;
use warnings;

use App::CELL qw( $CELL $log $site );
use App::Dochazka::REST::ACL qw( acl_check_is_me acl_check_is_my_report );
use App::Dochazka::REST::ConnBank qw( conn_status );
use App::Dochazka::REST::Model::Activity;
use App::Dochazka::REST::Model::Employee;
use App::Dochazka::REST::Model::Interval;
use App::Dochazka::REST::Model::Lock;
use App::Dochazka::REST::Model::Privhistory;
use App::Dochazka::REST::Model::Schedhistory;
use App::Dochazka::REST::Model::Schedule;
use App::Dochazka::REST::Model::Shared qw( priv_by_eid schedule_by_eid );
use App::Dochazka::REST::Util qw( hash_the_password pre_update_comparison );
use Data::Dumper;
use Params::Validate qw( :all );
use Try::Tiny;

my $fail = $CELL->status_not_ok;


=head1 NAME

App::Dochazka::REST::Dispatch::Shared - Shared dispatch functions




=head1 DESCRIPTION

This module provides code that is, or may be, used by more than one resource
handler method.




=head1 EXPORTS

=cut

use Exporter qw( import );
our @EXPORT_OK = qw( 
    shared_first_pass_lookup
    shared_entity_check
    shared_get_employee
    shared_get_employee_pass1
    shared_insert_employee
    shared_update_employee
    shared_update_schedule
    shared_get_class_prop_id
    shared_history_init
    shared_get_privsched
    shared_employee_acl_part1
    shared_employee_acl_part2
    shared_update_activity
    shared_update_component
    shared_update_history
    shared_insert_activity
    shared_insert_component
    shared_insert_interval
    shared_insert_lock
    shared_update_intlock
    shared_process_quals
);
our %EXPORT_TAGS = ( ALL => [ @EXPORT_OK ] );


=head1 PACKAGE VARIABLES

The package variable C<%f_dispatch> is used in C<fetch_by_eid>, C<fetch_by_nick>,
and C<fetch_own>.

=cut

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

    my $emp = shared_first_pass_lookup( $d_obj, $key, $value );
    return 0 unless $emp;
    $d_obj->context->{'stashed_employee_object'} = $emp;
    return 1;
}


=head2 shared_get_employee

=cut

sub shared_get_employee {
    my ( $d_obj, $pass, $key, $value ) = @_;
    $log->debug( "Entering " . __PACKAGE__ . "::shared_get_employee" ); 

    # first pass
    if ( $pass == 1 ) {
        return shared_get_employee_pass1(
            $d_obj, $pass, $key, $value
        );
    }

    # second pass
    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 );