Factorized split_addr.

2 files changed, 15 insertions, 9 deletions

diff --git a/lib/Fripost/Panel/Interface.pm b/lib/Fripost/Panel/Interface.pm
index 02f3f4b..18b9a48 100644
--- a/lib/Fripost/Panel/Interface.pm
+++ b/lib/Fripost/Panel/Interface.pm
@@ -14,6 +14,7 @@ Interface.pm -
 use parent 'Fripost::Panel::Login';
 
 use Fripost::Schema;
+use Fripost::Schema::Misc 'split_addr';
 use Fripost::Password;
 use HTML::Entities 'encode_entities';
 use URI::Escape::XS 'encodeURIComponent';
@@ -37,7 +38,7 @@ sub ListDomains : StartRunmode {
     my $self = shift;
     my %CFG = $self->cfg;
 
-    my ($ul,$ud) = split /\@/, email_to_unicode($self->authen->username), 2;
+    my ($ul,$ud) = split_addr( $self->authen->username, -encoding => 'unicode' );
 
     my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG );
     my @domains = $fp->domain->search( -concat => "\n", -die => 403);
@@ -61,7 +62,7 @@ sub ListLocals : Runmode {
     my $self = shift;
     my %CFG = $self->cfg;
 
-    my ($ul,$ud) = split /\@/, email_to_unicode($self->authen->username), 2;
+    my ($ul,$ud) = split_addr( $self->authen->username, -encoding => 'unicode' );
     my $d = ($self->split_path)[1];
     my $fp = Fripost::Schema::->SASLauth( $self->authen->username, %CFG );
 
@@ -155,7 +156,7 @@ sub EditDomain : Runmode {
     my $self = shift;
     my %CFG = $self->cfg;
 
-    my ($ul,$ud) = split /\@/, email_to_unicode($self->authen->username), 2;
+    my ($ul,$ud) = split_addr( $self->authen->username, -encoding => 'unicode' );
     my $d = ($self->split_path)[1];
 
     my $q = $self->query;
@@ -457,11 +458,13 @@ sub mkLink {
 
 sub userInfo {
     my $self = shift;
-    my ($l,$d) = split /\@/, email_to_unicode($self->authen->username), 2;
+    my ($l,$d) = split_addr( $self->authen->username, -encoding => 'unicode' );
+    my $root = $ENV{SCRIPT_NAME} // $self->cfg->{'cgi-bin'} // '';
+    $root =~ s@/$@@s;
 
     ( user_localpart => encode_entities($l)
     , user_domainpart => encode_entities($d)
-    , userURI => &mkURL ($ENV{SCRIPT_NAME}, $d, $l)
+    , userURI => &mkURL ($root, $d, $l)
     )
 }
 
@@ -479,7 +482,7 @@ Guilhem Moulin C<< <guilhem at fripost.org> >>
 
 =head1 COPYRIGHT
 
-Copyright 2012 Guilhem Moulin.
+Copyright 2012,2013 Guilhem Moulin.
 
 =head1 LICENSE
 
diff --git a/lib/Fripost/Panel/Login.pm b/lib/Fripost/Panel/Login.pm
index ccb4ca7..ef8474c 100644
--- a/lib/Fripost/Panel/Login.pm
+++ b/lib/Fripost/Panel/Login.pm
@@ -20,6 +20,7 @@ use CGI::Application::Plugin::Redirect;
 use CGI::Application::Plugin::ConfigAuto 'cfg';
 
 use Fripost::Schema;
+use Fripost::Schema::Misc 'split_addr';
 use HTML::Entities 'encode_entities';
 use URI::Escape::XS 'decodeURIComponent';
 use Net::IDN::Encode 'email_to_ascii';
@@ -56,7 +57,7 @@ sub cgiapp_init {
     $self->authen->config(
         DRIVER                => [ 'Generic', sub {
             my ($u,$p) = @_;
-            my $d = (split /\@/, $u, 2)[1];
+            my $d = (split_addr($u))[1];
 
             unless (defined $d) {
                 $CFG{default_realm} // return 0;
@@ -227,7 +228,9 @@ sub split_path {
     my $self = shift;
     my %options = @_;
 
-    my $script = $ENV{SCRIPT_NAME} // '';
+    my $script = $ENV{SCRIPT_NAME} // $self->cfg->{'cgi-bin'} // '';
+    $script =~ s@/$@@s;
+
     my $uri = $self->query->request_uri;
     $uri =~ s/^$script//s;
     $uri =~ s/\?.*//s;
@@ -243,7 +246,7 @@ Guilhem Moulin C<< <guilhem at fripost.org> >>
 
 =head1 COPYRIGHT
 
-Copyright 2012 Guilhem Moulin.
+Copyright 2012,2013 Guilhem Moulin.
 
 =head1 LICENSE