X-Git-Url: http://git.ieval.ro/?p=gruntmaster-data.git;a=blobdiff_plain;f=lib%2FGruntmaster%2FData.pm;h=1b2492cc28c6a07dc927edf30d4039ec9fe1e1eb;hp=48de966aed29da3093ccc14d92e73ac97ea0b1e6;hb=014ee8a614839ded741f61979d979cdd4f20044c;hpb=bbf8209c979ab3d89e93e13117dd4b9f639dba9c

diff --git a/lib/Gruntmaster/Data.pm b/lib/Gruntmaster/Data.pm
index 48de966..1b2492c 100644
--- a/lib/Gruntmaster/Data.pm
+++ b/lib/Gruntmaster/Data.pm
@@ -1,85 +1,102 @@
 package Gruntmaster::Data;
-
-use 5.014002;
-use strict;
+use v5.14;
 use warnings;
-
-require Exporter;
-
-our @ISA = qw(Exporter);
-
-# Items to export into callers namespace by default. Note: do not export
-# names by default without a very good reason. Use EXPORT_OK instead.
-# Do not simply export all your public functions/methods/constants.
-
-# This allows declaration	use Gruntmaster::Data ':all';
-# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
-# will save memory.
-our %EXPORT_TAGS = ( 'all' => [ qw(
-	
-) ] );
-
-our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
-
-our @EXPORT = qw(
-	
-);
-
-our $VERSION = '5999.000_001';
-$VERSION = eval $VERSION;  # see L<perlmodstyle>
-
-
-# Preloaded methods go here.
-
-1;
-__END__
-# Below is stub documentation for your module. You'd better edit it!
-
-=head1 NAME
-
-Gruntmaster::Data - Perl extension for blah blah blah
-
-=head1 SYNOPSIS
-
-  use Gruntmaster::Data;
-  blah blah blah
-
-=head1 DESCRIPTION
-
-Stub documentation for Gruntmaster::Data, created by h2xs. It looks like the
-author of the extension was negligent enough to leave the stub
-unedited.
-
-Blah blah blah.
-
-=head2 EXPORT
-
-None by default.
-
-
-
-=head1 SEE ALSO
-
-Mention other useful documentation such as the documentation of
-related modules or operating system documentation (such as man pages
-in UNIX), or any relevant external documentation such as RFCs or
-standards.
-
-If you have a mailing list set up for your module, mention it here.
-
-If you have a web site set up for your module, mention it here.
-
-=head1 AUTHOR
-
-Marius Gavrilescu, E<lt>marius@E<gt>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2014 by Marius Gavrilescu
-
-This library is free software; you can redistribute it and/or modify
-it under the same terms as Perl itself, either Perl version 5.18.2 or,
-at your option, any later version of Perl 5 you may have available.
-
-
-=cut
+use parent qw/Exporter/;
+
+use JSON qw/encode_json decode_json/;
+
+use Redis;
+
+our $contest;
+my $redis = Redis->new;
+my $pubsub = Redis->new;
+
+sub dynsub{
+	no strict 'refs';
+	*{$_[0]} = $_[1];
+}
+
+BEGIN {
+	for my $cmd (qw/multi exec smembers get hget hdel hset sadd srem incr hmset hsetnx publish del/) {
+		dynsub uc $cmd, sub { $redis->$cmd(@_) };
+	}
+
+	for my $cmd (qw/subscribe wait_for_messages/) {
+		dynsub uc $cmd, sub { $pubsub->$cmd(@_) };
+	}
+}
+
+sub cp { defined $contest ? "contest.$contest." : '' }
+
+sub multi				()		{ MULTI }
+sub rexec				()		{ EXEC }
+
+sub problems			()		{ SMEMBERS cp . 'problem' }
+sub contests			()		{ SMEMBERS cp . 'contest' }
+sub users				()		{ SMEMBERS cp . 'user' }
+sub jobcard				()		{ GET cp . 'job' }
+
+sub job_results			(_)		{ decode_json HGET cp . "job.$_[0]", 'results' }
+sub set_job_results		($+)	{ HSET cp . "job.$_[0]", 'results', encode_json $_[1] }
+sub job_inmeta			(_)		{ decode_json HGET cp . "job.$_[0]", 'inmeta' }
+sub set_job_inmeta		($+)	{ HSET cp . "job.$_[0]", 'inmeta', encode_json $_[1] }
+sub problem_meta		(_)		{ decode_json HGET cp . "problem.$_[0]", 'meta' }
+sub set_problem_meta	($+)	{ HSET cp . "problem.$_[0]", 'meta', encode_json $_[1] }
+sub job_daemon			(_)		{ HGET cp . "job.$_[0]", 'daemon' }
+sub set_job_daemon		($$)	{ HSETNX cp . "job.$_[0]", 'daemon', $_[1] };
+
+sub defhash{
+	my ($name, @keys) = @_;
+	for my $key (@keys) {
+		dynsub "${name}_$key", sub (_)  { HGET cp . "$name.$_[0]", $key };
+		dynsub "set_${name}_$key", sub ($$) { HSET cp . "$name.$_[0]", $key, $_[1] };
+	}
+
+	dynsub "edit_$name", sub {
+		my ($key, %values) = @_;
+		HMSET cp . "$name.$key", %values;
+	};
+
+	dynsub "insert_$name", sub {
+		my ($key, %values) = @_;
+		SADD cp . $name, $key or return;
+		HMSET cp . "$name.$key", %values;
+	};
+	dynsub "remove_$name", sub (_) {
+		my $key = shift;
+		SREM cp . $name, $key;
+		DEL cp . "$name.$key";
+	};
+
+	dynsub "push_$name", sub {
+		my $nr = INCR cp . $name;
+		HMSET cp . "$name.$nr", @_;
+		$nr
+	};
+}
+
+defhash problem => qw/name level statement owner author/;
+defhash contest => qw/start end name owner/;
+defhash job => qw/date errors extension filesize private problem result result_text user/;
+defhash user => qw/name email town university level/;
+
+sub clean_job (_){
+	HDEL cp . "job.$_[0]", qw/result result_text results daemon/
+}
+
+sub mark_open {
+	my ($problem, $user) = @_;
+	HSETNX cp . 'open', "$problem.$user", time;
+}
+
+sub get_open {
+	my ($problem, $user) = @_;
+	HGET cp . 'open', "$problem.$user";
+}
+
+our @EXPORT = do {
+	no strict 'refs';
+	grep { $_ =~ /^[a-zA-Z]/ and exists &$_ } keys %{__PACKAGE__ . '::'};
+};
+
+1