AxKit::App::TABOO::Data::Article - Article Data object for TABOO

  use AxKit::App::TABOO::Data::Article;
  [etc ... similar as for other Data objects]

package AxKit::App::TABOO::Data::Article;
use strict;
use warnings;
use Carp;
use Encode;


use Data::Dumper;
use AxKit::App::TABOO::Data;
use vars qw/@ISA/;

@ISA = qw(AxKit::App::TABOO::Data);
use AxKit::App::TABOO::Data::User;
use AxKit::App::TABOO::Data::Category;
use AxKit::App::TABOO::Data::MediaType;
use AxKit::App::TABOO::Data::Plurals::Users;
use AxKit::App::TABOO::Data::Plurals::Categories;
use Time::Piece;
use MIME::Types;

use DBI;


our $VERSION = '0.3';

AxKit::App::TABOO::Data::Article->dbtable("articles");
AxKit::App::TABOO::Data::Article->dbfrom("articles JOIN languages ON (languages.ID = articles.lang_ID) JOIN mediatypes ON (mediatypes.ID = articles.format_ID)");
AxKit::App::TABOO::Data::Article->dbprimkey("filename");
AxKit::App::TABOO::Data::Article->elementorder("filename, lang, primcat, seccat, freesubject, editorok, authorok, title, description, AUTHORS, date, publisher, type, format, coverage, rights");


sub new {
    my $that  = shift;
    my $class = ref($that) || $that;
    my $self = {
		filename  => undef,
		primcat => undef,
		seccat => [],
		freesubject => [],
		angles => [],
		authorok => undef,
		editorok => undef,
		title => undef,
		description => undef,
		publisher => undef,
		date => undef,
		type => undef,
		format => undef,
		lang => undef,
		coverage => undef,
		rights => [],
		authorids => [],
		AUTHORS => undef,
		DBCONNECTARGS => \@_,
		XMLELEMENT => 'article',
		XMLPREFIX => 'art',
		XMLNS => 'http://www.kjetil.kjernsmo.net/software/TABOO/NS/Article/Output',
		ONFILE => undef,
	       };
    bless($self, $class);
    return $self;
}

sub load
{
  my ($self, %args) = @_;
  my $what = $args{'what'} || '*';
  if ($what eq '*') {
    $what = 'articles.ID,articles.filename,articles.authorok,articles.editorok,articles.title,articles.description,articles.publisher,articles.date,articles.type,articles.identifieruri,articles.identifierurn,articles.coverage,articles.rights,mediatypes.mimetype,languages.code';
  }
  $args{'what'} = $what;
  my $data = $self->_load(%args);
  warn Dumper($data);
  return undef unless ($data);
  ${$self}{'ONFILE'} = 1;
  my $dbh = DBI->connect($self->dbconnectargs());
  # TODO: check 'what'
  my $categories = $dbh->selectall_arrayref("SELECT categories.catname, articlecats.field FROM categories JOIN articlecats ON (categories.ID = Cat_ID) JOIN articles ON (articlecats.Article_ID=articles.ID) WHERE articlecats.Article_ID=?", {}, (${$data}{'id'}));

  my $users = $dbh->selectcol_arrayref("SELECT users.username FROM users JOIN articleusers ON (users.ID = Users_ID) JOIN articles ON (articleusers.Article_ID=articles.ID) WHERE articleusers.Article_ID=? ORDER BY articleusers.Users_ID", {}, (${$data}{'id'}));

  $self->populate($data,$categories,$users);
  warn Dumper($self);
  return $self;
}

