CGI::Listman - Easily managing web subscribtion lists

    use CGI::Listman;

# Listman.pm - this file is part of the CGI::Listman distribution
#
# CGI::Listman is Copyright (C) 2002 iScream multimédia <info@iScream.ca>
#
# This package is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Author: Wolfgang Sourdeau <Wolfgang@Contre.COM>

use strict;

package CGI::Listman;

use Carp;
use DBI;

use CGI::Listman::dictionary;
use CGI::Listman::line;
use CGI::Listman::selection;

use vars qw($VERSION);
$VERSION = '0.05';

sub new {
  my $class = shift;

  my $self = {};
  $self->{'dbi_backend'} = shift;
  $self->{'list_name'} = shift;
  $self->{'list_dir'} = shift;
  $self->{'table_name'} = $self->{'list_name'};
  $self->{'db_name'} = undef;
  $self->{'db_uname'} = undef;
  $self->{'db_passwd'} = undef;
  $self->{'db_host'} = undef;
  $self->{'db_port'} = undef;

  $self->{'list'} = undef;
  $self->{'_dbi_params'} = undef;
  $self->{'_dictionary'} = undef;
  $self->{'_last_line_number'} = 0;
  $self->{'_loading_list'} = undef;

  bless $self, $class;
}

sub set_backend {
  my ($self, $backend) = @_;

  if (defined $self->{'dbi_backend'}) {
    croak "A backend is already defined ("
      .$self->{'dbi_backend'}.") for this CGI::Listman instance.\n"
  } else {
    eval "use DBD::".$backend.";";
    croak "This backend is not available:\n".$@ if ($@);
    $self->{'dbi_backend'} = $backend;
  }
}

sub set_db_name {
  my ($self, $db_name) = @_;

  croak "A database is already defined  (".$self->{'db_name'}
    .") for this CGI::Listman instance.\n"
      if (defined $self->{'db_name'} && $self->{'db_name'} ne '');

  $self->{'db_name'} = $db_name;
}

sub set_user_infos {
  my ($self, $db_uname, $db_passwd) = @_;

  croak "A password is already defined for this CGI::Listman instance.\n"
    if (defined $self->{'db_passwd'} && $self->{'db_passwd'} ne '');
  croak "A username is already defined (".$self->{'db_uname'}
    .") for this CGI::Listman instance.\n"
      if (defined $self->{'db_uname'} && $self->{'db_uname'} ne '');

  $self->{'db_uname'} = $db_uname;
  $self->{'db_passwd'} = $db_passwd;
}

sub set_host_infos {
  my ($self, $db_host, $db_port) = @_;

  croak "A hostname/address is already defined  (".$self->{'db_host'}
    .") for this CGI::Listman instance.\n"
      if (defined $self->{'db_host'} && $self->{'db_host'} ne '');
  croak "A port is already defined (".$self->{'db_port'}
    .") for this CGI::Listman instance.\n"
      if (defined $self->{'db_port'} && $self->{'db_port'} ne '');

  $self->{'db_host'} = $db_host;
  $self->{'db_port'} = $db_port;
}

sub set_list_name {
  my ($self, $list_name) = @_;

  croak "A list name is already defined (".$self->{'list_name'}
    .") for this instance of CGI::Listman.\n"
      if (defined $self->{'list_name'});

  $self->{'list_name'} = $list_name;
  $self->{'table_name'} = $list_name
    unless (defined $self->{'table_name'});
}

sub set_list_directory {
  my ($self, $new_directory) = @_;

  croak "A list directory is already defined (".$self->{'list_name'}
    .") for this instance of CGI::Listman.\n"
      if (defined $self->{'list_dir'});
  $self->{'list_dir'} = $new_directory;
}

sub set_table_name {
  my ($self, $table_name) = @_;

  croak "Please defined a list_name before a table_name.\n"
    unless (defined $self->{'table_name'});

  croak "The table_name cannot be empty.\n"
    if ('table_name' eq '');
  $self->{'table_name'} = $table_name;
}

sub dictionary {
  my $self = shift;

  unless (defined $self->{'_dictionary'}) {
    croak "List directory not defined for this instance of CGI::Listman.\n"
      unless (defined $self->{'list_dir'});
    croak "List filename not defined for this instance of CGI::Listman.\n"
      unless (defined $self->{'list_name'});

    my $path = $self->{'list_dir'}.'/'.$self->{'list_name'}.'.dict';
    croak "No dictionary ('".$self->{'list_name'}.".dict')\n"
      unless (-f $path);

    my $dictionary = CGI::Listman::dictionary->new ($path);

    $self->{'_dictionary'} = $dictionary;
  }

  return $self->{'_dictionary'};
}

