=pod

=head1 NAME

MOJO::Archive


=head1 SYNOPSIS

use MOJO::Archive;

	my $archive = MOJO::Archive->new(-List => \%list); 

=head1 DESCRIPTION

Archive interface to a simple tied hash archiving system for messages saved in Mojo Mail 

=cut

#This Module is used for archives of Mojo Mail, if you
# didn't get the jist from the name there buddy.

package MOJO::Archive; 
use lib '.'; 
use lib '../'; 
use lib './'; 
use lib 'MOJO';

use MOJO::Config; 
use MOJO::Guts; 

use strict; 
use vars qw($AUTOLOAD); 
use Carp; 
use Fcntl;
use AnyDBM_File; 

my $archive_name; 
my $archive_path; 
my $list_ref; 
my $opened_archive; 
my %Archive;

my %allowed = (); 

=pod

=head1 SUBROUTINES

=over 

=item new

	my $archive = MOJO::Archive ->new(-List => \%list); 

this wil tie the db hash and get you going with this whole gosh darn thing
if it has a valid list, it will open up the archive and get to work on it.
  
=cut



sub new { 


# the "new" function, wee
my $that = shift; 
my $class = ref($that) || $that; 

my $self = {
    _permitted => \%allowed, 
    %allowed,
}; 

bless $self, $class;

#we gots some stuff passed to this darn thing
my %args = (
-List    => undef, 
-Path    => $ARCHIVES, 
@_,
); 


$list_ref  = $args{-List}; 
$archive_name = $list_ref ->{list} || undef; 
$archive_path = $args{-Path}; 


$self -> _open_archive(); 

return $self; 

}

#the "autoload" function
sub AUTOLOAD { 
    my $self = shift; 
    my $type = ref($self) 
    or croak "$self is not an object"; 
    my $name = $AUTOLOAD;
    $name =~ s/.*://; #strip fully qualifies portion 
    unless (exists  $self -> {_permitted} -> {$name}) { 
    croak "Can't access '$name' field in object of class $type"; 
    }
    
    if(@_) { 
        return $self->{$name} = shift; 
    } else { 
        return $self->{$name}; 
    }
}


=pod


=item _open_archive 

private function for this module, this is what actually does the opening. 

=cut



sub _open_archive { 

my $warning; 
 
my $list_archive; 

$list_archive = "mj-$archive_name-archive";

 
 #untaint 
$list_archive = make_safer($list_archive); 
$list_archive =~ /(.*)/; 
$list_archive = $1; 

tie %Archive, "AnyDBM_File", "$archive_path/$list_archive",  O_RDWR|O_CREAT, $FILE_CHMOD or $warning = 1;


if($warning){

$opened_archive = $warning; 
return $warning;
}else{ 
$opened_archive = \%Archive; 
return \%Archive;
}                   
}


=pod

=item get_available-archives

	my $array_ref = $archive -> get_available_archives(); 

this will return a reference to an array of a list of mojo lists that have archives available 

=cut 




sub get_available_archives{ 
my $self = shift;


my @all_dbs = ();
my @available_lists = (); 
my @available_archives = ();

while (defined(my $present_list = <$archive_path/mj-*>)){
  
  $present_list =~ s#.*/##;
  $present_list =~ s/mj-//;
  $present_list =~ s/\..*//; 
  push(@all_dbs, $present_list);                             
     
     }
     
     
     foreach my $all_those(@all_dbs) { 
     if($all_those =~ m/.*-archive/) { 
      push( @available_archives, $all_those)
     
 

}
}    
@available_archives = sort(@available_archives); 
my %seen = (); 
my @unique = grep {! $seen{$_} ++ }  @available_archives; 
return \@unique; 




} 


=pod

=item archive_exists 

	my $archive_exists = $archive -> archive_exists($archive); 

this sees if an archive is there, returns  1 if you're gold, zero if its a stinker. 

=cut 



