# Copyright (c) 2008 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: Regexp.pm,v 1.2 2008/10/27 21:40:31 dobbs Exp $
package Bivio::Type::Regexp;
use strict;
use Bivio::Base 'Bivio::Type';

our($VERSION) = sprintf('%d.%02d', q$Revision: 1.2 $ =~ /\d+/g);

sub from_literal {
    my($self, $value) = @_;
    return !defined($value) || !length($value) ? (undef, undef)
	: ref($value) eq 'Regexp' ? $value : _compile($value);
    return;
}

sub from_sql_column {
    return shift->from_literal_or_die(@_);
}

sub to_literal {
    my(undef, $value) = @_;
    return $value ? "$value" : '';
}

sub get_width {
    return 500;
}

sub quote_string {
    my(undef, $value) = @_;
    $value =~ s/(\W)/\\$1/sg;
    return $value;
}

sub to_sql_param {
    return shift->to_literal(@_);
}

sub to_string {
    return shift->to_literal(@_);
}

sub _compile {
    my($value) = @_;
    return (undef, Bivio::TypeError->PERMISSION_DENIED)
	if $value =~ /\(\?(?!\<\!|\<\=|\!|=|\w|\:|\#|\-)/;
    # Perl puts an extra (?-xism:) in front of all variables converted to
    # regular expressions.  This is problematic as the value would grow
    # every time from_sql_column is called.  This prevents this, but
    # depends on the fact that the unique leading value is (-xism:
    $value =~ s/^\(\?\-xism\:(.*)\)$/$1/si;
    return (undef, undef)
	unless length($value);
    my($res) = Bivio::Die->eval(sub {qr{$value}});
    return (undef, Bivio::TypeError->SYNTAX_ERROR)
	unless $res;
    return $res;
}

1;