sub populate {
  my $self = shift;
  my $articles = shift;
  my $categories = shift;
  my @keys = grep(/[a-z]+/, keys(%{$self})); # all the lower-case keys
  foreach my $key (@keys) {
    if (defined(${$articles}{$key}) && (${$articles}{$key} =~ m/^\{(\S+)\}$/)) { # Support SQL3 arrays ad hoc
      my @arr = split(/\,/, $1);
      ${$self}{$key} = \@arr;
    } else {
      ${$self}{$key} = Encode::decode_utf8(${$articles}{$key}, Encode::FB_HTMLCREF);
    }
  }
  ${$self}{'authorids'} = shift;
  ${$self}{'lang'} = ${$articles}{'code'};
  ${$self}{'format'} = ${$articles}{'mimetype'};
  foreach my $cat (@{$categories}) {
    if (${$cat}[1] eq 'primcat') {
      ${$self}{'primcat'} = ${$cat}[0];
    } else {
      push(@{${$self}{${$cat}[1]}}, ${$cat}[0]);
    }
  }
  return $self;
}

sub save {
  my $self = shift;
  my $dbh = DBI->connect($self->dbconnectargs());
  my @fields;
  my $i=0;
  my $catsusers=0;
  foreach my $key (keys(%{$self})) {
    next if ($key =~ m/[A-Z]/); # Uppercase keys are not in db
    next unless defined(${$self}{$key}); # No need to insert something that isn't there
    if (grep(/^$key$/, qw(primcat seccat freesubject angles authorids))) {
      # Needs to be dealt with specially
      $catsusers=1;
      next;
    }
    $key =~ s/^(format|lang)$/$1_id/;
    push(@fields, $key);
    $i++;
  }
  if (($i == 0) && ($catsusers == 0)) {
    carp "No data fields with anything to save";
  } else {
    my $sth;
    my ($articleid) = $dbh->selectrow_array("SELECT id FROM articles WHERE filename=?", {}, ${$self}{'filename'});
    if ($articleid) {
      die "Updating articles not yet implemented. Filename ${$self}{'filename'} exists";
    } else {
      ($articleid) = $dbh->selectrow_array("SELECT NEXTVAL('articles_id_seq')");
      $sth = $dbh->prepare("INSERT INTO articles (id, " . join(',', @fields) . ") VALUES (" . '?,' x $i . '?)');
      $sth->bind_param(1, $articleid);
      $i = 2;
      foreach my $key (@fields) {
	my $content = ${$self}{$key};
	if ($key eq 'format_id') {
	  my ($fid) = $dbh->selectrow_array("SELECT id FROM mediatypes WHERE mimetype=?", {}, ${$self}{'format'});
	  croak(${$self}{'format'} . " doesn't exist in database, insert first") unless ($fid);
	  $sth->bind_param($i, $fid);
	} elsif ($key eq 'lang_id') {
	  my ($lid) = $dbh->selectrow_array("SELECT id FROM languages WHERE code=?", {}, ${$self}{'lang'});
	  croak(${$self}{'lang'} . " doesn't exist in database, insert first") unless ($lid);
	  $sth->bind_param($i, $lid);
	} elsif (ref($content) eq '') {
	  $sth->bind_param($i, $content);
	} elsif (ref($content) eq "ARRAY") {
	  # The content is an array, save it as such, ad hoc SQL3 for now.
	  $sth->bind_param($i, "{" . join(',', @{$content}) . "}");
	} else {
	  # Actually, I should never get here, but anyway...:
	  warn "Advanced forms of references aren't implemented meaningfully yet. Don't be surprised if I crash or corrupt something.";
	  $content->save(); # IOW: Panic!! Everybody save yourselves if you can! :-)
	}
	$i++;
      }
      $sth->execute;

      foreach my $catfield (qw(primcat seccat freesubject angles)) {
	if ((ref(${$self}{$catfield}) eq 'ARRAY') && scalar(@{${$self}{$catfield}})) {
	  warn Dumper(($articleid, $catfield, @{${$self}{$catfield}}));
	  $dbh->do("INSERT INTO articlecats (article_id, field, cat_id) SELECT ?,?,id FROM categories WHERE catname IN (?" . ',?' x (scalar(@{${$self}{$catfield}})-1) . ')', {}, ($articleid, $catfield, @{${$self}{$catfield}}));
	} elsif (defined(${$self}{$catfield})) {
	  $dbh->do("INSERT INTO articlecats (article_id, field, cat_id) SELECT ?,?,id FROM categories WHERE catname=?", {}, ($articleid, $catfield, ${$self}{$catfield}));

	}
      }
      $dbh->do("INSERT INTO articleusers (article_id, role_id, enabled, users_id) SELECT ?,1,true,id FROM users WHERE username IN (?" . ',?' x (scalar(@{${$self}{'authorids'}})-1) . ')', {}, ($articleid, @{${$self}{'authorids'}}));
    }
  }
  return $self;
}

