From 4a0d87e642c4d97ee2a026f1207e25a001518f3a Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem.moulin@fripost.org>
Date: Sat, 8 Sep 2012 19:49:11 +0200
Subject: Abstracting the LDAP stuff in an OO library.

---
 lib/Fripost/Schema/Misc.pm | 130 +++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 130 insertions(+)
 create mode 100644 lib/Fripost/Schema/Misc.pm

(limited to 'lib/Fripost/Schema/Misc.pm')

diff --git a/lib/Fripost/Schema/Misc.pm b/lib/Fripost/Schema/Misc.pm
new file mode 100644
index 0000000..be88385
--- /dev/null
+++ b/lib/Fripost/Schema/Misc.pm
@@ -0,0 +1,130 @@
+package Fripost::Schema::Misc;
+
+=head1 NAME
+
+Misc.pm -
+
+=cut
+
+use 5.010_000;
+use strict;
+use warnings;
+use utf8;
+
+use Exporter 'import';
+our @EXPORT_OK = qw /concat get_perms explode
+                     must_attrs email_valid/;
+use Email::Valid;
+
+
+# Let the first argument, if defined, intersperse the other arguments.
+sub concat {
+    my $concat = shift;
+
+    if (defined $concat) {
+        return join ($concat, @_);
+    }
+    else {
+        return [ @_ ];
+    }
+}
+
+# The reverse of 'concat': takes a single line, and split it along
+# "concat", if defined. Returns an array reference in any case.
+sub explode {
+    my $concat = shift;
+
+    my $out;
+    if (defined $concat) {
+        $out = [ split /$concat/, $_[0] ]; 
+    }
+    else {
+        $out = [ @_ ];
+    }
+    [ grep { !/^\s*$/ } @$out ];
+}
+
+
+# This subroutine displays the access that the given DN has on the entry.
+# Possible values are :
+# - '': no rights
+# - a:  can create aliases
+# - l:  can create lists
+# - al: can create aliases & lists
+# - o:  owner
+# - p:  postmaster
+sub get_perms {
+    my ($entry, $dn) = @_;
+    my $perms = '';
+
+    $perms .= 'a'
+        if grep { $dn eq $_  or  (split /,/,$dn,2)[1] eq $_ }
+                $entry->get_value ('fripostCanCreateAlias');
+
+    $perms .= 'l'
+        if grep { $dn eq $_  or  (split /,/,$dn,2)[1] eq $_ }
+                $entry->get_value ('fripostCanCreateList');
+
+    $perms = 'o'
+        if grep { $dn eq $_ } $entry->get_value('fripostOwner');
+
+    $perms = 'p'
+        if grep { $dn eq $_ } $entry->get_value('fripostPostmaster');
+
+    return $perms;
+}
+
+
+# "&must_att $h qw/a b c .../" ensures that attributes a b c... are all
+# defined in the hash reference.
+sub must_attrs {
+    my $h = shift;
+    foreach (@_) {
+        die '‘'.$_."‘: Missing attribute.\n"
+            unless defined $h->{$_} and
+                   (ref $h->{$_} eq 'ARRAY' ? @{$h->{$_}} : $h->{$_} ne '')
+    }
+}
+
+
+# Ensure that the first argument is a valid email. Can also be used to
+# check the validity of domains using the '-prefix' option.
+# '-exact' forces the input to be a bare email, ("name <email>" is not
+# allowed).
+sub email_valid {
+    my $in = shift;
+    my %options = @_;
+
+    my $i = $in;
+    $i =~ s/.*<([^>]+)>.*/$1/;
+    my $mesg = $options{'-error'} // "Invalid e-mail";
+    $in = $options{'-prefix'}.$in if defined $options{'-prefix'};
+
+    my $addr = Email::Valid::->address( -address => $in,
+                                        -tldcheck => 1,
+                                        -fqdn => 1 );
+    my $match = defined $addr;
+    $match &&= $addr eq $in  if $options{'-exact'};
+    die $mesg." ‘".$i."‘\n" unless $match;
+    return $addr;
+}
+
+
+=head1 AUTHOR
+
+Guilhem Moulin C<< <guilhem at fripost.org> >>
+
+=head1 COPYRIGHT
+
+Copyright 2012 Guilhem Moulin.
+
+=head1 LICENSE
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as perl itself.
+
+=cut
+
+1;
+
+__END__
-- 
cgit v1.2.3