# $Id: common.pm,v 1.27 2004/11/12 05:45:04 gwolf Exp $
######################################
# Comas - Conference Management System
######################################
# Copyright 2003 CONSOL
# Congreso Nacional de Software Libre (http://www.consol.org.mx/)
#   Gunnar Wolf <gwolf@gwolf.cx>
#   Manuel Rabade <mig@mig-29.net>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
######################################

######################################
# Module: Comas::HTML::common
# Common Functions for the HTML Front End.
######################################
# Depends on:
#
# HTML::Template - Perl module to use HTML Templates from CGI scripts

# This module is not meant to be called on its own, it should be called from
# Comas::HTML.

package Comas::HTML::common;

use strict;
use warnings;
use Carp;
use HTML::Template;

use Exporter;

our @ISA = qw(Exporter);
our @EXPORT_OK = qw(new_template _catalog2html_opts _list2html_opts 
                    _validator2html _is_privileged _get_file_info
		    _sort_proposals);
our %EXPORT_TAGS = (all => [@EXPORT_OK]);

=head1 NAME

Comas::HTML::common - Common functions for the HTML Front End.

=head1 SYNOPSIS

This module is not meant to be used by itself, but as an auxiliary to
L<Comas::HTML|Comas::HTML>. Please check L<Comas::HTML|Comas::HTML>'s
documentation, in the B<Front End Tasks> section, for further details on the
usage for this functions.

=head1 INTERNALS

=head2 METHODS

=head3 $template = $html->new_template($filename, %args);

Returns a new template created via C<HTML::Template>, the argument C<$filename>
should be a relative or absoulte path to the template we want to use, and %args
is an optional hash with options that will be passed to C<HTML::Template> and
should only be used in rare cases where we want to override some database
configuration or C<HTML::Template> default behavior.

Also this function pass some default values to the templates like the comas URL
(C<comas_url> in the templates).

In case of an error it returns undef, or true if if successful.

=cut

sub new_template {
    my ($h, $filename, $args, $template, $comas_url, $conference_url);
    $h = shift;
    $filename = shift;
    $args = shift || {};

    $comas_url = $h->{-db}->get_conf('comas_url') || '/comas';
    $conference_url = $h->{-db}->get_conf('conference_url') || '/';

    # Default values: Set them unless specified by the invoker
    $args->{path} = $h->{-config}{-tmpl_path} unless exists $args->{path};
    $args->{die_on_bad_params} = 0 unless exists $args->{die_on_bad_params};
    $args->{cache} = 1 unless exists $args->{cache};
    $args->{global_vars} = 1 unless exists $args->{global_vars};

    $template = HTML::Template->new(filename => $filename, %$args);
    $template->param(comas_url => $comas_url,
		     comas_conf => $conference_url);

    return $template;
}

=pod

=head2 FUNCTIONS

This functions are not internal, they are used all across
L<Comas::HTML|Comas::HTML> module.

=head3 $str = _catalog2html_opts($db, $catalog, $selected_id, $privileges,
$type);

Returns a html dropbox from a catalog of the database. The arguments are:

=over 2

=item - $db

L<Comas::DB|Comas::DB> object.

=item - $catalog

The name of the catalog.

=item - $selected_id

An id of the option selected by default, if it is not present and empty option
will be added and selected.

=item - $privileges

it's the name of a configuration option with the privileged values that we don't
want to have in the options box, optional.

=item - $type

If it's set to 0 or isn't set the dropbox will have a blank (or unset) option,
if it's set to 1, the box will not have the blank option.

=back

=cut

sub _catalog2html_opts {    
    my $db = shift;
    my $catalog = shift;
    my $selected_id = shift;
    my $privileges = shift;
    my $type = shift;
    my ($sth, $html, $catalog_id);

    unless (defined $type) {
        $type = 0;
    }

    unless ($sth = $db->prepare("SELECT id, descr FROM $catalog WHERE id != 0")) {
        return undef;
    }
    
    if ($sth->execute eq '0E0') {
        return undef;
    }
    
    my $r = $sth->fetchall_hashref('id');

    if ($type == 0) {
        if (defined $selected_id) {
            if ($selected_id eq '') {
                $html = '<option name="unset" value="" selected></option>';
            } else {
                $html = '<option name="unset" value=""></option>';
            }
        } else {
            $html = '<option name="unset" value=""></option>';
        }
    }

    if (defined $privileges) {
        my ($priv, $p_id, $rv);
        unless ($sth = $db->prepare('SELECT value FROM config where name= ?')) {
            return undef;
        }
        unless ($rv = $sth->execute($privileges)) {
            return undef;
        }
	unless ($rv eq '0E0') {
	    foreach $p_id (split(/\,/, $sth->fetchrow_array)) {
		delete $r->{$p_id};
	    }
	}
    }

    foreach $catalog_id (sort {$a <=> $b} keys %$r) {
        $html .='<option ';
        if (defined $selected_id && $catalog_id eq $selected_id) {
            $html .= 'selected ';
        }
        $html .= 'value="'. $catalog_id .'">';
        $html .= $r->{$catalog_id}{'descr'} .'</option>';
    }
    return $html;	
}

