From 1f35ed5ce38525af78508b46eea67a4f41c74a4a Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Fri, 18 Jan 2013 21:44:37 +0100 Subject: =?UTF-8?q?Fripost::Schema::Misc=20=E2=86=92=20Fripost::Schema::Ut?= =?UTF-8?q?il?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- lib/Fripost/Schema/Misc.pm | 172 --------------------------------------------- 1 file changed, 172 deletions(-) delete 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 deleted file mode 100644 index aec2618..0000000 --- a/lib/Fripost/Schema/Misc.pm +++ /dev/null @@ -1,172 +0,0 @@ -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 - canonical_dn ldap_explode_dn - split_addr/; -use Email::Valid; -use Net::IDN::Encode; -use Net::LDAP::Util; -use Encode; - - -# 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 @dn = @{ldap_explode_dn ($dn)}; - shift @dn; - my $dn2 = canonical_dn (@dn); - my $perms = ''; - - $perms .= 'a' - if grep { $dn eq $_ or $dn2 eq $_ } - $entry->get_value ('fripostCanCreateAlias'); - - $perms .= 'l' - if grep { $dn eq $_ or $dn2 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 " is not -# allowed). -sub email_valid { - my $in = shift; - my %options = @_; - - my $i = $in; - $i =~ s/^[^<>]+\s<([^>]+)>/$1/; - my $mesg = $options{'-error'} // "Invalid e-mail"; - $in = $options{'-prefix'}.$i if defined $options{'-prefix'}; - Encode::_utf8_on($in); - Encode::_utf8_on($i); - $in = Net::IDN::Encode::email_to_ascii($in); - - 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; - $addr =~ s/^$options{'-prefix'}// if defined $options{'-prefix'}; - return $addr; -} - -sub canonical_dn { - Net::LDAP::Util::canonical_dn(\@_, casefold => 'lower' - , mbcescape => 1 - , reverse => 0 - , separator => ','); -}; - -sub ldap_explode_dn { - Net::LDAP::Util::ldap_explode_dn( join (',', @_), casefold => 'lower' ) -} - -sub split_addr { - my $addr = shift; - my %options = @_; - - if (defined $options{'-encoding'}) { - if ($options{'-encoding'} eq 'ascii') { - $addr = Net::IDN::Encode::email_to_ascii($addr); - } - elsif ($options{'-encoding'} eq 'unicode') { - $addr = Net::IDN::Encode::email_to_unicode($addr); - } - else { - die "Unknown encoding: ". $options{'-encoding'}; - } - } - - split /\@/, $addr, 2; -} - - -=head1 AUTHOR - -Guilhem Moulin C<< >> - -=head1 COPYRIGHT - -Copyright 2012,2013 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