# -------------------------------------------------------------------------------------
# flo::Editor
# -------------------------------------------------------------------------------------
#
#       Author : Jean-Michel Hiver (jhiver@cisedi.com).
#    Copyright : (c) MKDoc Holdings Ltd, 2001
# 
#      Unauthorized modification, use, reuse, distribution or redistribution
#      of this module is stricly forbidden.
#
#    Description:
#
#      A class that is used to manage a pluggable component system for MKDoc
#
# -------------------------------------------------------------------------------------
package flo::Editor;
use flo::Template;
use flo::Standard;
use lib::cgi::CGI;
use lib::Exception;
use strict;
use vars qw /$BLOCK $MAP $PAM $ADD $DECIMAL_TO_HTML $TEXT_TO_HTML $ETERNAL @LINKS/;


# The flo::Editor object should be unique as we'll be parsing one page per request,
# this package variable will let us access everywhere in the program
@LINKS = ();
$ETERNAL = undef;
$BLOCK  = '_edit_block';
$MAP   = {
    file  => "flo::editor::File",
    text  => "flo::editor::Text",
    html  => "flo::editor::Html",
    image => "flo::editor::Image",
    link  => "flo::editor::Link",
    poll  => "flo::editor::Poll",
};

$PAM   = { reverse %{$MAP} };


##
# new $class;
# -----------
#   Instanciates and initializes a new flo::Editor object.
#   Attempts to initialize using lib::cgi::CGI->get object parameters
#
#   Parameters names should look like block_1_text, block_2_image, etc
##
sub new
{
    my $class = shift;
    $class    = ref $class || $class;
    my $self  = bless { @_ }, $class;
    $self->{block} ||= {};
    $self->_initialize;
    $ETERNAL = $self;
    return $self;
}


##
# $self->_links;
# --------------
#   This subroutine returns all the links of the current document
#   and caches them into $LINKS, these links can then be used by
#   flo::XHTMLFilter to linkify the whole document.
#
#   It may look like a horrible hack (and it is), but since the
#   component system needs to be redesigned it does not bother
#   me that much anyway
##
sub links
{
    my $class = shift;
    return @LINKS if (@LINKS);
    @LINKS = ();
    
    my $self = $ETERNAL;
    my @links_components = $self->access ( class => [ 'link' ] );
    
    # add the links for the child documents of that document
    my $document_table = table ('Document');
    my $document = $document_table->get ( Full_Path => path_info );
    
    # hyperlinking is done when the path_info variable is okay, but
    # NOT in plugins that use a hacked path_info
    if (defined $document)
    {
	# retrieve the links for that document
	foreach my $link_component (@links_components)
	{
	    push @LINKS, {
		href => $link_component->url,
		desc => $link_component->description,
		expr => $link_component->title,
	    } if ($link_component->url ne '' and $link_component->title ne '');
	}
	
	# add the links for the child documents of that document
	my $document_table = table ('Document');
	my $document = $document_table->get ( Full_Path => path_info ) or
	    throw (new lib::Exception ( code => 'CANNOT_GET_DOCUMENT',
					info => $self ) );
	foreach my $child ($document->Children)
	{
	    push @LINKS, {
		href => $child->URI,
		desc => $child->Description,
		expr => $child->Title,
		lang => $child->Lang,
	    }
	}
    }
    
    # throw (new lib::Exception (info => [ sort { length ($b->{expr}) <=> length ($a->{expr}) } @LINKS ]));
    @LINKS = sort { length ($b->{expr}) <=> length ($a->{expr}) } @LINKS;
    return @LINKS;
}