=pod

=head3 $res = _is_privileged($db, $id, $priv_catalog);

Check if an id is privileged or not via the privileged catalogs in the database
configuration. Return 1 is its prvileged and 0 if isn't. The arguments are:

=over 2

=item - $db

L<Comas::DB||Comas::DB> object.

=item - $id

The id to check.

=item - $priv_catalog

The name of the privileged catalog.

=back

=cut

sub _is_privileged {
    # Three arguments: a Comas::DB object, the second is and id and the third
    # the name of the config option to check if is privileged the id.

    # Will return '1' if its privileged and '0' if isn't

    my ($db, $id, $priv_catalog) = (shift, shift, shift);
    my $sth;

    unless ($sth = $db->prepare('SELECT value FROM config where name= ?')) {
        return undef;
    }
    unless ($sth->execute($priv_catalog)) {
        return undef;
    }
    foreach my $p_id (split(/\,/, $sth->fetchrow_array)) {
        if ($p_id eq $id) {
            return 1;
        }
    }
    return 0;
}

=pod

=head3 $str = _is_privileged($list, $id);

Returns an html dropbox from a list of values (normaly numbers, becasue the
value in the dropbox is the same that is show). The arguments are:

=over 2

=item - $list

A reference to an array that cotains the list.

=item - $id

The default value selected, if not defined will be a blank value selected.

=back

In case of an error it returns undef, or true if successful.

=cut

sub _list2html_opts {
    my ($list, $selected_id) = (shift, shift);
    my ($html, $list_item);
   
    if (defined $selected_id) {
        $selected_id =~ s/^0//;    
        if ($selected_id ne '') {
            $html = '<option name="unset" value=""></option>';
        } else {
            $html = '<option name="unset" value="" selected></option>';
        }
    } else {
        $html = '<option name="unset" value="" selected></option>';
    }
    
    foreach $list_item (@$list) {
        $html .='<option ';
        if (defined $selected_id) {
            if ($list_item eq $selected_id) {
                $html .= 'selected ';
            }
        }
        $html .= 'value="'. $list_item .'">'. $list_item .'</option>';
    }
    return $html;	
}

=pod

=head3 %res = _validator2html($results);

Returns a nice hash ready to be passed to C<HTML::Template> of
C<Data::FormValidator> results.

In case of an error it returns undef, or true if if successful.

=cut

sub _validator2html {
    my $results = shift;
    my %ret;

    if ( $results->has_missing ) {
        $ret{HAS_MISSING} = '1';
        foreach my $f ( $results->missing ) {
            $f =~ s/^-//;
            $ret{$f . '_MISSING'} = '1';
        }
    }    
    
    if ( $results->has_invalid ) {
        $ret{HAS_INVALID} = '1';
        foreach my $f ( $results->invalid ) {
            $f =~ s/^-//;
            $ret{$f . '_INVALID'} = '1';
        }
    }
    return %ret;
}

##################################
# Deprecated function _get_file_info
# Leaving the stub here in order not to break (too much) the code. Should die
# soon.
#
# =pod
#
# =head3 %res = $html->_get_file_info($proposal);
#
# Retrive the file information of C<$proposal> (must be a
# L<Comas::Proposal|Comas::Proposal> object). The result is a nice hash with the
# creation date and size of the file.
#
# Note: This is not a function, is a method of L<Comas::HTML|Comas::HTML>, but is
# classified as an utility funcion, also this function will be deprecated because
# we will store the files in the database soon.
#
# In case of an error it returns undef, or true if if successful.
#
# =cut

sub _get_file_info {
#     my $h = shift;
#     my $proposal = shift;
#     my (%info, $mtime);

#     (undef, undef, undef, undef, undef, undef, undef, $info{-size},
#      undef,$mtime,undef) = stat($h->{-config}->{-prop_file_path}.
#                                 $proposal->{-id}.'/'.
#                                 $proposal->get_filename);
#     (undef, $info{-min}, $info{-hour}, $info{-day}, $info{-month}, $info{-year}) = localtime($mtime);
    
#     $info{-year} += 1900;
#     $info{-month} += 1;

#     if($info{-hour} < 10) {
#         $info{-hour} = "0$info{-hour}";
#     }
#     if($info{-min} < 10) {
#         $info{-min} = "0$info{-min}";
#     }
#     if($info{-size} < 1024) {
#         $info{-size} = "$info{-size} bytes";
#     } elsif ($info{-size} < 1048576) {
#         $info{-size} = int($info{-size}/1024) . ' Kb';
#     } elsif ($info{-size} < 1073741824) {
#         $info{-size} = int($info{-size}/1048576) . ' Mb';
#     }

#     return %info;
    carp "Use of deprecated _get_file_info method";
}

=pod

=head3 @sorted = _sort_proposals($criteria, @unsorted);

Sort proposals by one criteria. The arguments are:

=over 2

=item - $criteria

The criteria that will use to sort the proposals, currently only 'title' or
'author'.

=item - @unsorted

An array of L<Comas::Proposal|Comas::Proposal> objects that isn't sorted.

=back 