sub archive_exists { 
my $self = shift; 
my $archive = shift; 

my $available_archives = $self -> get_available_archives(); 
my $test = 0;

foreach(@$available_archives){
if($_ eq $archive){ 
$test++; 
}
}

return $test; 
}


=pod


=item get_available_archive 

	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; 
@keys = sort { $a <=> $b  } keys %Archive;
my $in_reverse = $list_ref ->{sort_archives_in_reverse} || 0;

if($order eq 'reverse' || $in_reverse == 1){ 
	@keys = reverse @keys;
}


return \@keys;

}

=pod

=item get_archive_subject

	my $subject = get_archive_subject($key);

gets the subject of the given $key

=cut



sub get_archive_subject { 
my $self = shift; 
my $key = shift; 

my ($subject, $message, $format) = split(/\[::\]/, $Archive{$key}); 
return $subject; 
}


=pod

=item get_neighbors

	my ($prev, $next) = $archive -> get_neighbors();

this will tell you in the frame of reference of what message you're on, 
what the previous and next entry keys are. 

=cut




sub get_neighbors { 
my $self = shift; 
my $key = shift;
my $entries = $self -> get_archive_entries(); 


my $i = 0; 
my %lookup_hash; 

foreach(@$entries){ 
$lookup_hash{$_} = $i;
$i++;  
}
my $index = $lookup_hash{$key}; 

my $prev = $entries -> [$index-1] || undef;  
my $next = $entries -> [$index+1] || $entries -> [0]; 

return ($prev, $next); 


}

=pod

=item create_index

	my ($begin, $stop) = $archive -> create_index($start);

This 'll tell you what to print on each archive index. 
something like, 'start on teh 40th message and end on the 50th'

=cut


sub create_index { 
my $self = shift; 
my $here = shift || 0; 
my $amount = $list_ref ->{archive_index_count} || 10;
my $entries = $self -> get_archive_entries() || undef; 

if($entries){ 

my ($start, $stop);    
    $start = $here;

#if($stop > $#{$entries}){ 
#$stop =  $#{$entries}; 
#}else{ 
$stop = ($start + $amount)-1; 
#}
return ($start, $stop);
}


}

=pod

=item create_index_nav

	print $archive -> create_index_nav($list_info{list}, $stopped_at);

creates a HTML table that looks like this: 


                  <<Prev                      Next >>

at the bottom of each archive index

=cut 


sub create_index_nav { 
my $self          = shift; 
my $list          = shift; 
my $stopped_at    = shift; 


my $iterate       = $list_ref ->{archive_index_count} || 10;
my $entries       = $self     -> get_archive_entries(); 

my $forward = $stopped_at;


my $back; 

# let see if we're at some weird halfway between point
my $mod_check = $stopped_at % $iterate; 
my $fixer; 
my $full_stop = $stopped_at; 

if($mod_check > 0){ 
	# substract it from the iterate 
	$fixer = $iterate - $mod_check; 
	$full_stop +=  $fixer; 
}

$back    = ($full_stop - ($iterate*2)); 



my $prev_link; 
my $next_link;

if($back >= 0){
$prev_link = "&lt;&lt; <a href=$MOJO_URL?flavor=archive&list=$list&start=$back>Previous</a>"; 
}else{
$prev_link = "&nbsp;"; 
}


if($forward  < $#{$entries}){
$next_link = "<a href=$MOJO_URL?flavor=archive&list=$list&start=$forward>Next</a> &gt;&gt;"; 
}else{
$next_link = "&nbsp;";

}


my $index_link = "<a href=$MOJO_URL?flavor=archive&list=$list>Archive Index</a> ";


my $table = <<EOF 

<table cellpadding=5 width=100%> 
 <tr>
  <td valign=top align=left width=33%>
   <p><b> $prev_link</b></p>
  </td> 
  
  <td valign=top align=right width=33%> 
   <p><b>$next_link</b></p>
  </td>
 </tr>
</table> 

EOF
;


return $table; 


}

=pod

=item make_nav_table, 

	print $archive -> make_nav_table(-Id => $id, -List => $list_info{list}); 

