package flo::Record::Document;
use flo::Standard;
use strict;


##
# $self->ID;
# ----------
#   Returns the ID of that flo::Record::Document
#
# $self->ID ($id);
# ----------------
#   Sets the ID of that flo::Record::Document
#   This method should be used internally only
##
sub ID
{
    my $self = shift;
    if (@_) { $self->{ID} = shift }
    else    { return $self->{ID}  }
}


##
# $self->Parent_ID;
# -----------------
#   Returns the Parent ID of that flo::Record::Document.
#   The Parent ID is a database attribute that tells us
#   to which document this document belongs
#
# $self->Parent_ID ($parent_id);
# ------------------------------
#   Sets a different $parent_id for that document.
#   Full_Path and Sibling_Position fields do not have to be
#   updated when modifying a record, that is handled by
#   the flo::Category table object
##
sub Parent_ID
{
    my $self = shift;
    if (@_) { $self->{Parent_ID} = shift }
    else    { return $self->{Parent_ID}  }
}


##
# $self->Parent;
# --------------
#   Returns the Parent document of that document.
##
sub Parent
{
    my $self = shift;
    my $parent_id = $self->Parent_ID;
    return unless (defined $parent_id);
    
    my $document_table = table 'Document';
    return $document_table->get ($parent_id);
}


##
# $self->Is_Current;
# ------------------
#   Returns TRUE if $self is the current document,
#   FALSE otherwise.
##
sub Is_Current
{
    my $self = shift;
    return $self->Full_Path eq path_info;
}


##
# $self->Ancestors;
# -----------------
#   Returns the ancestors of that document, i.e.
#   its parent, grand-parent, grand-grand parent, etc...
#   the root element being the first element of the
#   array which is being returned
##
sub Ancestors
{
    my $self = shift;
    my $parent = $self->Parent;
    if (defined $parent)
    {
	my @res = ($parent->Ancestors, $parent);
	return (wantarray) ? @res : \@res;
    }
    else
    {
	return (wantarray) ? () : [];
    }
}


##
# $self->Sibling_Position;
# ------------------------
#   Returns the sibling position of that document, i.e.
#   where it ranks compared with its siblings
##
sub Sibling_Position
{
    my $self = shift;
    if (@_) { $self->{Sibling_Position} = shift }
    else    { return $self->{Sibling_Position}  }
}


##
# $self->Full_Path;
# -----------------
#   Returns the full path of that document, i.e.
#   /cars/sport/top-5/
##
sub Full_Path
{
    my $self = shift;
    if (@_) { $self->{Full_Path} = shift }
    else    { return $self->{Full_Path}  }
}


##
# $self->Title;
# -------------
#   Returns the title of that document
#
# $self->Title ($title);
# ----------------------
#   Sets the title of that document to $title
##
sub Title
{
    my $self = shift;
    if (@_) { $self->{Title} = shift }
    else    { return $self->{Title}  }
}


##
# $self->Description;
# -------------------
#   Returns the description of that document
#
# $self->Title ($description);
# ----------------------------
#   Sets the description of that document to $description
##
sub Description
{
    my $self = shift;
    if (@_) { $self->{Description} = shift }
    else    { return $self->{Description}  }
}


##
# $self->Keywords;
# ----------------
#   Returns a list of keywords for that document
##
sub Keywords
{
    my $self = shift;
    if (@_) { $self->{Keywords} = shift }
    else    { return $self->{Keywords}  }
}


##
# $self->Body;
# ------------
#   Deprecated.
#   Returns an XMLish field that is the body of the
#   document. Needs to be parsed using flo::Editor,
#   don't use as is
#
# $self->Body ($body);
# --------------------
#   Sets the body of that document
##
sub Body
{
    my $self = shift;
    if (@_) { $self->{Body} = shift }
    else    { return $self->{Body}  }
}


##
# $self->Template;
# ----------------
#   Returns the name of the template which is being
#   used for that document
#
# $self->Template ($template);
# ----------------------------
#   Sets the template of that document to $template
##
sub Template
{
    my $self = shift;
    if (@_) { $self->{Template} = shift }
    else    { return $self->{Template}  }
}


