legend results from the CPAN

CGI-Listman
view release on metacpan or search on metacpan
#!/usr/bin/perl -wT

use strict;

use lib '/home/wolfgang/programmes/perl/CGI-Listman';
use CGI;
use CGI::Carp qw(fatalsToBrowser);
use CGI::Listman;
use CGI::Listman::exporter;
use POSIX qw(strftime);

use lib '.';
use config;

use constant export_file => 'export.csv';

use vars qw ($script_name);

$CGI::POST_MAX = 1024;
$ENV{'PATH'} = '/bin:/usr/bin';

sub decor_cell {
  my ($cell, $seen, $exported) = @_;

  my $decorated = undef;

  $decorated = $cell || '&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;';
  $decorated = '<b>'.$decorated.'</b>' unless ($seen);
  $decorated = '<font color="blue">'.$decorated.'</font>' if ($exported);

  return $decorated;
}

sub print_legend {
  print "<table align=\"right\" nowrap=\"nowrap\" border=1 cellspacing=0 cellpadding=1><tbody><tr>\n";
  print "<td>Légende&nbsp;:</td><td>Normal</td><td><b>Nouveau</b></td>".
    "<td><font color=blue>Exporté</font></td></tr>";
  print "</tbody></table>\n";
}

sub check_uri_file {
  my $file = $ENV{'REQUEST_URI'};

  if (defined $script_name) {
    $file =~ s/^${script_name}//;
    $file =~ s@^/@@ unless (-z $file);
  }

  return $file;
}

sub parse_line {
  my $line_ref = shift;

  my $content_line = '<tr><td nowrap="nowrap"><input type="checkbox" ';

  my $number = $line_ref->number ();
  $content_line .= 'checked="checked" ' unless $line_ref->{'seen'};
  $content_line .= 'name="select_'.$number.'">'.$number.'</td>';

  my $fields_ref = $line_ref->line_fields ();
  foreach my $field (@$fields_ref) {
    $content_line .= '<td bgcolor="lightgrey" nowrap="nowrap">'.
      decor_cell ($field, $line_ref->{'seen'}, $line_ref->{'exported'}).
	'</td>';
  }

  my $time = strftime "%a %b %e %H:%M:%S %Y", localtime ($line_ref->{'timestamp'});
  $content_line .= '<td nowrap="nowrap">';
  $content_line .= $time;
  $content_line .= "</td></tr>\n";

  return $content_line;
}

sub make_contents_header {
  my $listman = shift;;

  my $header = '<tr><td>No</td>';

  my $dictionary = $listman->dictionary ();
  my $dict_terms = $dictionary->terms ();

  foreach my $term (@$dict_terms) {
    my $field_name = $term->definition_or_key ();
    $header .= '<td nowrap="nowrap" align="center">'.$field_name.'</td>';
  }
  $header .= '<td nowrap="nowrap" align="center">'
    ."Date d'inscription</td></tr>\n";

  return $header;
}

sub interpret_contents {
  my $listman = shift;

  my $contents_ref = $listman->list_contents ();

  my $contents;
  if (defined $contents_ref && @$contents_ref) {
    $contents = make_contents_header ($listman);
    foreach my $contents_line (@$contents_ref) {
      $contents .= parse_line ($contents_line);
      $contents_line->mark_seen ();
    }
  } else {
    $contents = "<p>Aucune inscription.</p>" unless (defined $contents);
  }

  return $contents;
}

sub get_main {
  my ($cgi, $listman, $redirect_uri) = @_;

  if (defined $cgi->param ('edit')) {
    edit_dict ($listman, $cgi->param ('edit'), $cgi->param ('key'));
  } else {
    my $request_file = check_uri_file ();

    if ($request_file) {
      export_records ();
    } else {
      print "Content-type: text/html\r\n\r\n";

      print '<html><head>';
      print '<meta http-equiv="refresh" content="0; url='
	.$redirect_uri.'">' if (defined $redirect_uri);
      print '<title>Administration</title><head><body>'."\n";
      print '<form action="'.$ENV{'SCRIPT_NAME'}.'" method="POST"><table>';
      print "<tbody>\n";

      my $content = interpret_contents ($listman);
      print $content;

      print "</tbody></table>\n";
      print '<table><tbody><tr>';
      print '<td><input type="submit" name="submit" value="Effacer"></td>';
      print '<td><input type="submit" name="submit" value="Exporter"></td>';
      #  print '<td nowrap=nowrap><input type="radio" name="export_fmt" value="CSV" checked=checked>&nbsp;CSV</td>';
      #  print '<td nowrap=nowrap><input type="radio" name="export_fmt" value="Excel">&nbsp;Excel</td>';
      print '<td><input type="reset" value="Recommencer"></td>';
      print '<td><input type="submit" name="submit" value="Dictionnaire"></td>';
      print "</form>\n";
      print_legend ();
      print "</body></html>\n";
    }
  }
}

# sub print_params {
#   my $cgi = shift;

#   print "<html><head><title>Param</title></head><body>";
#   foreach my $param ($cgi->param ()) {
#     print "<p>".$param." = ".$cgi->param ($param)."</p>";
#   }
#   print "</body></html>";
# }

sub make_selection {
  my ($cgi, $listman) = @_;

  my @list;
  my @params = $cgi->param ();

  if (@params) {
    foreach my $param (@params) {
      if ($param =~ m/^select_([0-9].*$)/) {
	push @list, $1 if ($cgi->param ($param) eq 'on');
      }
    }
  }

  my $selection = undef;
  if (@list) {
    $selection = CGI::Listman::selection->new ();
    $selection->add_lines_by_number ($listman, \@list);
  }

  return $selection;
}

sub export_records {
  my $exporter = CGI::Listman::exporter->new ($config::list_dir.'/'.export_file);
  my $contents = $exporter->file_contents ();

  if (defined $contents) {
    print "Content-type: application/binary\r\n\r\n".$contents;
    unlink $config::list_dir.'/'.export_file;
  } else {
    print "Content-type: text/html\r\n\r\n";
    print "<html><body>No export file.</body></html>";
  }
}

sub make_export_uri {
  my $date = strftime ("%Y-%m-%d", localtime);
  my $uri = $ENV{'HTTP_REFERER'}.'/'.$config::list_name.'_'.$date.'.csv';

#  my $extension = ($format eq 'CSV') ? '.csv' : '.xls';

  return $uri;
}
( run in 1.789 second using v1.01-cache-2.11-cpan-9581c071862 )