package Chronology;
# vim:sw=3:ts=3:et:

use 5.006;
use strict;
use warnings;
use Time::Local;
use Data::Dumper; #TODO Para tirar no final

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT_OK = qw();
our @EXPORT = qw();

our $VERSION = '0.01';

our $DEBUG = 1;

=head1 NAME

Chronology - Perl module for manipulating chronologies.

=head1 SYNOPSIS

use Chronology;
blah blah blah

=head1 DESCRIPTION

TODO

=head2 METHODS

=over 4

=item new Chronology(I<>) | new Chronology(I<backend>, I<file>)

Creates a new Chronology object. If you pass it a backend's name and a
file it tries to load the chronology from that C<file> using the
C<backend>.

=cut
sub new {
   my ($proto, $backend, $file) = @_;
   my $class = ref($proto) || $proto;
   my $self = {};
   bless($self, $class);

   $self->{_chrono_} = {};

   if((defined $backend) && (defined $file)) {
      $self->load($backend, $file);
   }

   return($self);
}


=pod

=item save(I<backend>, I<file>)

Saves the Chronology object to a C<file> using a C<backend>.

=cut
sub save($$$) {
   my ($self, $backend, $file) = @_;

   $backend = "Chronology::$backend";

   if(!_checkBackend_($backend)) {
      die "Invalid backend: $backend\n";
   } elsif(-f $file && !(-w $file)) {
      die "Can't write to $file!\n";
   } else {
      eval "${backend}::save(\$file, \$self);";
      if($@) { die "$@"; }
   }
}


=pod

=item load(I<backend>, I<file>)

Loads a Chronology object from a C<file> using a C<backend>.

=cut
sub load($$$) {
   my ($self, $backend, $file) = @_;
   my $c;

   $backend = "Chronology::$backend";

   if(!_checkBackend_($backend)) {
      die "Invalid backend: $backend\n";
   } elsif(!(-r $file)) {
      die "Can't read $file!\n";
   } else {
      eval "\$c = ${backend}::load(\$file); ";
      if($@) { die "$@"; }

      if(ref($c) eq 'Chronology') {
         $self->{_chrono_} = $c->{_chrono_};
      } elsif(ref($c) eq 'Chronology::Chronology') {
         $self->add_chronology($c);
      } elsif(ref($c) eq 'ARRAY') {
         map { $self->add_chronology($_); } @$c;
      } else {
         die "backend $backend doesn't return a valid type\n";
      }
   }
}

=pod

=item get_chronology(I<id>)

Retrieves the Chronology::Chronology object with the given C<id>.

=cut
sub get_chronology($$) {
   my ($s, $id) = @_;

   return($s->{_chrono_}{$id} || undef);
}

=pod

=item add_chronology(I<chronology>)

Adds a new L<Chronology::Chronology(3pm)> object to the structure.

=cut
sub add_chronology($$) {
   my ($s, $c) = @_;

   if(ref($c) eq 'Chronology::Chronology') {
      my $id = $c->id();

      if( !defined($id) ||             # chronology doesn't have an id or
          exists($s->{_chrono_}{$id})  # chronology has a duplicated id
      ) {
         #let's find a new id
         my $num = 0;
         while(exists $s->{_chrono_}{"_${num}_"}) { $num++; }
         $id = "_${num}_";

         # update object
         $c->id($id);
      }
      # add chronology
      $s->{_chrono_}{$id} = $c;
   } else {
      warn 'trying to add a ' . ref($c) . " object to the chronology\n";
   }
}

=pod

=item filter(I<filter1>, ...) | filter('or', I<filter1>, ...)

Retrieve a the events that apply to a filter. If a multiple filter are
used then the return value is an AND combination of each filter. This can
be changed passing C<or> as the first parameter (in which case the result
will be an OR combination of each filter). The result is
Chronology::Chronology object with the events that match the filter.

Valid filters are:

=over 8

=item return_list => 1

Defines an alternative return type of the filter. By default it returns a
Chronology object but if this option is set it can return an anonymous
array of Event objects.

=item keyword => I<regex>

Matches a perl regular expression with all the keywords.

=item name => I<regex>

Matches a perl regular expression with name of the event.

=item author => I<regex>

Matches a perl regular expression with all the authors of the event.

=item lang => I<regex>

Matches a perl regular expression with the lang of the event.

=item local => I<regex>

Matches a perl regular expression with the local of the event.

=item description => I<regex>

Matches a perl regular expression with the text description of the event
(as returned by the C<text_description> function).

=item after => I<date>

Matches all events that toke place after the specified date. The date must
be in a ChronL format (see L<Chronology::chronl/Dates>).

=item before => I<date>

Matches all events that toke place before the specified date. The date must
be in a ChronL format (see L<Chronology::chronl/Dates>).

=back

