view release on metacpan or  search on metacpan

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

=cut

sub delete_audit_triggers {
    my $conn = shift;
    return _do_audit_triggers( 'delete', $conn );
}
    

=head2 reset_mason_dir

Wipe out and re-create the Mason state directory. Returns status object.
Upon success, level will be 'OK' and payload will contain the full path
to the Mason component root.

=cut

sub reset_mason_dir {
    my $status;

    $log->info( "Checking permissions of Mason directory (DOCHAZKA_STATE_DIR)" );
    my $statedir = $site->DOCHAZKA_STATE_DIR;
    die "OUCH!!! DOCHAZKA_STATE_DIR site parameter not defined!" unless $statedir;
    die "OUCH!!! DOCHAZKA_STATE_DIR $statedir is not readable by me!" unless -r $statedir;
    die "OUCH!!! DOCHAZKA_STATE_DIR $statedir is not writable by me!" unless -w $statedir;
    die "OUCH!!! DOCHAZKA_STATE_DIR $statedir is not executable by me!" unless -x $statedir;
    my $masondir = File::Spec->catfile( $statedir, 'Mason' );
    $log->debug( "Mason directory is $masondir" );
    rmtree( $masondir );
    mkpath( $masondir, 0, 0750 );

    # re-create
    my $comp_root = File::Spec->catfile( $masondir, 'comp_root' );
    mkpath( $comp_root, 0, 0750 );
    my $data_dir = File::Spec->catfile( $masondir, 'data_dir' );
    mkpath( $data_dir, 0, 0750 );
    $status = App::Dochazka::REST::Mason::init_singleton( 
        comp_root => $comp_root, 
        data_dir => $data_dir 
    );
    return $status unless $status->ok;
    $status->payload( $comp_root );
    return $status;
}


=head2 initialize_activities_table

Create the activities defined in the site parameter
DOCHAZKA_ACTIVITY_DEFINITIONS

=cut

sub initialize_activities_table {
    my $conn = shift;
    my $status = $CELL->status_ok;
    try {
        $conn->txn( fixup => sub {
            my $sth = $_->prepare( $site->SQL_ACTIVITY_INSERT );
            foreach my $actdef ( @{ $site->DOCHAZKA_ACTIVITY_DEFINITIONS } ) {
                $sth->bind_param( 1, $actdef->{code} );
                $sth->bind_param( 2, $actdef->{long_desc} );
                $sth->bind_param( 3, 'dbinit' );
                $sth->execute;
            }
        } );
    } catch {
        $status = $CELL->status_err( 'DOCHAZKA_DBI_ERR', args => [ $_ ] );
    };
    return $status;
}


=head2 reset_db

Drop and re-create a Dochazka database. Takes superuser credentials as
arguments. 

Be very, _very_, _VERY_ careful with this function.

=cut

