File Coverage

blib/lib/App/Dochazka/CLI/Commands/History.pm

Criterion	Covered	Total	%
statement	44	148	29.7
branch	10	66	15.1
condition	0	18	0.0
subroutine	15	20	75.0
pod	5	5	100.0
total	74	257	28.7

# *************************************************************************
# Copyright (c) 2014-2016, 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.
# *************************************************************************
#
# History commands
package App::Dochazka::CLI::Commands::History;

use 5.012;
use strict;
use warnings;

use App::CELL qw( $CELL );
use App::Dochazka::CLI qw( $current_emp $debug_mode );
use App::Dochazka::CLI::Util qw( lookup_employee parse_test rest_error truncate_to );
use Data::Dumper;
use Exporter 'import';
use Text::Table;
use Web::MREST::CLI qw( send_req );




=head1 NAME

App::Dochazka::CLI::Commands::History - History commands




=head1 PACKAGE VARIABLES

=cut

our @EXPORT_OK = qw(
    add_priv_history
    add_schedule_history
    dump_priv_history
    dump_schedule_history
    set_history_remark
);




=head1 FUNCTIONS

The functions in this module are called from the parser when it recognizes a command.


=head2 Command handlers

Command handler functions are called from the parser.


=head3 dump_priv_history

    PRIV HISTORY
    EMPLOYEE_SPEC PRIV HISTORY

=cut

sub dump_priv_history {
    print "Entering " . __PACKAGE__ . "::dump_priv_history\n" if $debug_mode;
    my ( $ts, $th ) = @_;

    # parse test
    return parse_test( $ts, $th ) if $ts eq 'PARSE_TEST';

    my $emp_spec = ( $th->{'EMPLOYEE_SPEC'} )
        ? $th->{'EMPLOYEE_SPEC'}
        : $current_emp;

    return _dump_history(
        emp_spec => $emp_spec,
        type => 'priv',
    );
}


=head3 dump_schedule_history

    SCHEDULE HISTORY
    EMPLOYEE_SPEC SCHEDULE HISTORY

=cut

sub dump_schedule_history {
    print "Entering " . __PACKAGE__ . "::dump_schedule_history\n" if $debug_mode;
    my ( $ts, $th ) = @_;

    # parse test
    return parse_test( $ts, $th ) if $ts eq 'PARSE_TEST';

    my $emp_spec = ( $th->{'EMPLOYEE_SPEC'} )
        ? $th->{'EMPLOYEE_SPEC'}
        : $current_emp;

    return _dump_history(
        emp_spec => $emp_spec,
        type => 'schedule',
    );
}


=head3 add_priv_history

Add privilege history record.

    EMPLOYEE_SPEC PRIV_SPEC _DATE
    EMPLOYEE_SPEC PRIV_SPEC EFFECTIVE _DATE
    EMPLOYEE_SPEC SET PRIV_SPEC _DATE
    EMPLOYEE_SPEC SET PRIV_SPEC EFFECTIVE _DATE

=cut

sub add_priv_history {
    print "Entering " . __PACKAGE__ . "::add_priv_history\n" if $debug_mode;
    my ( $ts, $th ) = @_;

    # parse test
    return parse_test( $ts, $th ) if $ts eq 'PARSE_TEST';

    my $emp_spec = ( $th->{'EMPLOYEE_SPEC'} )
        ? $th->{'EMPLOYEE_SPEC'}
        : $current_emp;

    return _add_history(
        emp_spec => $emp_spec,
        type => 'priv',
        effective => $th->{'_DATE'},
        priv => $th->{'PRIV_SPEC'},
    );
}


=head3 add_schedule_history

Add schedule history record.

    EMPLOYEE_SPEC SCHEDULE_SPEC _DATE
    EMPLOYEE_SPEC SCHEDULE_SPEC EFFECTIVE _DATE
    EMPLOYEE_SPEC SET SCHEDULE_SPEC _DATE
    EMPLOYEE_SPEC SET SCHEDULE_SPEC EFFECTIVE _DATE