##
# $obj->access ( class  => [ 'text, link' ],
#                number => 1,
#                remove => 0 );
# -----------------------------
#   Lets you query and access an editor components
##
sub access
{
    my $self = shift;
    my $arg  = undef;
    if (@_ == 0)    { return        }
    elsif (@_ == 1) { $arg = shift  }
    else            { $arg = { @_ } }
    
    my @component_class  = @{$arg->{class}};
    @component_class = () unless (defined @{$arg->{class}});
    my $component_number = $arg->{number} || 0;
    my $component_remove = $arg->{remove} || 0;
    
    # first of all, let's capture the components given their type
    # into a pool of matching components
    my @pool = ();
    foreach my $id (sort { $a <=> $b } keys %{$self->{block}})
    {
	my $component = $self->{block}->{$id};
	my $type = ref $component;
	
	if (@component_class)
	{
	    push @pool, map { ($MAP->{$_} eq $type) ? $id : () } @component_class;
	}
	else
	{
	    push @pool, $id;
	}
    }
    
    # if the component number is specified, then we should deal
    # with that component only
    if ($component_number)
    {
	my $id = $pool[$component_number - 1];
	return unless (defined $id);
	if ($component_remove) { return delete $self->{block}->{$id} }
	else                   { return $self->{block}->{$id} }
    }
    else
    {
	if ($component_remove) { return map { delete $self->{block}->{$_} or {} } @pool }
	else { return map { $self->{block}->{$_} } @pool }
    }
}


##
# $self->_initialize;
# -------------------
#   Initializes the newly created object
##
sub _initialize
{
    my $self = shift;
    my $cgi  = $self->{cgi} || return;
    
    $self->_initialize_initialize ($cgi);
    $self->_initialize_delete ($cgi);
    $self->_initialize_up ($cgi);
    $self->_initialize_down ($cgi);
    $self->_initialize_add ($cgi);
}


##
# $self->_initialize_initialize;
# ------------------------------
#   Scans the CGI parameters to set all the components
##
sub _initialize_initialize
{
    my $self = shift;
    my $cgi  = shift;
    
    # This loop sets all the components by scanning the CGI parameters
    foreach my $cgi_param_name ($cgi->param)
    {
	my $qBLOCK = quotemeta ($BLOCK) . "_";

	# if this CGI param is appropriate because it starts by $BLOCK
	if ($cgi_param_name =~ /^$qBLOCK([0-9]+)_([a-zA-Z]+)$/)
	{
	    my ($id, $type) = $cgi_param_name =~ /^$qBLOCK([0-9]+)_([a-zA-Z]+)$/;
	    my $class = $MAP->{$type};
	    my $file  = $class;
	    $file =~ s/::/\//g;
	    $file .= ".pm";
	    require $file;
	    import  $file;
	    $self->{block}->{$id} = $class->new ( cgi => $cgi, param_name => $cgi_param_name );
	}
    }
}


##
# $self->_initialize_delete;
# --------------------------
#   Scans the CGI parameters to check if a component has
#   to be removed
##
sub _initialize_delete
{
    my $self = shift;
    my $cgi  = shift;
    
    # Then we need to re-scan the cgi parameters to check if deleting
    # a component is requested
    foreach my $cgi_param_name ($cgi->param)
    {
	my $qBLOCK = quotemeta ($BLOCK) . "_";
       
	if ($cgi_param_name =~ /^$qBLOCK([0-9]+)_([a-zA-Z]+)_delete$/)
	{
	    my ($id, $type) = $cgi_param_name =~ /^$qBLOCK([0-9]+)_([a-zA-Z]+)_delete$/;
	    delete $self->{block}->{$id};
	}
    }
    
    # we may have deleted some elements, thus we need to squash the list
    # of identifiers ex 1 2 3 5 => 1 2 3 4
    my @components = map { $self->{block}->{$_} } sort { $a <=> $b } keys %{$self->{block}};
    $self->{block} = {};
    
    for (my $i = 0; $i < @components; $i++)
    {
	my $component = $components[$i];
	my $type   = $PAM->{ref $component};
	my $new_id = $i + 1;

	$component->{param_name} = $BLOCK . "_" . $new_id . "_" . $type;
	$self->{block}->{$new_id} = $component;
    }
}


