formulare/zlp2013/zlp

#!/usr/bin/perl -w -CSDA
use v5.14;
use strict;
use warnings;
use utf8;

use CGI::Fast qw/header param/;
use CGI::Fast qw/Vars/;
use Data::Dumper;
use Email::Simple;
use Email::Sender::Simple qw/sendmail/;
use File::Slurp qw/append_file/;
use JSON qw/encode_json/;
use YAML::Any qw/Dump LoadFile/;

use Fcntl qw/LOCK_EX LOCK_UN/;
use List::Util qw/sum/;

##################################################

# Inceput setari
my %events = (
  balti => {
	date => 'duminică, 29 septembrie 2013',
	locul => '',
	sala => '',
	locuri => 60,
	link => 'http://ceata.org/evenimente/zlp-2013-%C8%99i-30-de-ani-de-gnu-%C3%AEn-b%C4%83l%C8%9Bi',
	image => '',
  },

  bucuresti => {
	date => 'duminică, 22 septembrie 2013',
	locul => '',
	sala => '',
	locuri => 60,
	link => 'http://ceata.org/evenimente/zlp-2013-%C8%99i-30-de-ani-de-gnu-%C3%AEn-bucure%C8%99ti',
	image => '',
  },

  chisinau => {
	date => 'sâmbătă, 28 septembrie 2013',
	locul => '',
	sala => '',
	locuri => 60,
	link => 'http://ceata.org/evenimente/zlp-2013-%C8%99i-30-de-ani-de-gnu-%C3%AEn-chi%C8%99in%C4%83u',
	image => '',
  },

  cluj => {
	date => 'sâmbătă, 28 septembrie 2013',
	locul => '',
	sala => '',
	locuri => 60,
	link => 'http://ceata.org/evenimente/zlp-2013-%C8%99i-30-de-ani-de-gnu-%C3%AEn-cluj-napoca',
	image => '',
  },

  constanta => {
	date => 'sâmbătă, 21 septembrie 2013',
	locul => '',
	sala => '',
	locuri => 60,
	link => 'http://ceata.org/evenimente/zlp-2013-%C8%99i-30-de-ani-de-gnu-%C3%AEn-constan%C8%9Ba',
	image => '',
  },

  valcea => {
	date => 'sâmbătă, 28 septembrie 2013',
	locul => '',
	sala => '',
	locuri => 60,
	link => 'http://ceata.org/evenimente/zlp-2013-%C8%99i-30-de-ani-de-gnu-%C3%AEn-r%C3%A2mnicu-v%C3%A2lcea',
	image => '',
  }
);

use constant EMAIL_FROM => 'Ziua Libertății Programelor — Fundația Ceata <zlp@ceata.org>';
use constant ADMIN_EMAIL => 'zlp@ceata.org';
use constant DATAFILE => 'date.yml';
# Sfarsit setari

##################################################

open LOCK, '<', DATAFILE;

sub nr_participanti { my $oras = shift; sum 0, map { $_->{numar} } grep { $_->{oras} eq $oras } @_ }

