$Vote::Count::TextTableTiny::VERSION
=
'2.01'
;
use
5.024;
our
@EXPORT_OK
=
qw/ generate_table /
;
our
$COLUMN_SEPARATOR
=
'|'
;
our
$ROW_SEPARATOR
=
'-'
;
our
$CORNER_MARKER
=
'+'
;
our
$HEADER_ROW_SEPARATOR
=
'='
;
our
$HEADER_CORNER_MARKER
=
'O'
;
my
%arguments
= (
rows
=>
"the rows, including a possible header row, of the table"
,
header_row
=>
"if true, indicates that the first row is a header row"
,
separate_rows
=>
"if true, a separate rule will be drawn between each row"
,
top_and_tail
=>
"if true, miss out top and bottom edges of table"
,
align
=>
"either single alignment, or an array per of alignments per col"
,
style
=>
"styling of table, one of classic, boxrule, or norule"
,
indent
=>
"indent every row of the table a certain number of spaces"
,
compact
=>
"narrow columns (no space either side of content)"
,
);
my
%charsets
= (
classic
=> {
TLC
=>
'+'
,
TT
=>
'+'
,
TRC
=>
'+'
,
HR
=>
'-'
,
VR
=>
'|'
,
FHR
=>
'='
,
LT
=>
'+'
,
RT
=>
'+'
,
FLT
=>
'O'
,
FRT
=>
'O'
,
HC
=>
'+'
,
FHC
=>
'O'
,
BLC
=>
'+'
,
BT
=>
'+'
,
BRC
=>
'+'
},
boxrule
=> {
TLC
=>
'┌'
,
TT
=>
'┬'
,
TRC
=>
'┐'
,
HR
=>
'─'
,
VR
=>
'│'
,
FHR
=>
'═'
,
LT
=>
'├'
,
RT
=>
'┤'
,
FLT
=>
'╞'
,
FRT
=>
'╡'
,
HC
=>
'┼'
,
FHC
=>
'╪'
,
BLC
=>
'└'
,
BT
=>
'┴'
,
BRC
=>
'┘'
},
norule
=> {
TLC
=>
' '
,
TT
=>
' '
,
TRC
=>
' '
,
HR
=>
' '
,
VR
=>
' '
,
FHR
=>
' '
,
LT
=>
' '
,
RT
=>
' '
,
FLT
=>
' '
,
FRT
=>
' '
,
HC
=>
' '
,
FHC
=>
' '
,
BLC
=>
' '
,
BT
=>
' '
,
BRC
=>
' '
},
markdown
=> {
TLC
=>
'|'
,
TT
=>
' '
,
TRC
=>
'|'
,
HR
=>
'-'
,
VR
=>
'|'
,
FHR
=>
' '
,
LT
=>
'|'
,
RT
=>
'|'
,
FLT
=>
' '
,
FRT
=>
' '
,
HC
=>
'|'
,
FHC
=>
' '
,
BLC
=>
'|'
,
BT
=>
' '
,
BRC
=>
'|'
,
},
);
sub
generate_table
{
my
%param
=
@_
;
foreach
my
$arg
(
keys
%param
) {
croak
"unknown argument '$arg'"
if
not
exists
$arguments
{
$arg
};
}
my
$rows
=
$param
{rows} or croak
"you must pass the 'rows' argument!"
;
my
@rows
=
@$rows
;
my
@widths
= _calculate_widths(
$rows
);
$param
{style} //=
'classic'
;
$param
{indent} //=
''
;
$param
{indent} =
' '
x
$param
{indent}
if
$param
{indent} =~ /^[0-9]+$/;
my
$style
=
$param
{style};
croak
"unknown style '$style'"
if
not
exists
(
$charsets
{
$style
});
my
$char
=
$charsets
{
$style
};
if
(
$style
eq
'classic'
) {
$char
->{TLC} =
$char
->{TRC} =
$char
->{TT} =
$char
->{LT} =
$char
->{RT} =
$char
->{HC} =
$char
->{BLC} =
$char
->{BT} =
$char
->{BRC} =
$CORNER_MARKER
;
$char
->{HR} =
$ROW_SEPARATOR
;
$char
->{VR} =
$COLUMN_SEPARATOR
;
$char
->{FLT} =
$char
->{FRT} =
$char
->{FHC} =
$HEADER_CORNER_MARKER
;
$char
->{FHR} =
$HEADER_ROW_SEPARATOR
;
}
elsif
(
$style
eq
'markdown'
) {
_md_validate_data(
$rows
);
$param
{
'header_row'
} = 1;
$param
{
'top_and_tail'
} = 1;
$param
{
'separate_rows'
} = 0;
$param
{
'indent'
} =
''
;
}
my
$header
;
my
@align
;
if
(
defined
$param
{align}) {
@align
= is_arrayref(
$param
{align})
? @{
$param
{align} }
: (
$param
{align}) x
int
(
@widths
)
;
}
else
{
@align
= (
'l'
) x
int
(
@widths
);
}
$header
=
shift
@rows
if
$param
{header_row};
my
$table
= _top_border(\
%param
, \
@widths
,
$char
)
._header_row(\
%param
,
$header
, \
@widths
, \
@align
,
$char
)
._header_rule(\
%param
, \
@widths
,
$char
, \
@align
)
._body(\
%param
, \
@rows
, \
@widths
, \
@align
,
$char
)
._bottom_border(\
%param
, \
@widths
,
$char
);
chop
(
$table
);
return
$table
;
}
sub
_top_border
{
my
(
$param
,
$widths
,
$char
) =
@_
;
return
''
if
$param
->{top_and_tail};
return
_rule_row(
$param
,
$widths
,
$char
->{TLC},
$char
->{HR},
$char
->{TT},
$char
->{TRC});
}
sub
_bottom_border
{
my
(
$param
,
$widths
,
$char
) =
@_
;
return
''
if
$param
->{top_and_tail};
return
_rule_row(
$param
,
$widths
,
$char
->{BLC},
$char
->{HR},
$char
->{BT},
$char
->{BRC});
}
sub
_rule_row
{
my
(
$param
,
$widths
,
$le
,
$hr
,
$cross
,
$re
) =
@_
;
my
$pad
=
$param
->{compact} ?
''
:
$hr
;
return
$param
->{indent}
.
$le
.
join
(
$cross
,
map
{
$pad
.(
$hr
x
$_
).
$pad
}
@$widths
)
.
$re
.
"\n"
;
}
sub
_header_row
{
my
(
$param
,
$row
,
$widths
,
$align
,
$char
) =
@_
;
return
''
unless
$param
->{header_row};
return
_text_row(
$param
,
$row
,
$widths
,
$align
,
$char
);
}
sub
_md_validate_data {
my
$rows
=
shift
@_
;
for
my
$row
( @{
$rows
}) {
if
(
"@{$row}"
=~ m/[^\\]\|/ ){
die
"Unescaped | will produce invalid Markdown!\n@{$row}"
;
}
}
}
sub
_md_header_rule {
my
(
$param
,
$widthref
,
$alignref
) =
@_
;
my
$coladj
=
$param
->{
'compact'
} ? -2 : 0;
my
@align
= @{
$alignref
};
my
@width
= @{
$widthref
};
my
$rule
=
'|'
;
while
(
@width
) {
my
$colwidth
=
$coladj
+
shift
(
@width
);
my
$colalign
=
shift
(
@align
);
my
$DASHES
=
'-'
x (
$colwidth
) ;
$rule
.=
":$DASHES-|"
if
(
$colalign
eq
'l'
) ;
$rule
.=
"-$DASHES:|"
if
(
$colalign
eq
'r'
) ;
$rule
.=
":$DASHES:|"
if
(
$colalign
eq
'c'
) ;
}
return
"$rule\n"
;
}
sub
_header_rule
{
my
(
$param
,
$widths
,
$char
,
$align
) =
@_
;
if
(
$param
->{
'style'
} eq
'markdown'
) {
return
_md_header_rule(
$param
,
$widths
,
$align
)
if
$param
->{
'align'
};
}
return
''
unless
$param
->{header_row};
my
$fancy
=
$param
->{separate_rows} ?
'F'
:
''
;
return
_rule_row(
$param
,
$widths
,
$char
->{
"${fancy}LT"
},
$char
->{
"${fancy}HR"
},
$char
->{
"${fancy}HC"
},
$char
->{
"${fancy}RT"
});
}
sub
_body
{
my
(
$param
,
$rows
,
$widths
,
$align
,
$char
) =
@_
;
my
$divider
=
$param
->{separate_rows} ? _rule_row(
$param
,
$widths
,
$char
->{LT},
$char
->{HR},
$char
->{HC},
$char
->{RT}) :
''
;
return
join
(
$divider
,
map
{ _text_row(
$param
,
$_
,
$widths
,
$align
,
$char
) }
@$rows
);
}
sub
_text_row
{
my
(
$param
,
$row
,
$widths
,
$align
,
$char
) =
@_
;
my
@columns
=
@$row
;
my
$text
=
$param
->{indent}.
$char
->{VR};
for
(
my
$i
= 0;
$i
<
@$widths
;
$i
++) {
$text
.= _format_column(
$columns
[
$i
] //
''
,
$widths
->[
$i
],
$align
->[
$i
] //
'l'
,
$param
,
$char
);
$text
.=
$char
->{VR};
}
$text
.=
"\n"
;
return
$text
;
}
sub
_format_column
{
my
(
$text
,
$width
,
$align
,
$param
,
$char
) =
@_
;
my
$pad
=
$param
->{compact} ?
''
:
' '
;
if
(
$align
eq
'r'
||
$align
eq
'right'
) {
return
$pad
.
' '
x (
$width
- tty_width(
$text
)).
$text
.
$pad
;
}
elsif
(
$align
eq
'c'
||
$align
eq
'center'
||
$align
eq
'centre'
) {
my
$total_spaces
=
$width
- tty_width(
$text
);
my
$left_spaces
=
int
(
$total_spaces
/ 2);
my
$right_spaces
=
$left_spaces
;
$right_spaces
++
if
$total_spaces
% 2 == 1;
return
$pad
.(
' '
x
$left_spaces
).
$text
.(
' '
x
$right_spaces
).
$pad
;
}
else
{
return
$pad
.
$text
.
' '
x (
$width
- tty_width(
$text
)).
$pad
;
}
}
sub
_calculate_widths
{
my
$rows
=
shift
;
my
@widths
;
foreach
my
$row
(
@$rows
) {
my
@columns
=
@$row
;
for
(
my
$i
= 0;
$i
<
@columns
;
$i
++) {
next
unless
defined
(
$columns
[
$i
]);
my
$width
= tty_width(
$columns
[
$i
]);
$widths
[
$i
] =
$width
if
!
defined
(
$widths
[
$i
])
||
$width
>
$widths
[
$i
];
}
}
return
@widths
;
}
*table
= \
&generate_table
;
1;
Hide Show 32 lines of Pod
Hide Show 24 lines of Pod