##
# $self->Lang;
# ------------
#   Returns the current language ISO code for that document
#
# $self->Lang ($lang);
# --------------------
#   Sets the current language ISO code for that document
##
sub Lang
{
    my $self = shift;
    if (@_) { $self->{Lang} = shift }
    else    { return $self->{Lang}  }
}


##
# $self->Sort_By;
# ---------------
#   Returns the column by which to sort the document
##
sub Sort_By
{
    my $self = shift;
    if (@_) { $self->{Sort_By} = shift }
    else    { return $self->{Sort_By}  }
}


##
# $self->Order_By;
# ----------------
#   Returns 1 if the document is sorted by descending order
#   Returns 0 otherwise
##
sub Order_By
{
    my $self = shift;
    if (@_) { $self->{Order_By} = shift }
    else    { return $self->{Order_By}  }
}


##
# $self->Children;
# ----------------
#   Returns a list of all sub-documents held by that document
##
sub Children
{
    my $self = shift;
    my $document_table = table 'Document';
    my $sort_by = $self->Sort_By || 'Sibling_Position';
    my $query = $document_table->select ( cols  => [ qw /ID Full_Path Parent_ID Title Description Lang Sort_By Order_By/ ],
					  where => { Parent_ID => $self->ID },
					  sort  => [ $sort_by ],
					  desc  => ($self->Order_By) ? 1 : 0 );    
    return $query->fetch_all;
}


##
# $self->Root;
# ------------
#   Returns the root document
##
sub Root
{
    my $document_table = table 'Document';
    my $query = $document_table->select ( where => { Full_Path => '/' } ); 
    return $query->next;
}


##
# $self->Children_Sibling_Position;
# ---------------------------------
#   Returns a list of all sub-documents held by that document,
#   sorted by the 'Sibling_Position' field
##
sub Children_By_Sibling_Position
{
    my $self = shift;
    my $document_table = table 'Document';
    my $query = $document_table->select ( cols  => [ qw /ID Full_Path Parent_ID Title Description Lang Sort_By Order_By/ ],
					  where => { Parent_ID => $self->ID },
					  sort  => [ qw/Sibling_Position/ ] );
    
    return $query->fetch_all;
}


##
# $self->Contributors;
# --------------------
#   Returns an array of Editor objects that represent the editors
#   who contributed to the document at some point
##
sub Contributors
{
    my $self = shift;
    my $contributor_table = table ('Contributor');
    my @res = $contributor_table->search ( Document_ID => $self->ID )->fetch_all;
    @res = map { ($_->Editor_ID == $self->Editor_Created_ID) ? () : $_->Editor } @res;
    return (wantarray) ? @res : \@res;
}


##
# $self->Editor_Created_ID;
# -------------------------
#   Returns the ID of the editor who created that document
##
sub Editor_Created_ID
{
    my $self = shift;
    $self->{Editor_Created_ID} = shift || return $self->{Editor_Created_ID};
}


##
# $self->Editor_Created;
# ----------------------
#   Returns the editor who created that document
##
sub Editor_Created
{
    my $self = shift;
    my $editor_table = table 'Editor';
    return $editor_table->get ($self->Editor_Created_ID);
}


##
# $self->Editor_Last_Modified_ID;
# -------------------------------
#   Returns the ID of the editor who last modified that document
##
sub Editor_Last_Modified_ID
{
    my $self = shift;
    $self->{Editor_Last_Modified_ID} = shift || return $self->{Editor_Last_Modified_ID};
}


##
# $self->Editor_Last_Modified;
# ----------------------------
#   Returns the editor who last modified that document
##
sub Editor_Last_Modified
{
    my $self = shift;
    my $editor_table = table 'Editor';
    return $editor_table->get ($self->Editor_Last_Modified_ID);
}


##
# $self->Previous_Locations;
# --------------------------
#   Returns the redirects related to that document
##
sub Previous_Locations
{
    my $self = shift;
    my $cgix = cgi->new;
    foreach ($cgix->param) { $cgix->delete ($_) }
    
    # finds all the previous locations that this document was at
    my $redirect_table = table 'Redirect';
    my @res = $redirect_table->search ( New_Path => $self->Full_Path )->fetch_all;
    return (wantarray) ? @res : \@res;
}


