# Copyright (c) 2010 bivio Software, Inc.  All Rights Reserved.
#
# Visit http://www.bivio.biz for more info.
# 
# This library is free software; you can redistribute it and/or modify
# it under the terms of the GNU Lesser General Public License as
# published by the Free Software Foundation; either version 2.1 of the
# License, or (at your option) any later version.
# 
# This library 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
# Lesser General Public License for more details.
# 
# You should have received a copy of the GNU Lesser General Public
# License along with this library;  If not, you may get a copy from:
# http://www.opensource.org/licenses/lgpl-license.html
# 
# $Id: SEOPrefix.pm,v 1.2 2010/04/27 23:57:09 nagler Exp $
package Bivio::Cache::SEOPrefix;
use strict;
use Bivio::Base 'Cache.RealmFileBase';

our($VERSION) = sprintf('%d.%02d', q$Revision: 1.2 $ =~ /\d+/g);
my($_C) = b_use('FacadeComponent.Constant');
my($_RSL) = b_use('Model.RealmSettingList');
my($_BASE) = 'SEOPrefix';
b_use('Biz.PropertyModel')->register_handler(__PACKAGE__);

sub FILE_PATH_REGEX {
    return qr{\Q@{[lc(b_use('Type.FilePath')->delete_suffix($_RSL->get_file_path($_BASE)))]}\E}is;
}

sub find_prefix_by_uri {
    my($proto, $uri, $req) = @_;
    my($map) = $proto->internal_retrieve($req);
    $uri = _clean($uri);
    while ($uri) {
	if (my $prefix = $map->{$uri}) {
	    return $prefix;
	}
	$uri =~ s{/[^/]*$}{};
    }
    return undef;
}

sub internal_compute {
    my($proto, $req) = @_;
    my($res) = $_RSL->new($req)
	->set_ephemeral
	->unauth_get_all_settings(
	    $proto->internal_realm_id($req),
	    $_BASE => [
		[qw(uri Text)],
		[qw(prefix Text)],
	    ],
	);
    return {map(
	(_clean($_->{uri}) => $_->{prefix}),
	values(%$res),
    )};
}

sub internal_realm_id {
    my($proto, $req) = @_;
    return ref($proto) ? $proto->get('realm_id')
	: $_C->get_value('site_realm_id', $req);
}

sub _clean {
    my($uri) = @_;
    $uri = join('/', split(m{/+}, lc($uri)));
    $uri =~ s{^(?=[^/])}{/};
    return $uri;
}

1;