# -------------------------------------------------------------------------------------
# flo::Standard
# -------------------------------------------------------------------------------------
#
#    Author   : Jean-Michel Hiver                                  (c) MKDoc ltd, 2001.
#
#    A module that provides methods to easily access most commonly used objects
#    Adding a 'use flo::Standard' statement imports the following methods:
#
#    config(), cgi(), path_info(), raw_path_info(), table($), template($$), session()
# -------------------------------------------------------------------------------------
package flo::Standard;
use lib::cgi::Session;
use lib::sql::Table;
use lib::cgi::CGI;
use lib::util::Unaccent;
use Exporter;
use strict;
use vars qw /@EXPORT @ISA $GENERAL_CONFIG/;

$GENERAL_CONFIG = undef;
@ISA    = qw /Exporter/;
@EXPORT = qw /general_config cgi path_info raw_path_info session table template move_or_delete_document_list/;


##
# config();
# ---------
#   Returns a lib::Config object that uses the global configuration file
##
sub general_config()
{
    unless (defined $GENERAL_CONFIG) { $GENERAL_CONFIG = new lib::Config ("GLOBAL") }
    return $GENERAL_CONFIG;
}


##
# cgi();
# ------
#   Returns the CGI object that was instanciated for that HTTP query
##
sub cgi()
{
    return lib::cgi::CGI->get;
}


##
# path_info();
# ------------
#   Returns a string which should match the Full_Path of the current document,
#   provided that this document exists
# 
#   Examples of strings returned:
#     /         # good - root document
#     /foo/bar/ # good
#     /foo/bar  # bad  - missing trailing slash
#     /Foo/Bar  # bad  - mkdoc URIs are always lowercased
##
sub path_info()
{
    my $path_info = lc (cgi->path_info);
    $path_info =~ s/^\/*//;
    $path_info =~ s/\/*$//;
    return ($path_info) ? '/' . $path_info .'/' : '/';
}


##
# table ($table_name);
# --------------------
#   Returns the table database object for the table which name is
#   $table_name
##
sub table($)
{
    my $table_name = shift;
    my $table = lib::sql::Table->table ($table_name);
    return $table;
}


##
# template ($template_directory, $language);
# ------------------------------------------
#   Since template engine supports multi-lingual templates,
#   this function computes which template is best suited
#   for your $template_directory depending on your $language
#   and returns its path
##
sub template($$)
{
    my $tmpl_dir = shift;
    my $lang     = shift;
    my $base_dir = general_config->get ('template_dir');
    
    if ($lang =~ /-/)
    {
	my $file = "$base_dir/$tmpl_dir/$lang.html";
	return $file if (-e $file);
	$lang =~ s/-.*//;
    }
    
    return "$tmpl_dir/$lang.html" if (-e "$base_dir/$tmpl_dir/$lang.html");
    return "$tmpl_dir/en.html";
}


sub raw_path_info() { return cgi->path_info }


sub session()
{
    return $lib::cgi::Session::ETERNAL if (defined $lib::cgi::Session::ETERNAL);
    return {};
}


##
# move_or_delete_document_list;
# -----------------------------
#   Return a list of documents which are administrable by the user,
#   but not descendants of the current document. The hash references
#   which are returned have the following attributes:
#
#   ID, Full_Path Document, Title, Description, Lang and Depth
##
sub move_or_delete_document_list()
{
    my $base_document_table = table ('Base_Document');
    my $document_table      = table ('Document');
    
    # retrieve all the base document that the user can administrate
    my @base_document  = $base_document_table->search ( Editor_ID => session->{Editor_ID} )->fetch_all;
    foreach my $base_document (@base_document)
    {
	my $document_info = $document_table->select ( cols  => [ qw /Full_Path/ ],
						      where => { ID => $base_document->{Document_ID} } )->next;
	
	(defined $document_info) or
	    throw (new lib::Exception ( code => 'CANNOT_GET_DOCUMENT',
					info => $base_document ) );
	
	$base_document->{Full_Path} = $document_info->{Full_Path};
    }
    
    # for each document, see if the document could be a potential parent for the
    # document that the user wants to move.
    my $document_query = $document_table->select ( cols => [ qw /ID Full_Path Title Description Lang/ ],
						   sort => [ qw /Full_Path/ ] );
    
    my $cgix = cgi->new;
    foreach ($cgix->param) { $cgix->delete ($_) }
    $cgix->param (qw /admin document_modify_location/);
    
    my @documents = ();
    
    # computes the current document depth
    my $path_info = path_info;
    my $current_document_depth = $path_info =~ tr/\//\// - 1;
    
    while (my $document = $document_query->next)
    {
	my $document_path = $document->{Full_Path};
	my $q_path_info   = quotemeta (path_info);
	
	# we don't want to move current document into one
	# of its sub-documents.
 	($document_path =~ /^$q_path_info/) and next;
	
	my $document_depth = $document_path =~ tr/\//\// - 1;
	
	foreach my $base_document (@base_document)
	{
	    $q_path_info = quotemeta ($base_document->{Full_Path});
	    if ($document->{Full_Path} =~ /^$q_path_info/)
	    {
		$document->{Depth} = $document_depth;
		$document->{Depth} = [ map { {} } 1 .. $document->{Depth} ];
		
		$cgix->param ('Parent_ID', $document->{ID});
		$document->{Move_URI} = $cgix->self_url;
		
		push @documents, $document;
		last;
	    }
	}
    }
    
    return (wantarray) ? @documents : \@documents;
}


1;