##
# $self->Keywords_Split;
# ----------------------
#   Return the list of keywords as an array, splitting them
#   on commas
##
sub Keywords_Split
{
    my $self = shift;
    my @subject = split /,/, $self->Keywords;
    foreach (@subject) { s/^\s*//; s/\s*$// }
    my @res = map { { Keyword => $_ } } @subject;
    return (wantarray) ? @res : \@res;
}


##
# $self->Body_Html;
# -----------------
#   Returns this document's Body's HTML. Deprecated
##
sub Body_Html
{
    my $self = shift;
    my $editor = new flo::Editor;
    $editor->parse_xml ($self->Body);
    return $editor->html;
}


##
# $self->URI;
# -----------
#   Returns the URI of this document.
##
sub URI
{
    my $self = shift;
    my $cgix = cgi->new;
    $cgix->path_info ($self->Full_Path);
    for ($cgix->param) { $cgix->delete ($_) }
    return $cgix->self_url;
}


##
# $self->Only_Child;
# ------------------
#   Returns TRUE if $self is an only child, FALSE otherwise
##
sub Only_Child
{
    my $self = shift;
    return 1 unless (defined $self->Parent_ID); 
    my @siblings = $self->Parent->Children;
    return @siblings == 1;
}


##
# $self->Matches_Path_Info;
# -------------------------
#   Returns TRUE if the current document Full_Path attribute
#   matches the current path_info, FALSE otherwise
##
sub Matches_Path_Info
{
    my $self = shift;
    return $self->{Full_Path} eq path_info();
}


### ADMIN MODE METHODS ###
# Returns the URI to view that document in admin mode
sub URI_View
{
    my $self = shift;
    my $cgix = cgi->new;
    foreach ($cgix->param) { $cgix->delete ($_) };
    $cgix->param ('no_cache', $self->_no_cache);
    return $cgix->self_url;
}


# Returns the URI to modify user profile in admin mode
# Returns FALSE if N/A
sub Admin_URI_Profile_Modify
{
    my $self = shift;
    my $cgix = cgi->new;
    return unless ($self->_user_session);
    
    $cgix->param (qw /admin profile_modify_form/);
    $cgix->param ('no_cache', $self->_no_cache);
    return $cgix->self_url;
}


# Returns the URI to logout user in admin mode
# Returns FALSE if N/A
sub Admin_URI_Logout
{
    my $self = shift;
    my $cgix = cgi->new;
    return unless ($self->_user_session);

    $cgix->param (qw /admin logout/);
    $cgix->param ('no_cache', $self->_no_cache);
    return $cgix->self_url;
}


# Returns the URI to modify metadata in admin mode
# Returns FALSE if N/A
sub Admin_URI_MetaData_Modify
{
    my $self = shift;
    return unless ($self->_user_session);
    return unless ($self->Can_Admin);
    
    my $cgix = cgi->new;    
    $cgix->param (qw /admin document_modify_metadata_form/);    
    $cgix->param ('no_cache', $self->_no_cache);
    return $cgix->self_url;    
}


# Returns the URI to modify contents in admin mode
# Returns FALSE if N/A
sub Admin_URI_Contents_Modify
{
    my $self = shift;
    return unless ($self->_user_session);
    return unless ($self->Can_Admin);
    
    my $cgix = cgi->new;    
    $cgix->param (qw /admin document_modify_contents_form/);    
    $cgix->param ('no_cache', $self->_no_cache);
    return $cgix->self_url;
}


# Returns the URI to modify location in admin mode
# Returns FALSE if N/A
sub Admin_URI_Location_Modify
{
    my $self = shift;
    return unless ($self->_user_session);
    return unless ($self->Can_Admin);
    
    my $cgix = cgi->new;
    $cgix->param (qw /admin document_modify_location_form/);    
    return $cgix->self_url;
}


# Returns the URI to add document in admin mode
# Returns FALSE if N/A
sub Admin_URI_Document_Add
{
    my $self = shift;
    return unless ($self->_user_session);
    return unless ($self->Can_Admin);

    my $cgix = cgi->new;
    $cgix->param (qw /admin document_add_form/);
    $cgix->param ('no_cache', $self->_no_cache);
    return $cgix->self_url;
}


# Returns the URI to modify document in admin mode
# Returns FALSE if N/A
sub Admin_URI_Document_Modify
{
    my $self = shift;
    return unless ($self->_user_session);
    return unless ($self->Can_Admin);
    
    my $cgix = cgi->new;
    $cgix->param (qw /admin document_modify_form/);    
    $cgix->param ('no_cache', $self->_no_cache);
    return $cgix->self_url;
}


# Returns the URI to delete document in admin mode
# Returns FALSE if N/A
sub Admin_URI_Document_Delete
{
    my $self = shift;
    return unless ($self->Parent_ID);
    return unless ($self->_user_session);
    return unless ($self->Can_Admin);
    return if (@{$self->Children} > 0);
    
    my $cgix = cgi->new;
    $cgix->param (qw /admin document_delete_form/);    
    $cgix->param ('no_cache', $self->_no_cache);
    return $cgix->self_url;
}


# Returns the URI to reorder document form in admin mode
# Returns FALSE if N/A
sub Admin_URI_Reorder_Modify
{
    my $self = shift;
    return unless ($self->_user_session);

    my $document_table = table 'Document';
    my $nb = $document_table->select ( cols => 'count(*)', where => { Parent_ID => $self->{ID} } )->next->{'count(*)'};
    if ($nb > 1)
    {
	my $cgix = cgi->new;
	$cgix->param (qw /admin document_reorder_form/);
	$cgix->param ('no_cache', $self->_no_cache);
	return $cgix->self_url;
    }
    return;
}


# Returns the URI to move document up in admin mode
# Returns FALSE if N/A
sub Admin_URI_Move_Up
{
    my $self = shift;
    return unless ($self->_user_session);
    my $cgix = cgi->new;

    $cgix->param (qw /admin document_reorder_move_up/);
    $cgix->param ('ID', $self->ID);
    return $cgix->self_url;
}


# Returns the URI to move document down in admin mode
# Returns FALSE if N/A
sub Admin_URI_Move_Down
{
    my $self = shift;
    return unless ($self->_user_session);
    my $cgix = cgi->new;
    
    $cgix->param (qw /admin document_reorder_move_down/);
    $cgix->param ('ID', $self->ID);
    return $cgix->self_url;
}


##
# $self->_user_session;
# ---------------------
#   Returns the user session if it exists, FALSE otherwise
##
sub _user_session
{
    my $session = session || {};
    if (keys %{$session}) { return $session }
    return;
}


##
# $self->_no_cache;
# -----------------
#   Returns a random string to always have URIs that look different
##
sub _no_cache
{
    return join '', map { chr ( ord ('a') + int (rand (26)) ) } 1..5;
}


##
# $self->Can_Admin;
# -----------------
#   Returns TRUE if the user can administrate that document,
#   FALSE otherwise.
##
sub Can_Admin
{
    my $self = shift;
    if (defined $self->{'.Can_Admin'}) { return $self->{'.Can_Admin'} };
    
    # if there is no session, let's return
    return unless ($self->_user_session);
    
    my $session = $self->_user_session;
    my $document_table = table ('Document'); 
    my $cgi = cgi;
    
    # perform a query on the database to find out the base documents for
    # this user
    my $base_document_table = table ('Base_Document');
    my %base_docs_id = map { $_->{Document_ID} => 1 } $base_document_table->search ( Editor_ID => $session->{Editor_ID} )->fetch_all;
    
    # checks if the current document is in the base docs
    if ($base_docs_id{$self->{ID}})
    {
	$self->{'.Can_Admin'} = 1;
	return 1;
    }
    while (defined $self->{Parent_ID})
    {
	$self = $document_table->get ($self->{Parent_ID}) or
	    throw (new lib::Exception ( code => 'CANNOT_GET_DOCUMENT',
					info => $cgi ) );
	
	if ($base_docs_id{$self->{ID}})
	{
	    $self->{'.Can_Admin'} = 1;
	    return 1;
	}
    }
    
    $self->{'.Can_Admin'} = undef;
    return;
}


1;
