View of /DadaFork/DADA/MailingList/Archives/baseSQL.pm

Parent Directory

Revision Log

Base version: DadaMail 2.10.12

package DADA::MailingList::Archives::baseSQL; 

use strict; 
use DADA::Config qw(!:DEFAULT);  
use DADA::MailingList::Settings; 
use DADA::App::Guts;

use Carp qw(carp croak); 

my $database         = $DADA::Config::SQL_PARAMS{database};
my $dbserver         = $DADA::Config::SQL_PARAMS{dbserver};    	  
my $port             = $DADA::Config::SQL_PARAMS{port};     	  
my $user             = $DADA::Config::SQL_PARAMS{user};         
my $pass             = $DADA::Config::SQL_PARAMS{pass};
my $dbtype           = $DADA::Config::SQL_PARAMS{dbtype};

if(!$dbtype){ 
	$dbtype = 'mysql' if $DADA::Config::SUBSCRIBER_DB_TYPE eq 'MySQL';
	$dbtype = 'Pg'    if $DADA::Config::SUBSCRIBER_DB_TYPE eq 'PostgreSQL';	
 }
 
use lib qw(./ ../ ../../ ../../../ ./../../DADA ../../perllib); 


use DBI;
use Fcntl qw(O_WRONLY 
             O_TRUNC 
             O_CREAT 
             O_CREAT 
             O_RDWR
             O_RDONLY
             LOCK_EX
             LOCK_SH 
             LOCK_NB
            ); 

my $dbi_obj = undef; 


my %fields; 


sub new {

	my $class = shift;
	my %args = (-List => undef, 
				@_); 
	   my $self = {};	
	   #in this case, $args{-List} contains a hashref with the list information. Yeah, duh. 
	   		
       bless $self, $class;
	   $self->_init(%args);  
	
	$self->{list_info} = $args{-List};
	$self->{name}      = $self->{list_info}->{list};	
		
	return $self; 
}

sub _init  { 

    my $self = shift; 
    my %args = @_; 
    %fields  = %args; 
  
    $self->{list}       = $args{-List}->{list};
	
	$self->{ignore_open_db_error} = $args{ignore_open_db_error} 
		if $args{ignore_open_db_error} && $args{ignore_open_db_error} == 1; 


	my $ls = DADA::MailingList::Settings->new(-List => $self->{list}); #we probably don't need this... 

	$ls->{ignore_open_db_error} = 1
		if $self->{ignore_open_db_error} && $self->{ignore_open_db_error} == 1;
  	
    $self->{list_info}  = $ls->get;
    $self->{sql_params} = {%DADA::Config::SQL_PARAMS};
    $self->{msg_cache} = {};
    
    
   
   if(!$dbi_obj){ 
		require DADA::App::DBIHandle; 
		$dbi_obj = DADA::App::DBIHandle->new; 
		$self->{dbh} = $dbi_obj->dbh_obj; 
	}else{ 
		$self->{dbh} = $dbi_obj->dbh_obj; 
	}
	
	
	if($args{-parser}){ 
		$self->{parser} = $args{-parser};
	}
}




sub can_display_attachments { 
	
	my $self = shift; 
	return 1; 

}

sub can_display_message_source { 
	
	my $self = shift; 
	return 1; 

}



sub print_message_source { 

	my $self = shift; 
	my $fh   = shift; 
	my $id   = shift; 
	
	croak "no id!" if ! $id; 
	croak "no fh!" if ! $fh; 
	
	croak "archive backend does not support viewing message source!" 
	 	unless can_display_message_source; 
	 	
	my ($subject, $message, $format, $raw_msg) = $self->get_archive_info($id); 
	
	print $fh $raw_msg;

}

sub get_available_archives{ 
	
	my $self = shift;	
	my @list; 
	my $query  = 'SELECT DISTINCT list FROM '. $self->{sql_params}->{archives_table};
	my $sth    = $self->{dbh}->prepare($query);    
							   
	$sth->execute() or croak "cannot do statment! $DBI::errstr\n";   

   while((my $list) = $sth->fetchrow_array){ 
		push(@list, $list); 
	}
	$sth->finish;
	return \@list; 

} 