sub seek_line_by_num {
  my ($self, $number) = @_;

  $self->load_lines () unless (defined $self->{'list'});

  my $ret_line = undef;
  my $list_ref = $self->{'list'};

  foreach my $line (@$list_ref) {
    if ($line->number () == $number) {
      $ret_line = $line;
      last;
    }
  }

  return $ret_line;
}

sub add_line {
  my ($self, $line) = @_;

  $self->load_lines ()
    unless (defined $self->{'list'}
	    || defined $self->{'_loading_list'});

  $line->{'number'} = $self->{'_last_line_number'} + 1
    unless ($line->{'number'});

  my @numbers = $self->_get_line_numbers ();
  croak "This instance's list of lines already contains a line with"
    ." this number (".$line->{'number'}.").\n"
      if (grep (m/$line->{'number'}/, @numbers));

  $self->{'_last_line_number'} = $line->{'number'};

  unless (defined $self->{'list'}) {
    my @new_list;
    $self->{'list'} = \@new_list;
  }

  my $list_ref = $self->{'list'};
  push @$list_ref, $line;
}

sub load_lines {
  my $self = shift;

  $self->{'_loading_list'} = 1;
  $self->_db_connect ();

  my $dbh = $self->{'_db_connection'};

  my $row_list =
    $dbh->selectall_arrayref ("SELECT * FROM ".$self->{'table_name'})
    or croak $dbh->errstr;

# croak $row_list->[0];
  delete $self->{'list'} if (defined $self->{'list'});

  if (defined $row_list) {
    foreach my $row (@$row_list) {
      my $line = CGI::Listman::line->new ();
      $line->_build_from_listman_data ($row);
      $self->add_line ($line);
    }
  }

  $self->{'_loading_list'} = undef;
}

sub list_contents {
  my $self = shift;

  my $contents_ref = undef;
  if (defined $self->{'list'}) {
    my @filt_contents;
    my $old_cref = $self->{'list'};
    foreach my $line (@$old_cref) {
      push @filt_contents, $line
	if (!$line->{'_deleted'});
    }
    $contents_ref = \@filt_contents;
  } else {
    $self->load_lines ();
    $contents_ref = $self->{'list'};
  }

  return $contents_ref;
}

# Check the validity of received parameters and returns two refs against
# the missing mandatory values and the unknown fields.
sub check_params {
  my ($self, $param_hash_ref) = @_;

  my $dictionary = $self->dictionary ();

  my @missing;
  my @unknown;

  foreach my $key (keys %$param_hash_ref) {
    my $term = $dictionary->get_term ($key);
    push @unknown, $key
      unless (defined $term);
  }

  my $dict_terms = $dictionary->terms ();

  foreach my $term (@$dict_terms) {
    my $key = $term->{'key'};
    push @missing, $term->definition_or_key ()
      if ($term->{'mandatory'}
	  && (!defined $param_hash_ref->{$key}
	      || $param_hash_ref->{$key} eq ''));
  }

  return (\@missing, \@unknown);
}

sub commit {
  my $self = shift;

  croak "Commit again?\n"
    if (defined $self->{'_commit'});

  if (defined $self->{'list'}) {
    $self->_db_connect ();
    my $dbh = $self->{'_db_connection'};
    my $list_ref = $self->{'list'};
    foreach my $line (@$list_ref) {
      if ($line->{'_updated'}) {
	next if ($line->{'_deleted'} && $line->{'_new_line'});
	if ($line->{'_deleted'}) {
	  $dbh->do ("DELETE FROM ".$self->{'table_name'}.
		    "       WHERE number = ".$line->{'number'})
	    or croak "A DBI error occured while deleting line "
	      .$line->{'number'}." from ".$self->{'table_name'}
		.":\n".$dbh->errstr;
	} elsif ($line->{'_new_line'}) {
	  $line->{'timestamp'} = time ()
	    unless ($line->{'timestamp'});
	  my $record = $self->_prepare_record ($line);
	  my $sth = $dbh->do ("INSERT INTO ".$self->{'table_name'}.
				   "       VALUES (".$record.")")
	    or croak "A DBI error occured while inserting...\n".$record.
	      "... into ".$self->{'table_name'}.":\n".$dbh->errstr;
	} else {
	  $dbh->do ("DELETE FROM ".$self->{'table_name'}.
		    "       WHERE number = ".$line->{'number'})
	    or croak "A DBI error occured while deleting line "
	      .$line->{'number'}." from ".$self->{'table_name'}
		.":\n".$dbh->errstr;
	  my $record = $self->_prepare_record ($line);
	  my $sth = $dbh->do ("INSERT INTO ".$self->{'table_name'}.
				   "       VALUES (".$record.")")
	    or croak "A DBI error occured while inserting...\n".$record.
	      "... into ".$self->{'table_name'}.":\n".$dbh->errstr;
	}
      }
    }
    $dbh->disconnect ();
  }

  $self->{'_commit'} = 1;
}