this will make a HTML table that has the previous message, the index and the next message 
like this: 


<< My Previous Message    |Archive Index|      My Next Message 


=cut


sub make_nav_table { 
my $self = shift; 


my %args = ( 
-List      =>    undef, 
-Id        =>    undef, 
-Function  =>    'visitor',
@_,
);



my $id   = $args{-Id}; 
my $list = $args{-List}; 
my $function = $args{-Function}; 
my $flavor_label; 

if($function eq "admin"){ 
$flavor_label = "view_archive"; 
}else{ 
$flavor_label = "archive"; 
}  
 
 my ($next, $prev); 
 
 
($prev, $next) = $self -> get_neighbors($id); 



my $prev_subject  = $self -> get_archive_subject($prev); 
my $next_subject  = $self -> get_archive_subject($next); 


my $prev_link;
my $next_link;


if (defined($prev)){
$prev_link = "&lt;&lt; <a href=$MOJO_URL?flavor=$flavor_label&list=$list&id=$prev>$prev_subject</a>"; 
}else{ 
$prev_link = "&nbsp;"; 
} 
if (defined($next)){
$next_link = "<a href=$MOJO_URL?flavor=$flavor_label&list=$list&id=$next>$next_subject</a>  &gt;&gt;"; 
}else{ 
$next_link = "&nbsp;"; 
} 

my $index_link = "<a href=$MOJO_URL?flavor=$flavor_label&list=$list>Archive Index</a> ";


my $table = <<EOF 

<table cellpadding=5 width=100%> 
 <tr>
  <td valign=top align=left width=33%>
   <p><b> $prev_link</b></p>
  </td> 
  <td valign=top align=middle width=33%>
   <p>| <b>$index_link</b> |</p>
  </td> 
  <td valign=top align=right width=33%> 
   <p><b>$next_link</b></p>
  </td>
 </tr>
</table> 

EOF
;

return $table;

}

=pod

=item make_search_form

	print $archive -> make_search_form(); 

this prints out the correct HTML form to make for your archives. 

=cut


sub make_search_form { 
my $self = shift; 
my $list = shift; 

my $form = <<EOF

<table width=100%><tr><td>
<p><b>Search</b> This list's archives</p> 
</td></tr>

</form> <form action=$MOJO_URL method=POST>  
<tr><td>

<input type=text name=keyword size=12> 
<input type=hidden name=list value="$list"> 
<input type=hidden name=flavor value=search_archive> 
<input type=submit style='$STYLE{green_submit}' value=Search>

</td></form></tr></table>


EOF
; 


return $form; 






}

=pod


=item zap_sig 

	my $zapped = $archive -> zap_sig($unzapped); 

This little subroutine takes a string and returns it, stopping when it reaches
a double dash '--' usually this refers to where the message stops and the 
sig starts. It looks for the double dashes at the begining of the line. 
 
=cut 



sub zap_sig { 
my $self = shift; 
my $message = shift; 
my @msg_lines = split(/\n(?!\s)/, $message);

my $new_message = ""; 




foreach my $line(@msg_lines){ 
last if($line =~ m/^--$/); 
$new_message .= "$line \n";
}

return $new_message; 

}

=pod

=item get_archive_message

	my $message = get_archive_message($key);

gets the message of the given $key

=cut


sub get_archive_message { 
my $self = shift; 
my $key = shift; 

my ($subject, $message, $format) = split(/\[::\]/, $Archive{$key}); 
return $message; 


}

=pod

=item get_archive_format

	my $format = get_archive_format($key); 

gets the format of the given $key

=cut



sub get_archive_format { 
my $self = shift; 
my $key = shift; 

my ($subject, $message, $format) = split(/\[::\]/, $Archive{$key}); 
return $format; 
}



=pod

=item get_archive_subject($key); 

my $subject, $message, $format = $archive -> get_archive_subject($key); 


gets the subject of the given $key

=cut


sub get_archive_info{ 

my $self = shift; 
my $key = shift; 

my ($subject, $message, $format) = split(/\[::\]/, $Archive{$key}); 
return ($subject, $message, $format); 


}