=pod


=head2 get_archive_entries

	my $entries = $archive -> get_archive_entries(); 

this will give you a refernce to an array that has the keys to your entries there. 

=cut 



sub get_archive_entries { 
	
	my $self  = shift;
	my $order = shift || 'normal';
	my @keys; 
	my $in_reverse = $self->{list_info}->{sort_archives_in_reverse} || 0; #yeah, like what?
		
	my $query  = 'SELECT archive_id FROM '. $self->{sql_params}->{archives_table} . 
	             ' WHERE list = ? ORDER BY archive_id ASC';
	
	#warn 'query: ' . $query;
	
	my $sth = $self->{dbh}->prepare($query); 
	   $sth->execute($self->{name});
	
	while((my $archives_id) = $sth->fetchrow_array){
		push(@keys, $archives_id); 
	}
	
    $sth->finish;
    
    if($order eq 'reverse' || $in_reverse == 1){ 
		@keys = reverse @keys;
	}	
	return \@keys;
}



sub get_archive_info{ 

	my $self  = shift; 
	my $key   = shift; 
	   $key   = $self->_massaged_key($key); 
	my $cache = shift || 0; 
	
	if($self->{msg_cache}->{$key}){ 
		# warn "i'm cached!"; 
		return ($self->{msg_cache}->{$key}->[0], $self->{msg_cache}->{$key}->[1], $self->{msg_cache}->{$key}->[2], $self->{msg_cache}->{$key}->[3]); 
		
	}else{ 
	
		my $query = 'SELECT * FROM ' . 
					 $self->{sql_params}->{archives_table} . 
					 ' WHERE archive_id = ? AND list = ?';
	
		my $sth = $self->{dbh}->prepare($query); 
		   $sth->execute($key, $self->{name});
		my $a_entry = $sth->fetchrow_hashref(); 
		   $sth->finish;  
		   
		   
		if($cache){ 
			# warn "I'm caching!"; 
			$self->{msg_cache}->{$key} = [$a_entry->{subject}, $a_entry->{message},$a_entry->{format}, $a_entry->{raw_msg}]; 
		}
		
		
		$a_entry->{subject} = $self->strip_subjects_appended_list_name($a_entry->{subject})
			if $self->{list_info}->{no_append_list_name_to_subject_in_archives} == 1; 

        if(! strip($a_entry->{subject})){ 
		    $a_entry->{subject} = $DADA::Config::EMAIL_HEADERS{Subject}; 
		}


		return ($a_entry->{subject}, $a_entry->{message},$a_entry->{format}, $a_entry->{raw_msg}); 

	}
}





=pod

=head2 set_archive_info

	$archive -> set_archive_info($subject, $message, $format, $raw_msg);

changes the archive's info (yo) 


=cut





sub set_archive_info { 

	my $self = shift; 
	
	my $key = shift; 
	   $key = $self->_massaged_key($key); 
	
	if($key){ 
		
		my $ping = 1; 
		
		if($self->check_if_entry_exists($key)){ 
			$self->delete_archive($key); 
			$ping = 0; 
		}
		
		my $new_subject = shift; 
		my $new_message = shift;
		my $new_format  = shift;
		my $raw_msg     = shift; 
		
		
		if((!$new_message) && ($raw_msg)){ 
			($new_message, $new_format) = $self->_faked_oldstyle_message($raw_msg);
		}
		
		if($self->{list_info}->{enable_open_msg_logging} == 1){ 
			if($new_format !~ /plain/){ 
				$new_message = $self->_remove_opener_image($new_message);
				$raw_msg     = $self->_remove_opener_image($raw_msg);
			}
		}
		
		my $query = 'INSERT INTO '. $self->{sql_params}->{archives_table} .' VALUES (?,?,?,?,?,?)';
		
		my $sth   = $self->{dbh}->prepare($query); 
		   $sth->execute($self->{name}, $key, $new_subject, $new_message, $new_format, $raw_msg); #shouldn't key and list be reversed in the table?
	
		require DADA::App::ScreenCache; 
		my $c = DADA::App::ScreenCache->new; 
	       $c->flush;
	
		$self->send_pings()
			if $ping == 1; 
	
		return 1; 
	
	}else{ 
	
		carp "no key passed!"; 
		return undef; 		
	
	}
	
}