Returns an array will sorted L<Comas::Proposal|Comas::Proposal> objects.

In case of an error it returns undef, or true if if successful.

=cut

sub _sort_proposals {
    my ($criteria, @unsorted, @sorted);
    $criteria = shift;
    @unsorted = @_;

    if ($criteria eq 'title') {
	# By title - that's easy.
	@sorted = sort { lc(_to_ascii($a->{-title})) cmp 
			     lc(_to_ascii($b->{-title})) } @unsorted;
    } elsif ($criteria eq 'author') {
	# By the name of the first author
	@sorted = sort { lc(_to_ascii($a->{AUTHORS}[0]{-famname})) cmp 
			     lc(_to_ascii($b->{AUTHORS}[0]{-famname})) 
			 } @unsorted;
    } else {
	# Not a known criteria - Warn about it and return the list as it is.
	warn "Unknown proposal sort criteria requested: $criteria";
	@sorted = @unsorted;
    }

    return @sorted;
}

=pod

=head3 $str = _to_ascii($str);

Converts a string to its closest ASCII representation.

Receives any LATIN1 string. Returns the same string, with the accented
characters replaced by the non-accented base character.

In case of an error it returns undef, or true if if successful.

=cut

sub _to_ascii {
    # Converts a string to its closest ASCII representation
    # Receives any LATIN1 string 
    # Returns the same string, with the accented characters replaced by 
    # the non-accented base character.
    my ($str);
    $str = shift;

    $str =~ tr/ÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöøùúûüýÿ/AAAAAACEEEEIIIIDNOOOOOOUUUUYaaaaaaceeeeiiiidnoooooouuuuyy/;

    # Many strings will only have the above characters - By returning
    # now, we avoid a lot of extra work
    return $str unless $str =~ /[ÆÞßæþ]/;

    $str =~ s/Æ/AE/g;
    $str =~ s/Þ/TH/g;
    $str =~ s/ß/ss/g;
    $str =~ s/æ/ae/g;
    $str =~ s/þ/th/g;

    return $str
}

=pod

=head1 SEE ALSO

L<Comas::HTML|Comas::HTML> module documentation

=head1 AUTHOR

Gunnar Wolf, gwolf@gwolf.cx

Manuel Rabade, mig@mig-29.net

Comas has been developed for CONSOL, Congreso Nacional de Software Libre,
http://www.consol.org.mx/

=head1 COPYRIGHT

Copyright 2003 Gunnar Wolf and Manuel Rabade

This library is free software, you can redistribute it and/or modify it
under the terms of the GPL version 2 or later.

=cut

1;

# $Log: common.pm,v $
# Revision 1.27  2004/11/12 05:45:04  gwolf
# Added the functionality to be able to handle more than one file per proposal and store it in the DB, not in separate files.
#
# Revision 1.26  2004/07/26 05:15:16  mig
# Fixed small typos in POD.
#
# Revision 1.25  2004/07/26 05:06:32  mig
# Fixed small typo in the comments at the beginning.
#
# Revision 1.24  2004/07/18 07:53:54  mig
# Fixed more typos in POD
#
# Revision 1.23  2004/07/18 05:03:28  mig
# Typos in POD corrected
#
# Revision 1.22  2004/07/15 22:49:50  mig
# Another documented module :)
#
# Revision 1.21  2004/07/15 06:28:45  mig
# Documentation done :)
#
# Revision 1.20  2004/07/08 02:53:29  gwolf
# Little bug-fix: Template variables should be global in order for the
# comas_url variable to be expanded inside loops :-/
#
# Revision 1.19  2004/07/08 00:15:41  gwolf
# Handling Comas' and the conference's base URL in the configuration,
# not hard-coded in the HTML templates themselves
#
# Revision 1.18  2004/07/01 05:50:39  gwolf
# Fixes sorting order in case the name/title in question has accented (or
# other non-ASCII) characters. Note that they _must_ be in the LATIN1
# charset, otherwise this will not do much with it (hopefully not meaning
# we are breaking other locales, only that it will only do this correctly
# for LATIN1)
#
# Revision 1.17  2004/04/17 16:33:34  gwolf
# Sorting authors and proposals should be case-insensitive.
#
# Revision 1.16  2004/04/16 23:55:37  gwolf
# Moved _sort_proposals from HTML::common to HTML::general, as it is
# used as well from HTML::committee::person_adm
#
# Revision 1.15  2004/04/14 13:32:39  gwolf
# Smaller typo/bug fixes.
#
# Revision 1.14  2004/04/07 21:32:41  gwolf
# Created Comas::DB methods getCatalog and getCatDescr, modified some of
# Comas::DB modules in order to use this interface instead of
# Comas::HTML::common::_id2descr (and removed that function, of course)
#
# Revision 1.13  2004/01/21 08:34:05  mig
# - El id '0' en los catalogos es utilitario y no lo despliega nunca.
#
# Revision 1.12  2004/01/11 04:57:19  mig
# - Agrego _get_file_info que devuelve un hash con la info de un archivo.
#
# Revision 1.11  2003/12/20 04:14:51  mig
# - Agrego tags Id y Log que expanda el CVS
#
