OpusVL-Preferences

 view release on metacpan or  search on metacpan

lib/OpusVL/Preferences/RolesFor/Result/PrfOwner.pm  view on Meta::CPAN

package OpusVL::Preferences::RolesFor::Result::PrfOwner;

=head1 DESCRIPTION

If you are using DBIx::Class::Schema::Loader add the necessary link fields manually, otherwise 
add the following line to add the fields to your result class.

    __PACKAGE__->prf_owner_init;

=head1 SYNOPSIS

=head1 METHODS

=head2 prf_owner_init

Tries to add the columns and relationships for your result class.  Call it like this,

    __PACKAGE__->prf_owner_init;

Your mileage may vary.

=head2 prf_defaults

ResultSet for the defaults.

=head2 prf_preferences

ResultSet of the preference values.

=head2 prf_get

Gets the setting.  If the object doesn't have the setting specified but there is a 
default, the default will be returned.

=head2 prf_set

Sets the setting for the object.

=head2 prf_reset

Resets the settings against the object.  prf_get may still return a value if there is a default 
for the setting.

=head2 preferences_to_array

Returns an array of the current results preferences.

    $object->preferences_to_array();
    # [{
    #     name => $_->name, 
    #     value => $_->value,
    #     param => # assocaited PrfDefault parameter definition.
    # } ];

=head2 safe_preferences_in_array

Returns the same as preferences_to_array but instead of the param object it returns the 
field label.  The safe refers to the fact that all the items in the hash are base types
and therefore are trivially serializable.

=head2 safe_prefs_to_hash

Returns the same as safe_prefs_to_hash but converts it to a hash for easier use.

=head1 COPYRIGHT and LICENSE

Copyright (C) 2011 OpusVL

This software is licensed according to the "IP Assignment Schedule" provided with the development project.

=cut

use v5.24;
use strict;
use warnings;
use Moose::Role;
use Scalar::IfDefined qw/$ifdef/;

sub _schema {
    state $schema = OpusVL::FB11::Hive
        ->fancy_hat('preferences')
        ->schema;
}

=head2 prf_id_column

Provides the default column that contains the preferences identifier.

If your Result doesn't have a standard integer primary key called 'id', override
this with the name of another column that I<is> an identifying integer

=cut

sub prf_id_column {'id'}

sub prf_owner_init
{
	my $class = shift;

	$class->add_columns
	(
		prf_owner_type_id =>
		{
			data_type      => 'integer',
			is_nullable    => 1,
			is_foreign_key => 1
		}
	);
}

sub prf_owner {
    my $self = shift;
    return $self->_schema->resultset('PrfOwner')->find({
        prf_owner_type_id => $self->prf_owner_type_id,
        prf_owner_id => $self->${ \$self->prf_id_column },
    });
}

sub prf_owner_type {
    my $self = shift;
    return $self->_schema->resultset('PrfOwnerType')->find({
        prf_owner_type_id => $self->prf_owner_type_id
    });

lib/OpusVL/Preferences/RolesFor/Result/PrfOwner.pm  view on Meta::CPAN

	({
		prf_owner_id      => $self->$prf_id_column,
		prf_owner_type_id => $type->prf_owner_type_id
	});
	
	$self->update ({ prf_owner_type_id => $type->prf_owner_type_id });
};

sub prf_defaults
{
	my $self = shift;

	return $self->prf_owner_type->prf_defaults;
}

sub prf_preferences
{
	# this could maybe be achieved with a proper DBIx::Class relationship, but
	# this will do for now

	my $self = shift;

	return $self->prf_owner->$ifdef('prf_preferences');
}

sub preferences_to_array
{
    my $self = shift;

    my $preferences = $self->prf_preferences
        or return [];

    my @expanded;
    for my $pref ($preferences->all)
    {
        my $param = $self->prf_defaults->find({ name => $pref->name });
        push @expanded, {
            name => $pref->name, 
            value => $param->decryption_routine->($pref->value),
            param => $param,
        };
    }
    my @d = sort { 
        $a->{param}->display_order <=> $b->{param}->display_order 
    } @expanded;
    return \@d;
}