sub reset_db {

    my $status;
    my $dbname = $site->DOCHAZKA_DBNAME;
    my $dbuser = $site->DOCHAZKA_DBUSER;
    my $dbpass = $site->DOCHAZKA_DBPASS;
    $log->debug( "Entering " . __PACKAGE__ . "::reset_db to initialize database $dbname with credentials $dbuser / $dbpass" );

    # PGTZ *must* be set
    $ENV{'PGTZ'} = $site->DOCHAZKA_TIMEZONE;

    # create:
    # - audit schema (see config/sql/audit_Config.pm)
    # - public schema (all application-specific tables, functions, triggers, etc.)
    # - the 'root' and 'demo' employees
    # - privhistory record for root
    print "Getting database connection...";
    my $conn = App::Dochazka::REST::ConnBank::get_arbitrary_dbix_conn(
        $dbname, $dbuser, $dbpass
    );
    print "done\n";

    print "Initializing audit schema...";
    $status = run_sql(
        $conn,
        @{ $site->DBINIT_AUDIT },
    );
    if ( $status->not_ok ) {
        print Dumper( $status ), "\n";
        return $status;
    }
    print "done\n";

    print "Initializing public schema...";
    $status = run_sql(
        $conn,
        @{ $site->DBINIT_CREATE },
    );
    if ( $status->not_ok ) {
        print Dumper( $status ), "\n";
        return $status;
    }
    print "done\n";

    # get EID of root employee that was just created, since
    # we will need it in the second round of SQL statements
    my $eids = get_eid_of( $conn, "root", "demo" );
    $site->set( 'DOCHAZKA_EID_OF_ROOT', $eids->{'root'} );
    $site->set( 'DOCHAZKA_EID_OF_DEMO', $eids->{'demo'} );

    # the second round of SQL statements to make root employee immutable
    # is taken from DBINIT_MAKE_ROOT_IMMUTABLE site param

    # prep DBINIT_MAKE_ROOT_IMMUTABLE
    # (replace ? with EID of root employee in all the statements
    # N.B.: we avoid the /r modifier here because we might be using Perl # 5.012)
    my @root_immutable_statements = map { 
        local $_ = $_; s/\?/$eids->{'root'}/g; $_; 
    } @{ $site->DBINIT_MAKE_ROOT_IMMUTABLE };

    # run the modified statements
    $status = run_sql(
        $conn,
        @root_immutable_statements,
    );
    return $status unless $status->ok;

    # insert initial set of activities
    $status = initialize_activities_table( $conn );
    
    # insert initial set of components
    try {
        $conn->txn( fixup => sub {
            my $sth = $_->prepare( $site->SQL_COMPONENT_INSERT );
            foreach my $actdef ( @{ $site->DOCHAZKA_COMPONENT_DEFINITIONS } ) {
                $actdef->{'validations'} = undef unless exists( $actdef->{'validations'} );
                $sth->bind_param( 1, $actdef->{path} );
                $sth->bind_param( 2, $actdef->{source} );
                $sth->bind_param( 3, $actdef->{acl} );
                $sth->bind_param( 4, $actdef->{validations} );
                $sth->execute;
            }
        } );
    } catch {
        $status = $CELL->status_err( 'DOCHAZKA_DBI_ERR', args => [ $_ ] );
    };
    return $status unless $status->ok;
    
    # if auditing is enabled, create the audit triggers
    if ( $site->DOCHAZKA_AUDITING ) {
        $status = create_audit_triggers( $conn );
        return $status unless $status->ok;
    }
    
    $log->notice( "Database $dbname successfully (re-)initialized" );
    return $status;
}


=head2 get_eid_of

Obtain the EIDs of a list of employee nicks. Returns a reference to a hash
where the keys are the nicks and the values are the corresponding EIDs.

NOTE 1: This routine expects to receive a L<DBIx::Connector> object as its
first argument. It does not use the C<$dbix_conn> singleton.

NOTE 2: The nicks are expected to exist and no provision (other than logging a
DOCHAZKA_DBI_ERR) is made for their non-existence.

=cut

sub get_eid_of {
    my ( $conn, @nicks ) = @_;
    $log->debug( "Entering " . __PACKAGE__ . "::get_eid_of" );
    my ( %eids, $status );
    $status = $CELL->status_ok;
    try {
        $conn->run( fixup => sub { 
            my $sth = $_->prepare( $site->DBINIT_SELECT_EID_OF );
            foreach my $nick ( @nicks ) {
                $sth->bind_param( 1, $nick );
                $sth->execute;
                ( $eids{$nick} ) = $sth->fetchrow_array();
                $log->debug( "EID of $nick is $eids{$nick}" );
            }
        } );
    } catch {
        $status = $CELL->status_err( 'DOCHAZKA_DBI_ERR', args => [ $_ ] );
    };
    die $status->text unless $status->ok;
    return \%eids;
}


=head2 version

Accessor method (to be called like a constructor) providing access to C<$VERSION> variable

=cut

sub version { $VERSION; }



=head2 init_arbitrary_script

For scripts that need to manipulate the database directly (i.e. via the data
model).

=cut

sub init_arbitrary_script {
    my ( $ARGS ) = @_;
    my $quiet = 0;
    if ( ref( $ARGS ) eq 'HASH' and exists( $ARGS->{quiet} ) ) {
        $quiet = $ARGS->{quiet};
    }
    my $app_distro = 'App-Dochazka-REST';
    my $sitedir = '/etc/dochazka-rest';
    print "Loading configuration parameters from $sitedir\n" unless $quiet;
    my $status = Web::MREST::init(
        distro => $app_distro,
        sitedir => $sitedir,
    );
    die $status->text unless $status->ok;

    print "Setting up logging\n" unless $quiet;
    my $log_file = normalize_filespec( $site->MREST_LOG_FILE );
    my $should_reset = $site->MREST_LOG_FILE_RESET;
    unlink $log_file if $should_reset;
    Log::Any::Adapter->set( 'File', $log_file );
    my $message = "Logging to $log_file";
    print "$message\n" unless $quiet;
    $log->info( $message );
    if ( ! $site->MREST_APPNAME ) {
        die "Site parameter MREST_APPNAME is undefined - please investigate!";
    }
    $log->init(
        ident => $site->MREST_APPNAME,
        debug_mode => ( $site->MREST_DEBUG_MODE || 0 ),
    );