sub adduserinfo {
  my $self = shift;
  my $users = AxKit::App::TABOO::Data::Plurals::Users->new($self->dbconnectargs());
  foreach my $username (@{${$self}{'authorids'}}) {
    my $user = AxKit::App::TABOO::Data::User->new($self->dbconnectargs());
    $user->xmlelement("author");
    $user->load(what => 'username,name', limit => {username => $username});
    $users->Push($user);
  }
  ${$self}{'AUTHORS'} = $users;
  return $self;
}

sub addcatinfo {
  my $self = shift;
  my @cattypes = qw(primcat seccat freesubject angles);
  foreach my $cattype (@cattypes) {
#    warn $cattype . ": ". ref(${$self}{$cattype});
    if (ref(${$self}{$cattype}) eq 'ARRAY') {
      my $cats = AxKit::App::TABOO::Data::Plurals::Categories->new($self->dbconnectargs());
      $cats->xmlelement($cattype);
      foreach my $catname (@{${$self}{$cattype}}) {
	my $cat = AxKit::App::TABOO::Data::Category->new($self->dbconnectargs());
	$cat->load(limit => {catname => $catname});
	$cats->Push($cat);
      }
      ${$self}{$cattype} = $cats;
    } elsif (defined(${$self}{$cattype})) {
      my $cat = AxKit::App::TABOO::Data::Category->new($self->dbconnectargs());
      $cat->xmlelement($cattype);
      $cat->load(limit => {catname => ${$self}{$cattype}});
      ${$self}{$cattype} = $cat;
    } else {
      # Actually, this is where we have an empty list
      ${$self}{$cattype} = [];
    }
  }
  
  return $self;
}

sub addformatinfo {
    my $self = shift;
    my $type = AxKit::App::TABOO::Data::MediaType->new($self->dbconnectargs());
    $type->load(limit => {mimetype => ${$self}{'format'}});
    ${$self}{'format'} = $type;
    return $self;
}

sub date {
  my $self = shift;
  my $arg = shift;
  if (ref($arg) eq 'Time::Piece') {
    ${$self}{'date'} = $arg->datetime;
    return $self;
  }
  if (! ${$self}{'date'}) {
    my $filename = shift;
    $self->load(what => 'date', limit => {filename => $arg});
  }
  unless (${$self}{'date'}) { return undef; }
  (my $tmp = ${$self}{'date'}) =~ s/\+\d{2}$//;
  return Time::Piece->strptime($tmp, "%Y-%m-%d");
}

sub editorok {
  my $self = shift;
  unless (defined(${$self}{'editorok'})) {
    my ($filename) = @_;
    croak "No filename given to editorok and no earlier record" unless ($filename);
    $self->load(what => 'editorok', limit => {filename => $filename});
  }
  return ${$self}{'editorok'};
}

sub authorok {
  my $self = shift;
  unless (defined(${$self}{'authorok'})) {
    my ($filename) = @_;
    croak "No filename given to authorok and no earlier record" unless ($filename);
    $self->load(what => 'authorok', limit => {filename => $filename});
  }
  return ${$self}{'authorok'};
}

sub mimetype {
  my $self = shift;
  if (ref(${$self}{'format'}) eq 'MIME::Type') {
    return ${$self}{'format'};
  }
  elsif (ref(${$self}{'format'}) eq 'AxKit::App::TABOO::Data::MediaType') {
    return ${$self}{'format'}->mimetype;
  }
  my $mimetypes = MIME::Types->new(only_complete => 1);
  my MIME::Type $type = $mimetypes->type(${$self}{'format'});
  return $type;
}

sub authorids {
  my $self = shift;
  return @{$self}{'authorids'};
}

1;