sub delete_line {
  my ($self, $line) = @_;

  croak "Cannot delete a line with number equal to 0.\n"
    unless ($line->{'number'});

  my $list_ref = $self->{'list'};
  croak "List empty.\n" unless (defined $list_ref);

  # delete the line from the list in memory...
  my $count;
  for ($count = 0; $count < @$list_ref; $count++) {
    if ($list_ref->[$count] == $line) {
      $line->{'_updated'} = 1;
      $line->{'_deleted'} = 1;
      last;
    }
  }

  croak "Line not found in list."
    if ($count == @$list_ref);
}

sub delete_selection {
  my ($self, $selection) = @_;

  my $list_ref = $selection->{'list'};
  croak "Selection is empty.\n" unless ($list_ref);
  foreach my $line (@$list_ref) {
    $self->delete_line ($line);
  }
}

# the private methods begin here

sub _prepare_record {
  my ($self, $line) = @_;

  my $fields_ref = $line->line_fields ();
  my @records;
  push @records, ($line->{'timestamp'}, $line->{'seen'}, $line->{'exported'});
  push @records, @$fields_ref;

  my $record_line = "'".$line->{'number'}."'";
  foreach my $record (@records) {
    $record =~ s/\'/\\\'/g;
    $record = '' unless (defined $record);
    $record_line .= ", '".$record."'";
  }

  # if we don't untaint $record_line, we get a stange error regarding
  # DBD::SQL::Statement::HASH_ref...
  $record_line =~ m/(.*)/;
  $record_line = $1;

  return $record_line;
}

sub _dbi_setup {
  my $self = shift;

  unless (defined $self->{'_dbi_params'}) {
    croak "No backend specified for this instance of CGI::Listman.\n"
      unless (defined $self->{'dbi_backend'});
    if ($self->{'dbi_backend'} eq 'CSV') {
      $self->{'_dbi_params'} = ":f_dir=".$self->{'list_dir'};
      unless (-f $self->{'list_dir'}.'/'.$self->{'table_name'}.'.csv') {
	open my $list_file, '>'
	  .$self->{'list_dir'}.'/'.$self->{'table_name'}.'.csv';
	close $list_file;
      }
    } else {
      croak "Sorry, the DBI backend \"".$self->{'dbi_backend'}
	."\" is not handled at this time.\n"
	  unless ($self->{'dbi_backend'} eq 'mysql');
      my $dbi_params = ":database=".$self->{'db_name'};
      $dbi_params .= ":host=".$self->{'db_host'}
      	if (defined $self->{'db_host'} && $self->{'db_host'} ne '');
      $dbi_params .= ":port=".$self->{'db_port'}
	if (defined $self->{'db_port'} && $self->{'db_port'} ne '');
      $self->{'_dbi_params'} = $dbi_params;
    }
  }
}

sub _db_fields_setup {
  my $self = shift;

  unless (defined $self->{'_db_fields'}) {
    my @fields = ('number', 'timestamp', 'seen', 'exported');
    my $dictionary = $self->dictionary ();
    my $dict_terms = $dictionary->terms ();

    foreach my $term (@$dict_terms) {
      push @fields, $term->{'key'};
    }
    $self->{'_db_fields'} = \@fields;
  }
}

sub _db_connect {
  my $self = shift;

  unless (defined $self->{'_db_connection'}) {
    $self->_dbi_setup ();
    $self->_db_fields_setup ();
    my $dbh = DBI->connect ("DBI:"
			    .$self->{'dbi_backend'}.$self->{'_dbi_params'},
			    $self->{'db_uname'},
			    $self->{'db_passwd'})
    or croak DBI->errstr;
    if ($self->{'dbi_backend'} eq 'CSV') {
      $dbh->{'csv_tables'}->{$self->{'table_name'}} =
	{'col_names' => $self->{'_db_fields'},
	 'file' => $self->{'table_name'}.".csv"};
    }
    $self->{'_db_connection'} = $dbh;
  }
}

sub _get_line_numbers {
  my $self = shift;

  my @numbers;

  if (defined $self->{'list'}) {
    my $list_ref = $self->{'list'};

    foreach my $line (@$list_ref) {
      push @numbers, $line->number ();
    }
  }

  return @numbers;
}

1;

__END__