##
# $self->_initialize_up;
# ----------------------
#   Scans the CGI parameters to check if a component has
#   to be moved up
##
sub _initialize_up
{
    my $self = shift;
    my $cgi  = shift;
   
    # Then we need to re-scan the cgi parameters to check if a component
    # has to move up.
    foreach my $cgi_param_name ($cgi->param)
    {
	my $qBLOCK = quotemeta ($BLOCK) . "_";
	
	if ($cgi_param_name =~ /^$qBLOCK([0-9]+)_([a-zA-Z]+)_up$/)
	{
	    my ($id, $type) = $cgi_param_name =~ /^$qBLOCK([0-9]+)_([a-zA-Z]+)_up$/;
	    if ($id > 1)
	    {
		my $id_1 = $id;
		my $id_2 = $id - 1,
		
		my $component_1 = $self->{block}->{$id_1};
		my $component_2 = $self->{block}->{$id_2};
		
		my $type_1 = $PAM->{ref $component_1};
		my $type_2 = $PAM->{ref $component_2};

		$self->{block}->{$id_1} = $component_2;
		$self->{block}->{$id_2} = $component_1;

		$component_1->{param_name} = $BLOCK . "_" . $id_2 . "_" . $type_1;
		$component_2->{param_name} = $BLOCK . "_" . $id_1 . "_" . $type_2;
	    }
	}
    }
}


##
# $self->_initialize_up;
# ----------------------
#   Scans the CGI parameters to check if a component has
#   to be moved down
##
sub _initialize_down
{
    my $self = shift;
    my $cgi  = shift;
    
    # Then we need to re-scan the cgi parameters to check if a component
    # has to move down
    foreach my $cgi_param_name ($cgi->param)
    {
	my $qBLOCK = quotemeta ($BLOCK) . "_";
	
	if ($cgi_param_name =~ /^$qBLOCK([0-9]+)_([a-zA-Z]+)_down$/)
	{
	    my ($id, $type) = $cgi_param_name =~ /^$qBLOCK([0-9]+)_([a-zA-Z]+)_down$/;
	    if ($id < scalar keys %{$self->{block}})
	    {
		my $id_1 = $id;
		my $id_2 = $id + 1,
		
		my $component_1 = $self->{block}->{$id_1};
		my $component_2 = $self->{block}->{$id_2};
		
		my $type_1 = $PAM->{ref $component_1};
		my $type_2 = $PAM->{ref $component_2};
		
		$self->{block}->{$id_1} = $component_2;
		$self->{block}->{$id_2} = $component_1;
		
		$component_1->{param_name} = $BLOCK . "_" . $id_2 . "_" . $type_1;
		$component_2->{param_name} = $BLOCK . "_" . $id_1 . "_" . $type_2;
	    }
	}
    }
}


##
# $self->_initialize_add;
# -----------------------
#   Scans the CGI parameters to check if a component has
#   to be added
##
sub _initialize_add
{
    my $self = shift;
    my $cgi  = shift;
    
    # Then we need to re-scan the cgi parameters to check if a component
    # has to be added
    if (defined $cgi->param ('_new_component_add'))
    {
	my $cgi_param_name = $cgi->param ('_new_component');
	my $qBLOCK = quotemeta ($BLOCK) . '_';
	my ($id, $type) = $cgi_param_name =~ /^$qBLOCK([0-9]+)_([a-zA-Z]+)$/;
	my $nb = $cgi->param ('_new_component_amount');
	my $class = $MAP->{$type};
	my $file  = $class;
	$file =~ s/::/\//g;
	$file .= ".pm";
	require $file;
	import  $file;
	
	$nb = 0 unless ($nb =~ /^[0-9]+$/);
	$nb = 100 if ($nb > 100);
	while ($nb > 0)
	{
	    $self->{block}->{$id} = $class->new ( cgi => $cgi, param_name => $BLOCK . "_" . $id . "_" . $type );
	    $id++;
	    $nb--;
	}
    }
}


