File Coverage

blib/lib/Glib/Ex/EnumBits.pm

Criterion	Covered	Total	%
statement	37	52	71.1
branch	6	18	33.3
condition	2	6	33.3
subroutine	9	10	90.0
pod	3	3	100.0
total	57	89	64.0

# Copyright 2010, 2011, 2012, 2014 Kevin Ryde

# This file is part of Glib-Ex-ObjectBits.
#
# Glib-Ex-ObjectBits is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Glib-Ex-ObjectBits 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 General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Glib-Ex-ObjectBits.  If not, see .

package Glib::Ex::EnumBits;
use 5.008;
use strict;
use warnings;
use Carp;

# uncomment this to run the ### lines
#use Smart::Comments;

use Exporter;
our @ISA = ('Exporter');
our @EXPORT_OK = qw(to_display
                    to_display_default
                    to_description);

our $VERSION = 16;

sub to_display {
  my ($enum_class, $nick) = @_;
  ### EnumBits to_display(): "$enum_class $nick"

  if (@_ != 2) {
    croak 'EnumBits to_display() wrong number of arguments';
  }
  if (my $coderef = $enum_class->can('EnumBits_to_display')) {
    ### $coderef
    if (defined (my $str = $enum_class->$coderef($nick))) {
      return $str;
    }
  }
  if (defined (my $str = do {
    no strict 'refs';
    ${"${enum_class}::EnumBits_to_display"}{$nick}
  })) {
    return $str;
  }
  return to_display_default ($enum_class, $nick);
}

sub to_display_default {
  my ($enum_class, $nick) = @_;
  ### EnumBits to_display_default(): $nick

  if (@_ != 2) {
    # it's easy to forget the $enum_class parameter, guard against that ...
    croak 'EnumBits to_display_default() wrong number of arguments';
  }

  if ($nick =~ /^([-_ ]+)$/) {
    # consists entirely of separators, eg "--"
    # preserve something non-empty
    $nick =~ s/^\s+//; # leading whitespace
    $nick =~ s/\s+$//; # trailing whitespace
    return $nick;
  }

  my $str = join (' ',
                  map {ucfirst}
                  split(/[-_ ]+
                       |(?<=[^[:upper:][:digit:]])(?=\d)     # before a digit
                       |(?<=\d)(?=\D)        # after a digit
                       |(?<=[[:lower:]])(?=[[:upper:]])
                       |(?<=[[:upper:]])(?=[[:upper:]][[:lower:]])
                        /x,
                        $nick));
  if (defined $enum_class
      && defined (my $textdomain = do {
        no strict 'refs';
        ${"${enum_class}::EnumBits_textdomain"}
      })
      && Locale::Messages->can('dgettext')) {
    $str = Locale::Messages::dgettext ($textdomain, $str);
  }
  return $str;
}

sub to_description {
  my ($enum_class, $nick) = @_;
  if (@_ < 2) {
    croak "Not enough arguments for EnumBits to_description()";
  }
  if (my $coderef = $enum_class->can('EnumBits_to_description')) {
    return $enum_class->$coderef($nick);
  }
  return undef;
}

1;
__END__