=cut

sub add_schedule_history {
    print "Entering " . __PACKAGE__ . "::add_schedule_history\n" if $debug_mode;
    my ( $ts, $th ) = @_;

    # parse test
    return parse_test( $ts, $th ) if $ts eq 'PARSE_TEST';

    my $emp_spec = ( $th->{'EMPLOYEE_SPEC'} )
        ? $th->{'EMPLOYEE_SPEC'}
        : $current_emp;

    my ( $key_spec, $key ) = $th->{'SCHEDULE_SPEC'} =~ m/^(.*)\=(.*)$/;
    $key_spec = lc $key_spec;

    return _add_history(
        emp_spec => $emp_spec,
        type => 'schedule',
        effective => $th->{'_DATE'},
        $key_spec => $key,
    );
}


=head3 set_history_remark

    PHISTORY_SPEC REMARK
    PHISTORY_SPEC SET REMARK
    SHISTORY_SPEC REMARK
    SHISTORY_SPEC SET REMARK

=cut

sub set_history_remark {
    print "Entering " . __PACKAGE__ . "::dump_schedule_history\n" if $debug_mode;
    my ( $ts, $th ) = @_;

    # parse test
    return parse_test( $ts, $th ) if $ts eq 'PARSE_TEST';

    my ( $type, $id_spec, $id );
    if ( $th->{'PHISTORY_SPEC'} ) {
        $type = 'priv';
        $id_spec = 'phid';
        $id = $th->{'PHISTORY_SPEC'};
    } elsif ( $th->{'SHISTORY_SPEC'} ) {
        $type = 'schedule';
        $id_spec = 'shid';
        $id = $th->{'SHISTORY_SPEC'};
    } else {
        die "Agh~! neither PHISTORY_SPEC nor SHISTORY_SPEC given";
    }

    my $remark = $th->{'_REST'} || '';
    $remark =~ s/[\"\']//g;

    my $status = send_req( 'POST', "$type/history/$id_spec/$id", <<"EOS" );
{ "remark" : "$remark" }
EOS

    return $status;
}


=head2 Helper functions

Functions called from multiple command handlers.


=head3 _add_history

Add a history record

=cut

sub _add_history {
    my %ARGS = @_;

    # get type
    my $type = $ARGS{'type'};

    # get EID
    my ( $emp_obj, $status );
    $status = _process_employee_spec( $ARGS{'emp_spec'} );
    return $status unless $status->ok;
    my $eid = $status->payload->{'eid'};

    # get key_spec and key
    my ( $key_spec, $key );
    if ( exists( $ARGS{'priv'} ) ) {
        $key_spec = 'priv';
        $key = $ARGS{'priv'};
    } elsif ( exists( $ARGS{'scode'} ) ) {
        # special case - since the underlying App::Dochazka::REST resource
        # only takes a 'sid', we have to look up the scode to determine the sid
        my $status = send_req( 'GET', "schedule/scode/$ARGS{'scode'}" );
        my $sid;
        if ( $status->ok and $status->code eq 'DISPATCH_SCHEDULE_FOUND' ) {
            $sid = $status->payload->{'sid'};
        } else {
            return $status;
        }
        $key_spec = 'sid';
        $key = $sid;
    } elsif ( exists( $ARGS{'sid'} ) ) {
        $key_spec = 'sid';
        $key = $ARGS{'sid'};
    } else {
        die "AHAAHHA!! bad key_spec " . ( $key_spec || "undefined" );
    }

    # get effective
    my $effective = $ARGS{'effective'} || "undefined";

    # send REST request
    $status = send_req( 'POST', "$type/history/eid/$eid", <<"EOS" );
{ "$key_spec" : "$key", "effective" : "$effective" }
EOS

    if ( $status->ok and $status->code eq 'DOCHAZKA_CUD_OK' ) {
        if ( $type eq 'priv' ) {
            $status = $CELL->status_ok( "DOCHAZKA_CLI_PRIV_HISTORY_ADD",
                args => [ $status->payload->{'phid'} ] );
        } elsif ( $type eq 'schedule' ) {
            $status = $CELL->status_ok( "DOCHAZKA_CLI_SCHEDULE_HISTORY_ADD",
                args => [ $status->payload->{'shid'} ] );
        } else {
            die "AH!@! bad type " . ( $type || "undefined" );
        }
    }

    return $status;
}


=head3 _dump_history

=cut

sub _dump_history {
    my %ARGS = @_;

    # get type
    my $type = $ARGS{'type'};

    # get EID
    my ( $emp_obj, $status );
    $status = _process_employee_spec( $ARGS{'emp_spec'} );
    return $status unless $status->ok;
    my $eid = $status->payload->{'eid'};
    die "AAHQ! Could not extract EID from payload: " . Dumper( $status ) unless $eid;

    # get $type history for that EID
    $status = send_req( 'GET', "$type/history/eid/$eid" );
    if ( $status->ok ) {
        my $pl;
        if ( $type eq 'priv' ) {
            $pl .= _print_priv_history( $status->payload );
        } elsif ( $type eq 'schedule' ) {
            $pl .= _print_schedule_history( $status->payload );
        } else {
            die "AH! bad type " . $type || "undefined";
        }
        return $CELL->status_ok( 'DOCHAZKA_CLI_NORMAL_COMPLETION', payload => $pl );
    }

    return $status;
}


=head3 _print_priv_history

Take a privhistory and print it

=cut

sub _print_priv_history {
    my $props = shift;
    my $eid = $props->{'eid'};
    my $nick = $props->{'nick'};

    my $pl = '';
    $pl .= "Privilege history of $nick (EID $eid):\n\n";

    my $t = Text::Table->new( 'PHID', 'Effective date', 'Privlevel', 'Remark' );
    foreach my $entry ( @{ $props->{'history'} } ) {
        my ( $effective ) = $entry->{'effective'} =~ m/(\S+)\s/;
        $t->add(
            $entry->{'phid'},
            $effective,
            $entry->{'priv'},
            truncate_to( $entry->{'remark'} ),
        );
    }

    $pl .= $t;

    return $pl;
}


=head3 _print_schedule_history

Take a schedhistory and print it

=cut

sub _print_schedule_history {
    my $props = shift;
    my $eid = $props->{'eid'};
    my $nick = $props->{'nick'};

    my $pl = '';
    $pl .= "Schedule history of $nick (EID $eid):\n\n";

    my $t = Text::Table->new( 'SHID', 'Effective date', 'SID', 'scode', 'Remark' );
    foreach my $entry ( @{ $props->{'history'} } ) {
        my ( $effective ) = $entry->{'effective'} =~ m/(\S+)\s/;
        my $status = send_req( 'GET', 'schedule/sid/' . $entry->{'sid'} );
        my ( $scode, $remark );
        if ( $status->ok ) {
            $scode = $status->payload->{'scode'} || '';
        } else {
            $scode = '';
        }
        $t->add(
            $entry->{'shid'},
            $effective,
            $entry->{'sid'},
            $scode,
            truncate_to( $entry->{'remark'} ),
        );
    }

    $pl .= $t;

    return $pl;
}


=head3 _process_employee_spec

Given EMPLOYEE_SPEC, return a status object that can either be OK with
employee object in payload or NOT_OK with mrest_declare_status already
called.

=cut

sub _process_employee_spec {
    my $emp_spec = shift;

    my ( $eid, $status );
    if ( $emp_spec->can('eid') ) {
        $status = $CELL->status_ok( 'DUMMY', payload => $emp_spec->TO_JSON );
    } elsif ( ref( $emp_spec ) eq '' ) {
        $status = lookup_employee( key => $emp_spec );
        return rest_error( $status, "Employee lookup" ) unless $status->ok;
    } else {
        die "AGHHAH! bad employee specifier";
    }

    return $status;
}


1;