# Copyright (c) 2005-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: ForumName.pm,v 1.9 2009/12/26 23:04:46 nagler Exp $ package Bivio::Type::ForumName; use strict; use Bivio::Base 'Type.Name'; our($VERSION) = sprintf('%d.%02d', q$Revision: 1.9 $ =~ /\d+/g); my($_SEP) = __PACKAGE__->use('Type.RealmName')->SPECIAL_SEPARATOR; sub FIRST_CHAR_REGEXP { return qr{[a-z]}; } sub SEP_CHAR_REGEXP { return qr{$_SEP}; } sub REGEXP { my($proto) = @_; my($c) = $proto->FIRST_CHAR_REGEXP; my($s) = $proto->SEP_CHAR_REGEXP; return qr/^($c\w{2,})(?:$s(\w+($s\w+)*)|)$/is; } sub extract_rest { my($proto, $value) = @_; return ($value =~ $proto->REGEXP)[1]; } sub extract_top { my($proto, $value) = @_; return ($value =~ $proto->REGEXP)[0]; } sub from_literal { my($proto, $value) = @_; $value =~ s/^\s+|\s+$//sg if defined($value); my($v, $e) = $proto->SUPER::from_literal($value); return ($v, $e) unless defined($v); return (undef, Bivio::TypeError->FORUM_NAME) unless $v =~ $proto->REGEXP; return lc($v); } sub get_min_width { return 3; } sub is_top { my($proto, $value) = @_; return $proto->extract_top($value) eq $value ? 1 : 0; } sub join { my($proto, @parts) = @_; return join($_SEP, @parts); } sub split { my($proto, $value) = @_; return split($_SEP, $value); } 1;