sub safe_preferences_in_array
{
    my $self = shift;
    my $extra_params = $self->preferences_to_array;
    my @cleaned_up = map { { 
        name => $_->{name},
        value => $_->{value},
        label => $_->{param}->comment,
    } } @$extra_params;
    return \@cleaned_up;
}

sub safe_prefs_to_hash
{
    my $self = shift;
    my $info = $self->safe_preferences_in_array;
    my %hash = map { $_->{name} => $_->{value} } @$info;
    return \%hash;
}

sub prf_get
{
	my $self = shift;
	my $name = shift;

	my $default = $self->prf_defaults->search ({ name => $name })->first;
    die "Field $name not setup" unless $default;

	my $pref = $self->prf_preferences->search ({ name => $name })->first;
    my $value;
    $value = $pref->value if $pref;
    if($default->encrypted)
    {
        if($pref)
        {
            my $schema = _schema;
            my $crypto = $schema->encryption_client;
            if($crypto)
            {
                $value = $crypto->decrypt($value);
            }
        }
    }
    return $value if defined $value;

    # FIXME: should probably look at encrypting defaults,
    # although, then again, do we need to?
	return $default->default_value
		if defined $default;

	return;
}

sub _clear_out_inactive_unique_values
{
    my $self = shift;
    my $prefname = shift;
    my $field = shift;

    my $schema = $self->_schema;
    my $obj_rs = $schema->resultset($self->prf_owner_type->owner_resultset);
    if($obj_rs->can('inactive_for_unique_params'))
    {
        my $rs = $obj_rs->inactive_for_unique_params;
        $schema->resultset('PrfOwner')->search({
            "prf_preferences.prf_owner_id"      => {
                -in => [ $rs->get_column($self->prf_id_column)->all ],
            },
            "prf_preferences.prf_owner_type_id" => $self->prf_owner_type_id
        })
        ->search_related('prf_preferences',
           {
               "prf_preferences.name" => $prefname,
               "prf_preferences.prf_owner_type_id" => $field->prf_owner_type_id,
           }
        )->search_related('unique_value')->delete;
    }
}

sub prf_set
{
	my $self     = shift;
	my $prefname = shift;
	my $value    = shift;

	my $allprefs = $self->prf_preferences;
	
	my $pref = $allprefs->search ({ name => $prefname })->first;
	my $field = $self->prf_defaults->search ({ name => $prefname })->first;
	unless($field)
	{
		die "Field $prefname not setup.";
	}

    if($field->encrypted)
    {
        my $schema = $self->result_source->schema;
        my $crypto = $schema->encryption_client;

        # if we need to search or ensure unique values,
        # then we have to use deterministic encryption
        # which is less secure, but still encrypted.

        if($crypto)
        {
            if($field->unique_field || $field->searchable)
            {
                $value = $crypto->encrypt_deterministic($value);
            }
            else
            {
                $value = $crypto->encrypt($value);
            }
        }
    }
	if ($pref)
	{
		$pref->update ({ value => $value });

        if($field->unique_field)
        {
            $self->_clear_out_inactive_unique_values($prefname, $field);
            my $unique_val = $pref->unique_value;
            if($unique_val)
            {
                my $place_holder = $value;
                if($field->data_type eq 'email')
                {
                    $place_holder = lc $value; 
                }
                $unique_val->value($place_holder);
                $unique_val->update;
            }
            else
            {
                $pref->create_related('unique_value', { value => $value });
            }
        }
	}
	else
	{
        my $data = {
			name  => $prefname,
			value => $value
		};
        if($field->unique_field)
        {
            $self->_clear_out_inactive_unique_values($prefname, $field);
            my $place_holder = $value;
            if($field->data_type eq 'email')
            {
                $place_holder = lc $value; 
            }
            $data->{unique_value} = { value => $place_holder };
        }
		$allprefs->create($data);
	}
}

sub prf_reset
{
	my $self = shift;
	my $name = shift;

    my $val = $self->prf_preferences->search ({ 'me.name' => $name });
    $val->search_related('unique_value')->delete;
	$val->delete;
}

return 1;



( run in 0.722 second using v1.01-cache-2.11-cpan-8f98c5d2c55 )