=pod

=item check_if_entry_exists;


see if an entry exists, returns 1 when its there, 0 if it aint

=cut


sub check_if_entry_exists {
my $self = shift;  
my $entry = shift; 
my $entry_list = $self -> get_archive_entries(); 
my $test = 0; 

foreach(@$entry_list){ 
if($_ eq $entry){ 
$test++; 
}
}
return $test; 


}

=pod

=item set_archive_subject();

$archive -> set_archive_subject($subject);

changes the archive's subject (yo) 


=cut



sub set_archive_subject { 
my $self = shift; 
my $key = shift; 
my $new_subject = shift; 

my ($subject, $message, $format) = split(/\[::\]/, $Archive{$key}); 

$Archive{key} = join("\[::\]", 
$new_subject, 
$message,
$format
); 

return 1; 

}


=pod

=item set_archive_message();

	$archive -> set_archive_message($message);

changes the archive's message (yo) 


=cut



sub set_archive_message { 
my $self = shift; 
my $key = shift; 
my $new_message = shift; 

my ($subject, $message, $format) = split(/\[::\]/, $Archive{$key}); 

$Archive{key} = join("\[::\]", 
$subject, 
$new_message,
$format
); 

return 1; 

}



=pod

=item set_archive_format

	$archive -> set_archive_format($format);

changes the archive's format (yo) 


=cut



sub set_archive_format { 
my $self = shift; 
my $key = shift; 
my $new_format = shift; 

my ($subject, $message, $format) = split(/\[::\]/, $Archive{$key}); 

$Archive{key} = join("\[::\]", 
$subject, 
$message,
$new_format
); 

return 1; 

}

=pod

=item set_archive_info

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

changes the archive's info (yo) 


=cut





sub set_archive_info { 
my $self = shift; 
my $key = shift; 
my $new_subject = shift; 
my $new_message = shift;
my $new_format  = shift;

$Archive{$key} = join("\[::\]", 
$new_subject, 
$new_message,
$new_format
); 

return 1; 

}

=pod

=item delete_archive

	delete_archive($key);

deletes the archive entry. 

=cut


sub set_raw_info {
my $self = shift; 
my $k    = shift;
my $v    = shift; 

$Archive{$k} = $v; 

}



sub delete_archive { 


my $self = shift; 
my $key = shift; 

delete($Archive{$key}); 




}


=pod


=item search_entries

	my $results = search_entries($keyword);

this is a funky subroutine that returns a refernce to an array of keys that 
has the $keyword in the subject or message, otherwise known as a "search"? 

=cut


sub search_entries{ 
my $self = shift; 
my $keyword = shift; 
my @results; 

my $entries = $self -> get_archive_entries(); 
	foreach(@$entries){ 
	my ($subject, $message, $format) = $self -> get_archive_info($_);
		if($subject =~ m/$keyword/i || $message =~ m/$keyword/i){ 
		push(@results, $_); 
		}
	}
return \@results;

}

sub make_search_summary { 

my $self    = shift; 
my $keyword = shift;
my $matches = shift;  
my $message_summary; 
my %search_summary;

my $key;
foreach $key(@$matches){ 

	my ($subject, $message, $format) = $self -> get_archive_info($key);
	my @message_lines = split("\n", $message);
	my $line;
	
	foreach $line(@message_lines){ 
	
		if($line =~ m/$keyword/io){ 
		
			$line =~ s#$keyword#<b>$keyword</b>#goi;
			$search_summary{$key} .= "... $line<br>";
			
		}
		
	} 
	
}


return \%search_summary;

}


=pod

=item DESTROY

	DESTROY ALL ASTROMEN!


=back

=cut




sub DESTROY { 

undef $archive_name;
undef $archive_path;
undef $opened_archive;
undef $list_ref; 
}


1;

=pod

=back

=head1 COPYRIGHT

 Copyright (c) 1999 - 2002 Justin Simoni (justin@skazat.com) http://skazat.com 
 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