=pod

=head2 search_entries

 my $search_results = $archive->search_entries($keyword); 

Given a $keyword, will return a array ref of archive key/ids that contain the 
keyword. 

=cut

sub search_entries { 

	my $self    = shift; 
	my $keyword = shift; 
	my @results; 

	my $query  = 'SELECT archive_id FROM '. $self->{sql_params}->{archives_table} . 
			     ' WHERE list = ? AND (raw_msg LIKE ? OR subject LIKE ?) ORDER BY archive_id DESC';

	my $sth = $self->{dbh}->prepare($query); 
	   $sth->execute($self->{name}, '%'.$keyword.'%', '%'.$keyword.'%');
	
	while((my $archives_id) = $sth->fetchrow_array){		
		push(@results, $archives_id); 
	}

	return \@results;
}



=pod

=head2 delete_archive

	delete_archive($key);

deletes the archive entry. 

=cut


sub delete_archive { 

	my $self      = shift;
	my @deep_six  = @_;
	my @good_list = (); 
	
	carp "no key passed to remove entries!"
		if !$deep_six[0];
	
	foreach(@deep_six){ 
		$_ = $self->_massaged_key($_);  
		if($self->check_if_entry_exists($_)){ 
			push(@good_list, $_);
		}else{ 
			carp "error removing entry, '$_' doesn't exist?";  
		}
	}
	
	foreach(@good_list){ 
	
		my $key = $_; 	
		my $query =  'DELETE FROM ' . $self->{sql_params}->{archives_table} . ' WHERE archive_id = ? AND list = ?';
		
		my $sth = $self->{dbh}->prepare($query); 
		
		$sth->execute($key, $self->{name}); 
		$sth->finish;
    
    }
	
	require DADA::App::ScreenCache; 
	my $c = DADA::App::ScreenCache->new; 
	   $c->flush;
	   
    
}




sub delete_all_archive_entries {

	my $self  = shift; 
	my $query =  'DELETE FROM ' . $self->{sql_params}->{archives_table} . ' WHERE list = ?';
	
	my $sth   = $self->{dbh}->prepare($query); 
    
    $sth->execute($self->{name}); 
    $sth->finish;
    
	return 1;	

}



sub removeAllBackups {
	# no backups are created, 
	# so no backups to remove - all right!
}




sub make_table { 

	my $self = shift; 
	
	my $query = 'CREATE TABLE dada_archives (list varchar(32), archive_id varchar(32), subject text, message text, format text, raw_msg text);';
	my $sth   = $self->{dbh}->prepare($query); 
	   $sth->execute()
	   		or croak "cannot do statment! $DBI::errstr\n";   

}




sub uses_backupDirs { 
	my $self = shift; 
	return 0; 
}




sub DESTROY { 
	my $self = shift; 
	
   $self->{parser}->filer->purge
	if $self->{parser};


}





# Probably only need to convert this if I want to do a backup thingy.
#sub get { 
#	my $self = shift;
#	return $self->{DB_HASH}; 
#}



# Probably only need to convert this if I want to do a backup thingy.
#sub save { 
#	my $self     = shift; 
#	my $new_vals = shift; 
#	
#	$self->_close_db;
#	
#	# hack. fix later. 
#	my %tmp; 
#	chmod($DADA::Config::FILE_CHMOD , $self->_db_filename)
#		if -e $self->_db_filename; 
#	tie %tmp, "AnyDBM_File", $self->_db_filename,  O_RDWR|O_CREAT, $DADA::Config::FILE_CHMOD   
#	or croak 'couldn\'t tie '. $self->_db_filename . ' for reading: ' . $! .  '; If your server recently upgraded software or moved your lists to a different server, you may need to restore your list ' . $self->{function} . '. Visit ' . 
#			$DADA::Config::PROGRAM_URL . '?f=restore_lists '; 
#	%tmp = %$new_vals; 
#	untie %tmp; 
#	$self->_open_db;
#}


1;