##
# $self->edit;
# ------------
#   Returns the body html for component edition
##
sub edit
{
    my $self = shift;
    my @out  = map  { $self->{block}->{$_}->edit }
               sort { $a <=> $b }
               keys %{$self->{block}};
    
    my @add = ();
    my @id  = keys %{$self->{block}};
    my $next_id = @id + 1;
    
    foreach my $type (sort keys %{$MAP})
    {
	push @add, { type => $type, add => $BLOCK . "_" . $next_id . "_" . $type };
    }
    
    # build the add component box
    my $tmpl = new flo::Template ( file => $self->template_box_path, hash => { option => \@add } );
    push @out, $tmpl->parse;
    return join "\n", @out;
}


##
# $self->generate_xml;
# --------------------
#   Generates easily parsable pseudo-xml for database storage
##
sub generate_xml
{
    my $self = shift;
    my @out  = ();
    foreach my $id (keys %{$self->{block}})
    {
	my $component = $self->{block}->{$id};
	
	# find out what the type of this component is.
	my $type = $PAM->{ref $component};	
	push @out, ( qq |<block id="flo_block_$id" type="$type">|,
		     $component->generate_xml,
		     qq |</block>| );
    }
    return join "\n", @out;
}


##
# $self->parse_xml;
# -----------------
#   Parses the database pseudo-xml and turns it back into
#   proper memory structure
##
sub parse_xml
{
    my $self = shift;
    my $xml  = shift || "";
    my @xml  = split /\n/, $xml;

    my $cgi  = $self->{cgi};
    my @current_data = ();
    my $current_id   = undef;
    my $current_type = undef;
    foreach my $line (@xml)
    {
	if ($line =~ /^<block id=\"flo_block_[0-9]+\" type=\".*\">/)
	{
	    ($current_id, $current_type) = $line =~ /^<block id=\"flo_block_([0-9]+)\" type=\"(.*?)\">/;
	}
	elsif ($line =~ /^<\/block>/)
	{
	    if (defined $current_id and defined $current_type)
	    {
		my $class = $MAP->{$current_type};
		my $file = $class;
		$file =~ s/::/\//g;
		$file .= ".pm";
		require $file;
		import  $file;
		
		my $component = $class->new (cgi => $cgi, param_name => $BLOCK . "_" . $current_id . "_" . $current_type);
		
		$component->parse_xml (join "\n", @current_data);
		$self->{block}->{$current_id} = $component;
		@current_data = ();
	    }
	}
	else { push @current_data, $line }
    }
}


##
# $self->html;
# ------------
#   Returns the HTML that represents all the components.
#   This method is deprecated and should not be used anymore
##
sub html
{
    my $self = shift;
    my @out  = ();
    foreach my $id (sort { $a <=> $b } keys %{$self->{block}})
    {
	my $type = $PAM->{ref $self->{block}->{$id}};
	push @out, ( qq |<div id="flo_block_$id" class="$type">|,
		     $self->{block}->{$id}->html,
		     qq |</div>| );
    }
    my $res = join "\n", @out;
    # return $self->_make_links ($res);
    return $res;
}


##
# Computes the path of the template which has to be used for
# that component given the current document language
##
sub template_box_path
{
    my $self = shift;
    
    my $document_table = table ('Document');
    my $document = $document_table->get ( Full_Path => path_info );
    my $lang = $document->{Lang};
    
    return template ('editor/box', $lang);
}


##
# Computes the path of the template which has to be used for
# that component given the current document language
##
sub template_editor_path
{
    my $self = shift;
    
    my $document_table = table ('Document');
    my $document = $document_table->get ( Full_Path => path_info );
    my $lang = $document->{Lang};
    
    return template ('editor/editor', $lang);
}


sub tidy
{
    my $self = shift;
    my $cgi  = shift;
    
    foreach my $component (values %{$self->{block}})
    {
	if ($component->can ('tidy'))
	{
	    return unless ($component->tidy);
	}
    }

    return 1;
}


1;