sub append{
  flock LOCK, LOCK_EX;

  eval {
	my $prenume = param('prenume') or die 'Nu ați completat prenumele';
	utf8::decode($prenume);
	my $nume = param('nume') // '';
	utf8::decode($nume);
	my $adresa = param('adresa') or die 'Nu ați completat adresa de poștă electronică';
	utf8::decode($adresa);
	my $oras = param('oras') or die 'Nu ați ales orașul cu evenimentul';
	die 'Ziua Libertății Programelor nu se ține în orașul ales' unless exists $events{$oras};
	my $numar = int param('numar') or die 'Nu ați ales numărul de participanți';
	die 'Numărul de participanți trebuie să fie între 1 și 5' unless $numar >= 1 && $numar <= 5;
	my $captcha = param('captcha') or die 'Nu ați completat anul de lansare al proiectului GNU';
	die 'Ați completat greșit anul de lansare al proiectului GNU' unless $captcha == 83;
	my $referinta = param('referinta') || param('referinta2');
	my $anunturi = param('anunturi') or 0;
	my @db = grep { $_->{oras} eq $oras } LoadFile DATAFILE;
	die 'Această adresă de poștă electronică este deja folosită' if grep { $_->{adresa} eq $adresa } @db;
	my $participanti = nr_participanti $oras, @db;
	die 'Nu sunt suficiente locuri libere' if $events{$oras}{locuri} < $participanti + $numar;

	my %entry = (
	  prenume => $prenume,
	  nume => $nume,
	  adresa => $adresa,
	  oras => $oras,
	  numar => $numar,
	  referinta => $referinta,
	  anunturi => defined($anunturi) && $anunturi ? 1 : 0,
	);
	my $success_email = Email::Simple->create(
	  header => [
		To => "$nume <$adresa>",
		Subject => 'Confirmarea de înscriere la Ziua Libertății Programelor',
		From => EMAIL_FROM,
	  ],
	  body => "Aceasta este o confirmare automată de înscriere la unul din evenimentele organizate de Fundația Ceata de Ziua Libertății Programelor și aniversarea a 30 de ani de GNU.\n\n" . Dump \%entry,
	);
	sendmail $success_email, { to => [$adresa, ADMIN_EMAIL]};
	append_file DATAFILE, Dump \%entry;
  };

  flock LOCK, LOCK_UN;
  if ($@) {
	my $eroare = $@ =~ s/ at .*//r;
	my $error_email = Email::Simple->create(
	  header => [
		To => "Administrator <" . ADMIN_EMAIL . ">",
		Subject => 'Eroare de înscriere la Ziua Libertății Programelor',
		From => EMAIL_FROM,
	  ],
	  body => "Eroare: $eroare\n" . Dumper scalar Vars,
	);
	sendmail $error_email;
	print header('text/html; charset=utf-8', '500 Internal Server Error');
	print $eroare;
  } else {
	print header('text/html; charset=utf-8');
	print 'Ați fost înscris cu succes';
  }
}

sub info{
  my $oras = param('oras');

  eval {
	die 'Eveniment inexistent' unless defined $oras && exists $events{$oras};
	my %out = %{$events{$oras}};
	my $participanti = nr_participanti $oras, LoadFile DATAFILE;
	$out{locuri} = $out{locuri} - $participanti;
	print header('application/json; charset=utf-8');
	print encode_json \%out;
  };

  if ($@) {
	$@ =~ s/ at .*//;
	print header('text/html; charset=utf-8', '500 Internal Server Error');
	print $@;
  }
}

sub view{
  my $oras = param('oras');

  unless (exists $events{$oras}) {
	print header('text/html; charset=utf-8', '500 Internal Server Error');
	print 'Acest eveniment nu există';
	return;
  }

  my @db = grep { $_->{oras} eq $oras } LoadFile DATAFILE;
  my $participanti = nr_participanti $oras, @db;
  print header('text/html; charset=utf-8');
  print "Sunt $participanti participanți înscriși<p>";
  # for my $p(@db) {
  #	print "Nume: $p->{nume}<br>Prenume: $p->{prenume}<br>Adresa: $p->{adresa}<br>Oras: $p->{oras}<br>Numar: $p->{numar}<br>Anunturi: $p->{anunturi}<p>";
  # }
}

while (CGI::Fast->new) {
  my $op = param 'op' // '';
  append if $op eq 'append';
  info if $op eq 'info';
  view if $op eq 'view';
}

1;
__END__

=head1 NAME

zlp - Formular de înscriere la Ziua Libertății Programelor

=head1 AUTHOR

Marius Gavrilescu E<lt>marius@ieval.roE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2013 Fundația Ceata

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as published by
the Free Software Foundation, either version 3 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 Affero General Public License for more details.

You should have received a copy of the GNU Affero General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.


=cut