package DADA::MailingList::Settings; use strict; use lib qw(./ ../ ../../ ../../DADA ../perllib); use DADA::Config qw(!:DEFAULT); use Carp qw(croak carp); if (eval "require DADA::MailingList::Settings::$DADA::Config::SETTINGS_DB_TYPE") { use base "DADA::MailingList::Settings::$DADA::Config::SETTINGS_DB_TYPE"; #return 1; #should this be return 1? }else{ die("cannot find 'DADA::MailingList::Settings::$DADA::Config::SETTINGS_DB_TYPE', $!"); } sub _init { my ($self, $args) = @_; if($self->{new_list} != 1){ croak('BAD List name "' . $args->{-List} . '" ' . $!) if $self->_list_name_check($args->{-List}) == 0; }else{ $self->{name} = $args->{-List}; } } sub get { my $self = shift; my %args = (-Format => "raw", @_); $self->_raw_db_hash; my $ls = $self->{RAW_DB_HASH}; $ls = $self->post_process_get($ls, {%args}); return $ls; } sub post_process_get { my $self = shift; my $ls = shift; my $args = shift; carp "$DADA::Config::PROGRAM_NAME $DADA::Config::VER warning! List " . $self->{function} . " db empty! List setting DB Possibly corrupted!" unless keys %$ls; carp "$DADA::Config::PROGRAM_NAME $DADA::Config::VER warning! no listshortname saved in list " . $self->{function} . " db! List " . $self->{function} . " DB Possibly corrupted!" if ! $ls->{list}; carp "listshortname in db, '" . $self->{name} . "' does not match saved list shortname: '" . $ls->{list} . "'" if $self->{name} ne $ls->{list}; if($args->{-Format} ne 'unmunged'){ $ls = $self->_munge_for_Config_Vars($ls); $ls->{charset_value} = $self->_munge_charset( $ls); $ls = $self->_munge_for_deprecated($ls); # sasl_smtp_password # pop3_password # If we don't need to load, DADA::Security::Password, let's not. my $d_password_check = 0; foreach ('sasl_smtp_password', 'pop3_password'){ if(exists($DADA::Config::LIST_SETUP_DEFAULTS {$_}) || exists($DADA::Config::LIST_SETUP_OVERRIDES {$_})){ $d_password_check = 1; require DADA::Security::Password; last; } } foreach ('sasl_smtp_password', 'pop3_password'){ if($DADA::Config::LIST_SETUP_OVERRIDES{$_}){ $self->{orig}->{LIST_SETUP_OVERRIDES}->{$_} = $DADA::Config::LIST_SETUP_OVERRIDES {$_}; $DADA::Config::LIST_SETUP_OVERRIDES {$_} = DADA::Security::Password::cipher_encrypt($ls->{cipher_key},$DADA::Config::LIST_SETUP_OVERRIDES {$_}); next; } if($DADA::Config::LIST_SETUP_DEFAULTS{$_}){ if(!$ls->{$_}){ $self->{orig}->{LIST_SETUP_DEFAULTS}->{$_} = $DADA::Config::LIST_SETUP_DEFAULTS {$_}; $DADA::Config::LIST_SETUP_DEFAULTS{$_} = DADA::Security::Password::cipher_encrypt($ls->{cipher_key},$DADA::Config::LIST_SETUP_DEFAULTS {$_}); } } } foreach(keys %$ls){ if (exists($ls->{$_})){ if(!defined($ls->{$_})){ delete($ls->{$_}); } } } %$ls = (%DADA::Config::LIST_SETUP_DEFAULTS , %$ls); %$ls = (%$ls, %DADA::Config::LIST_SETUP_OVERRIDES ); $DADA::Config::SUBSCRIPTION_QUOTA ||= undef; # # # This is actually, pretty bizarre. # if($DADA::Config::SUBSCRIPTION_QUOTA ne undef){ # if ($self->_trim($DADA::Config::SUBSCRIPTION_QUOTA) eq '') { # $DADA::Config::SUBSCRIPTION_QUOTA = undef; # } # } if( $DADA::Config::SUBSCRIPTION_QUOTA && $ls->{subscription_quota} && ($ls->{subscription_quota} > $DADA::Config::SUBSCRIPTION_QUOTA) ) { $ls->{subscription_quota} = $DADA::Config::SUBSCRIPTION_QUOTA; } foreach ('sasl_smtp_password', 'pop3_password', 'discussion_pop_password'){ if($DADA::Config::LIST_SETUP_OVERRIDES {$_}){ $DADA::Config::LIST_SETUP_OVERRIDES {$_} = $self->{orig}->{LIST_SETUP_OVERRIDES}->{$_}; } if($DADA::Config::LIST_SETUP_DEFAULTS {$_}){ $DADA::Config::LIST_SETUP_DEFAULTS {$_} = $self->{orig}->{LIST_SETUP_DEFAULTS}->{$_}; } } $ls = $self->_format_settings($ls) if $args->{-Format} eq "replaced"; } return $ls; } sub _existance_check { my $self = shift; my $li = shift; foreach(keys %$li){ #next if $_ eq 'list'; if(!exists($DADA::Config::LIST_SETUP_DEFAULTS{$_})){ croak("Attempt to save a unregistered setting - $_"); } } } sub _format_settings { # I don't like this at all. my ($self, $ls) = @_; for($ls->{subscribed_message}, $ls->{unsubscribed_message}, $ls->{confirmation_message}, $ls->{mailing_list_message}, $ls->{not_allowed_to_post_message}, $ls->{html_confirmation_message}, $ls->{html_unsub_confirmation_message}, $ls->{html_subscribed_message}, $ls->{html_unsubscribed_message}, $ls->{unsub_confirmation_message} ){ $_ =~ s/\[list\]/$ls->{list}/g; $_ =~ s/\[list_name\]/$ls->{list_name}/g; $_ =~ s/\[list_info\]/$ls->{info}/g; $_ =~ s/\[list_owner_email\]/$ls->{list_owner_email}/g; $_ =~ s/\[list_admin_email\]/$ls->{admin_email}/g; $_ =~ s/\[privacy_policy\]/$ls->{privacy_policy}/g; $_ =~ s/\[list_privacy_policy\]/$ls->{privacy_policy}/g; $_ =~ s/\[physical_address\]/$ls->{physical_address}/g; $_ =~ s/\[program_url\]/$DADA::Config::PROGRAM_URL/g; } return $ls; } sub _munge_for_Config_Vars { my ($self, $li) = @_; # Keeping this around... for now.. $li->{subscribed_message} ||= $DADA::Config::LIST_SETUP_DEFAULTS{subscribed_message}; $li->{unsubscribed_message} ||= $DADA::Config::LIST_SETUP_DEFAULTS{unsubscribed_message}; $li->{confirmation_message} ||= $DADA::Config::LIST_SETUP_DEFAULTS{confirmation_message}; $li->{unsub_confirmation_message} ||= $DADA::Config::LIST_SETUP_DEFAULTS{unsub_confirmation_message}; $li->{mailing_list_message} ||= $DADA::Config::LIST_SETUP_DEFAULTS{mailing_list_message} ; $li->{mailing_list_message_html} ||= $DADA::Config::LIST_SETUP_DEFAULTS{mailing_list_message_html}; $li->{not_allowed_to_post_message} ||= $DADA::Config::LIST_SETUP_DEFAULTS{not_allowed_to_post_message}; $li->{html_confirmation_message} ||= $DADA::Config::LIST_SETUP_DEFAULTS{html_confirmation_message}; $li->{html_unsub_confirmation_message} ||= $DADA::Config::LIST_SETUP_DEFAULTS{html_unsub_confirmation_message}; $li->{html_subscribed_message} ||= $DADA::Config::LIST_SETUP_DEFAULTS{html_subscribed_message}; $li->{html_unsubscribed_message} ||= $DADA::Config::LIST_SETUP_DEFAULTS{html_unsubscribed_message}; $li->{send_archive_message} ||= $DADA::Config::LIST_SETUP_DEFAULTS{send_archive_message}; $li->{send_archive_message_html} ||= $DADA::Config::LIST_SETUP_DEFAULTS{send_archive_message_html}; $li->{invite_message_text} ||= $DADA::Config::LIST_SETUP_DEFAULTS{invite_message_text}; $li->{invite_message_html} ||= $DADA::Config::LIST_SETUP_DEFAULTS{invite_message_html}; # i guess this is here because it goes well with the above 2 $li->{you_are_already_subscribed_message} ||= $DADA::Config::LIST_SETUP_DEFAULTS{you_are_already_subscribed_message} ; if(! exists($li->{invite_message_subject}) || $li->{invite_message_subject} eq undef){ $li->{invite_message_subject} ||= $li->{list_name} . ' Invitation'; } return $li; } sub _munge_charset { my ($self, $li) = @_; if(!exists($li->{charset})){ $li->{charset} = $DADA::Config::LIST_SETUP_DEFAULTS{charset}; } my $charset_info = $li->{charset}; my @labeled_charsets = split(/\t/, $charset_info); return $labeled_charsets[$#labeled_charsets]; } sub _munge_for_deprecated { my ($self, $li) = @_; $li->{list_owner_email} ||= $li->{mojo_email}; $li->{admin_email} ||= $li->{list_owner_email}; $li->{privacy_policy} ||= $li->{private_policy}; #we're talkin' way back here.. if(!exists($li->{list_name})){ $li->{list_name} = $li->{list}; $li->{list_name} =~ s/_/ /g; } return $li; } sub _trim { my ($self, $s) = @_; return DADA::App::Guts::strip($s); } 1; =pod =head1 COPYRIGHT Copyright (c) 1999-2007 Justin Simoni All rights reserved. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. =cut