=cut
sub filter {
   my $s = shift();
   my $or = 0;
   if($_[0] eq 'or') { $or = 1; shift(); }
   my %o = @_;

   my $do_list = 0;
   $do_list = delete($o{return_list}) if(exists $o{return_list});

   my @list = ();

   for my $id (keys %{$s->{_chrono_}}) {
      my $c = $s->{_chrono_}{$id};

      my $v;
      if($or) { $v = $c->filter('or', %o); }
      else { $v = $c->filter(%o); }

      push(@list, $v) if(defined $v);
   }

   return(undef) unless(@list);

   if($do_list) {
      my @return;
      for my $cc (@list) { push(@return, @{$cc->events()}); }
      return(\@return);
   }

   # else 
   my $c = new Chronology();
   for my $cc (@list) { $c->add_chronology($cc); }
   return($c);
}

# checks if a backend exists
# <= backend:str
# => boolean
sub _checkBackend_($) {
   my $backend = shift();

   eval "require $backend;";
   if($@) {
      warn "$@\n";
      return(0);
   }
   return(1);
}

# creates a html document with the chronology
# <= null
# => str
sub toHTML {
   my $self = shift(); 
   my %args = @_;
   my ($toc, $path, $res, $base_dir) = (0, '.');

   $res = _header_('Chronologies') if(exists($args{standalone}) &&
                                      $args{standalone});
   #saving options
   if(exists $args{auxdir}) { $path = $args{auxdir}; }

   # do TOC
   if(exists $args{toc}) { $toc = $args{toc}; }
   
   $base_dir = $args{base_dir} if(exists $args{base_dir});

   #filtering views
   if (!exists($args{view}) || $args{view} eq "events_list") {
      $res .= _eventsList_($self,$path,$toc, $base_dir);     
   } elsif($args{view} eq "events_table") {
      $res .= _eventsTable_($self,$path);
   } elsif($args{view} eq "keywords") {
      $res .= _keywords_($self,$path);
   } elsif($args{view} eq "timeline") {
      $res .= _timeline_($self,$path);
   } else {
      warn("invalid view\n");
      return(undef);
   }
  
   $res .= _footer_() if(exists($args{standalone}) &&
                        $args{standalone});
   return($res);
}


#header of the html document
sub _header_ {
   my $title = shift;
   my $res = <<"END";
<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\" \"http://www.w3.org/TR/html4/strict.dtd\">
<html>
<head>
<style type=\"text/css\">
  body {font-family: Arial; font-size: 13px}
   thead.events {font-weight: bold;}
   caption.events {text-align: left; font-weight: bold;}
   table.events {}
   thead.events {background-color: #d0d0d0;}
   tr.par {background-color: #f9ce87;}
   tr.impar {background-color: #93a5ed;}
   li.event {font-size:110%;}
</style>   
<meta http-equiv=\"Content-Type\" content=\"text/html; charset=ISO-8859-15\">
<title>$title</title>
</head>

<body>
<h1>$title</h1>
END
}


#footer of the html document
sub _footer_ {
   return("</body></html>");
}

#outputs a html list of the events 
sub _eventsList_ {
   my ($self, $path, $toc, $b) = @_;
   my $ind = 0;
   my $res = "<ul>\n";

   for my $aux (keys %{$self->{_chrono_}}) {
      my $c = $self->get_chronology($aux);

      $res .= "<li class=\"chronology\">\n";
      (defined $b)
      ? ($res .= $c->toHTML(toc => $toc, base_dir => $b))
      : ($res .= $c->toHTML(toc => $toc));
      $res .= "</li>\n";
   }

   $res .= "</ul>\n";

   return($res);
}

#outputs a html table of the events 
sub _eventsTable_ {
   my ($self,$path) = @_;
   my $ind = 0;
   my $res;

   for my $aux (keys %{$self->{_chrono_}}) {
      my $c = $self->get_chronology($aux);
#use Data::Dumper; print Dumper($c);
      next unless(defined($c) && ref($c) eq 'Chronology::Chronology');
 
      # chronology's name
      $res = "<h3>". ++$ind . "- ". $c->name() ."</h3>";

      $res .= <<'END';
<table summary="Event's Table" class="events">
<thead class="events">
<tr>
   <td>Date</td><td>Description</td><td>Location</td>
</tr>
</thead>
<tbody>
END

      # chronology's events
      my $events = $c->events(); #events is a array pointer
      for(my $i = 0; $i < @$events; $i++) {
         my $e = $events->[$i];
         $res .= '<tr class="'. ($i % 2 == 0 ? 'par' : 'impar') .
                 "\">\n   <td>";
         # dates
         my @dates = $e->date();
         if(@dates == 1) {
            $res .= $dates[0];
         } elsif(@dates == 2) {
            $res .= $dates[0] . ' until ' . $dates[1];
         } 

         $res .= "</td>\n";

         $res .= '   <td>'. $e->html_description() . '</td>';

         if($e->local()) {
            $res .= "<td>".$e->local()."</td>";
         } else {
            $res .= "<td></td>";
         }

         $res .= "\n</tr>\n";
      }

      $res .= "</tbody>\n</table>\n<hr/>";
   }
   return($res);
}


#keywords
sub _keywords_ {
   my ($self,$chrono_id,$path) = @_;
   my $ind = 0;
   my $res;

   for my $aux (keys %{$self->{_chrono_}}) {
      my $c = $self->get_chronology($aux);
      
      # chronology's name
      $res = "<h3>". ++$ind . "- ". $c->name() ."</h3>\n<ol>";

      # chronology's events
      my $events = $c->events(); #events is a array pointer
      for(my $i = 0; $i < @$events; $i++) {
         my $e = $events->[$i];
         if(defined $e->keyword()) {
            $res .= '<li>' . $e->html_description();
            $res .= '<blockquote>';
         
            $res .= join("; ", @{$e->keyword()});
            $res .= '</blockquote></li>';
         }
      }
      $res .= "</ol><hr/>\n";
   }
   $res;
}

=pod

=item timeline(I<OPTIONS>)

Creates a GD object from the chronology and returns it. This method
requires Image::Timeline to work properly, if this module isn't present it
returns C<undef>.

At the moment only the year information is used when creating the
timeline. Also notice that for a medium/large chronology, the timeline
generated is confusing.

Valid options are:

=over 8

=item max_events

Defines the number of events to the consider.

=back

Any other option is passed to the L<Image::Timeline(3pm)> module.

=cut
sub timeline {
   my $self = shift();
   my %opts = @_;
   my $max = -1;

   $max = delete($opts{max_events}) if(exists $opts{max_events});

   delete $opts{date_format};

   # check if Chronology::Timeline is present
   eval "use Chronology::Timeline;";
   if($@) {
      return(undef);
   }

   my @arr;

   # for each chronology
   LOOP:
   for my $ch_id (keys %{$self->{_chrono_}}) {
      my $chrono = $self->get_chronology($ch_id);

      # for each event in chronology
      for my $event (@{$chrono->events()}) {
         my $name = $event->name();
         my @dates = $event->date();

         if(@dates == 1) {
            push(@arr, [$name, $dates[0]->to_num(), $dates[0]->to_num()]);
         } elsif(@dates == 2) {
            push(@arr, [$name, $dates[0]->to_num(), $dates[1]->to_num()]);
         }
         last LOOP if(--$max == 0);
      }
   }

   my $label = $arr[-1]->[0];
 
   use Chronology::Timeline;
   my $t = new Chronology::Timeline(
      to_string => \&Chronology::Date::from_int,
      bar_stepsize => '20%',
      right_margin => length($label) * 5,
      %opts,
   );

   for my $elem (@arr) {
      my ($label, $date_b, $date_e) = @$elem;
      $t->add($label, $date_b, $date_e);
   }

   return($t->draw());
}

#TODO
#Problemas com o Image::Timeline
#. A linha de tempo só pode ficar na horizontal
# <= null 
# => gd object
sub _timeline_ {
   my ($self, $chrono_id, $path) = @_;
   my $img;
  
   eval "use Image::Timeline;";
   if($@) {
       return('<p>Image::Timeline not available</p>');
   } else {
      use Image::Timeline;
   }
    
   for my $aux (keys %{$self->{_chrono_}}) {
      my $c = $self->get_chronology($aux);

      # chronology's name
      # $chrono->{$aux}{_name_}
      my @events_name;
      
      # chronology's events
      my $events = $c->events(); #events is a array pointer
      for(my $i = 0; $i < @$events; $i++) {
         my $e = $events->[$i];

         if(defined $e->name()) {
            my @date = $e->date();
            if(@date == 1) {
                push(@events_name, [$e->name(), $date[0]->year()]);
            } elsif(@date == 2) {
                push(@events_name, [$e->name(), $date[0]->year(), $date[1]->year()]);
             }
         }
      }

      
      #se encontrou algum evento disponível para ir para a timeline
      if (@events_name > 0) {
         my $t = new Image::Timeline(bar_stepsize => 1);
         
         for my $aux (@events_name) {
            if (@$aux == 2) {  #evento só com date
               $t->add($aux->[0], $aux->[1], $aux->[1]);            
            } elsif (@$aux == 3) { #evento com date_begin e date_end
               $t->add($aux->[0], $aux->[1], $aux->[2]);            
            }
         }
       
         $img = $t->draw;
      }
   }
   $img;
}

1;

=pod

=head1 SEE ALSO

Chronology::Chronology(3pm), Chronology::Event(3pm), Image::Timeline(3pm)

=head1 AUTHOR

Paulo Jorge Jesus Silva, E<lt>paulojjs@c47.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2004 by Paulo Jorge Jesus Silva

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.1 or,
   at your option, any later version of Perl 5 you may have available.

=cut