__PACKAGE__->mk_accessors(
qw(
_formatter
_is_first_line
_mode
_input
_output
_fortunes_list
_fortune
_this_line
)
);
our
$VERSION
=
'0.0107'
;
sub
new
{
my
$class
=
shift
;
my
$self
= {};
bless
$self
,
$class
;
$self
->_init(
@_
);
return
$self
;
}
sub
_init
{
my
$self
=
shift
;
my
$args
=
shift
;
$self
->_input(
$args
->{input});
$self
->_output(
$args
->{output});
$self
->_formatter(
Text::Format->new(
{
columns
=> 78,
firstIndent
=> 0,
leftMargin
=> 0,
}
)
);
$self
->_this_line(
""
);
return
0;
}
sub
_out
{
my
$self
=
shift
;
print
{
$self
->_output()}
@_
;
return
;
}
sub
run
{
my
$self
=
shift
;
my
$xml
= XML::LibXML->new->parse_file(
$self
->_input());
$self
->_fortunes_list(
scalar
(
$xml
->findnodes(
"//fortune"
)));
while
(
$self
->_fortune(
$self
->_fortunes_list->
shift
()))
{
my
(
$raw_node
) =
$self
->_fortune()->findnodes(
"raw|irc|screenplay|quote"
);
if
(
$raw_node
->localname() eq
"raw"
)
{
$self
->_process_raw_node(
$raw_node
);
}
elsif
(
$raw_node
->localname() eq
"irc"
)
{
$self
->_process_irc_node(
$raw_node
);
}
elsif
(
$raw_node
->localname() eq
"screenplay"
)
{
$self
->_process_screenplay_node(
$raw_node
);
}
elsif
(
$raw_node
->localname() eq
"quote"
)
{
$self
->_process_quote_node(
$raw_node
);
}
}
continue
{
if
(
$self
->_fortunes_list->size())
{
$self
->_out(
"%\n"
);
}
}
$self
->_fortunes_list(
undef
);
return
;
}
sub
_process_raw_node
{
my
(
$self
,
$raw_node
) =
@_
;
my
(
$text_node
) =
$raw_node
->findnodes(
"body/text"
);
my
@text_childs
=
$text_node
->childNodes();
if
(
@text_childs
!= 1)
{
Carp::confess(
'@cdata is not 1'
);
}
my
$cdata
=
$text_childs
[0];
if
(
$cdata
->nodeType() != XML_CDATA_SECTION_NODE())
{
Carp::confess(
"Not a cdata"
);
}
my
$value
=
$cdata
->nodeValue();
$value
=~ s{\n+\z}{}g;
$self
->_out(
"$value\n"
);
if
(() =
$self
->_fortune()->findnodes(
"descendant::info/*"
))
{
$self
->_render_info();
}
return
;
}
sub
_process_irc_node
{
my
(
$self
,
$irc_node
) =
@_
;
my
(
$body_node
) =
$irc_node
->findnodes(
"body"
);
my
@lines_list
=
$body_node
->findnodes(
"saying|me_is|joins|leaves"
);
my
$longest_nick_len
= 0;
my
@messages
;
foreach
my
$line
(
@lines_list
)
{
if
(
$line
->localname() eq
"saying"
)
{
my
$nick
=
$line
->getAttribute(
"who"
);
push
@messages
,
{
type
=>
"say"
,
nick
=>
$nick
,
msg
=>
$line
->textContent(),
};
$longest_nick_len
= max(
$longest_nick_len
,
length
(
$nick
));
}
elsif
(
$line
->localname() eq
"me_is"
)
{
my
$nick
=
$line
->getAttribute(
"who"
);
push
@messages
,
{
type
=>
"me_is"
,
nick
=>
$nick
,
msg
=>
$line
->textContent(),
};
$longest_nick_len
= max(
$longest_nick_len
,
length
(
"*"
));
}
elsif
(
$line
->localname() eq
"joins"
)
{
my
$nick
=
$line
->getAttribute(
"who"
);
push
@messages
,
{
type
=>
"joins"
,
nick
=>
$nick
,
msg
=>
$line
->textContent(),
};
$longest_nick_len
= max(
$longest_nick_len
,
length
(
"<--"
));
}
elsif
(
$line
->localname() eq
"leaves"
)
{
my
$nick
=
$line
->getAttribute(
"who"
);
push
@messages
,
{
type
=>
"leaves"
,
nick
=>
$nick
,
msg
=>
$line
->textContent(),
};
$longest_nick_len
= max(
$longest_nick_len
,
length
(
"-->"
));
}
else
{
Carp::confess(
'Unimplemented localname "'
.
$line
->localname() .
'"'
);
}
}
my
$formatter
=
Text::Format->new(
{
columns
=> 72-1-2-
$longest_nick_len
,
firstIndent
=> 0,
leftMargin
=> 0,
}
);
my
$line_starts_at
=
$longest_nick_len
+ 1
+ 1
+ 1
+ 2
;
my
$nick_len_with_delim
=
$longest_nick_len
+2;
foreach
my
$m
(
@messages
)
{
my
%cmds
= (
"me_is"
=>
"*"
,
"joins"
=>
"-->"
,
"leaves"
=>
"<--"
,);
if
(
$m
->{
'type'
} eq
"say"
)
{
my
@lines
= (
$formatter
->
format
([
$m
->{
'msg'
}]));
$self
->_out(
" "
.
sprintf
(
"%${nick_len_with_delim}s"
,
"<"
.
$m
->{
'nick'
} .
">"
) .
" "
.
$lines
[0]);
$self
->_out(
join
(
""
,
map
{ (
" "
x
$line_starts_at
) .
$_
}
@lines
[1..
$#lines
]
)
);
}
elsif
(
$m
->{
'type'
} eq
"raw"
)
{
$self
->_out(
$m
->{
'msg'
}.
"\n"
);
}
elsif
(
$m
->{
'type'
} eq
"change_nick"
)
{
$self
->_out((
" "
x (
$line_starts_at
)) .
$m
->{
'old'
} .
" is now known as "
.
$m
->{
'new'
} .
"\n"
);
}
elsif
(
exists
(
$cmds
{
$m
->{
'type'
}}))
{
my
@lines
=
$formatter
->
format
(
[
$m
->{
'nick'
} .
" "
.
$m
->{
'msg'
}]
);
$self
->_out(
" "
.
sprintf
(
"%${nick_len_with_delim}s"
,
$cmds
{
$m
->{
'type'
}}) .
" "
.
$lines
[0]);
$self
->_out(
join
(
""
,
map
{ (
" "
x
$line_starts_at
) .
$_
}
@lines
[1..
$#lines
]
)
);
}
}
if
(() =
$self
->_fortune()->findnodes(
"descendant::info/*"
))
{
$self
->_render_info();
}
return
;
}
sub
_render_screenplay_paras
{
my
(
$self
,
$portion
) =
@_
;
return
$self
->_render_portion_paras(
$portion
, {
para_is
=>
"para"
});
}
sub
_process_screenplay_node
{
my
(
$self
,
$play_node
) =
@_
;
my
(
$body_node
) =
$play_node
->findnodes(
"body"
);
my
$portions_list
=
$body_node
->findnodes(
"description|saying"
);
while
(
my
$portion
=
$portions_list
->
shift
())
{
if
(
$portion
->localname() eq
"description"
)
{
$self
->_this_line(
"["
);
$self
->_render_screenplay_paras(
$portion
);
$self
->_out(
"]\n"
);
}
else
{
$self
->_this_line(
$portion
->getAttribute(
"character"
) .
": "
);
$self
->_render_screenplay_paras(
$portion
);
$self
->_out(
"\n"
);
}
}
continue
{
if
(
$portions_list
->size())
{
$self
->_out(
"\n"
);
}
}
if
(() =
$self
->_fortune()->findnodes(
"descendant::info/*"
))
{
$self
->_render_info();
}
}
sub
_out_formatted_line
{
my
$self
=
shift
;
my
$text
=
$self
->_this_line();
$text
=~ s{\A\n+}{}ms;
$text
=~ s{\n+\z}{}ms;
$text
=~ s{\s+}{ }gms;
if
(
$self
->_is_first_line())
{
$self
->_is_first_line(0);
}
else
{
$self
->_out(
"\n"
);
}
my
$output_string
=
$self
->_formatter->
format
(
$text
);
chomp
(
$output_string
);
$self
->_out(
$output_string
);
$self
->_this_line(
""
);
return
;
}
sub
_append_to_this_line
{
my
(
$self
,
$more_text
) =
@_
;
$self
->_this_line(
$self
->_this_line() .
$more_text
);
}
sub
_render_portion_paras
{
my
(
$self
,
$portion
,
$args
) =
@_
;
my
$para_name
=
$args
->{para_is};
my
$paragraphs
=
$portion
->findnodes(
$para_name
);
while
(
my
$para
=
$paragraphs
->
shift
())
{
$self
->_is_first_line(1);
foreach
my
$node
(
$para
->childNodes())
{
if
(
$node
->nodeType() == XML_ELEMENT_NODE())
{
if
(
$node
->localname() eq
"br"
)
{
$self
->_out_formatted_line();
}
else
{
$self
->_append_to_this_line(
$node
->textContent());
}
}
elsif
(
$node
->nodeType() == XML_TEXT_NODE())
{
my
$node_text
=
$node
->textContent();
$node_text
=~ s{\A\n+}{}ms;
$node_text
=~ s{\n+\z}{}ms;
$node_text
=~ s{\s+}{ }gms;
$self
->_append_to_this_line(
$node_text
);
}
}
if
(
$self
->_this_line() =~ m{\S})
{
$self
->_out_formatted_line();
$self
->_this_line(
""
);
}
}
continue
{
if
(
$paragraphs
->size())
{
$self
->_out(
"\n\n"
);
}
}
}
sub
_process_quote_node
{
my
(
$self
,
$quote_node
) =
@_
;
my
(
$body_node
) =
$quote_node
->findnodes(
"body"
);
$self
->_render_portion_paras(
$body_node
, {
para_is
=>
"p"
});
$self
->_out(
"\n"
);
if
(() =
$self
->_fortune()->findnodes(
"descendant::info/*"
))
{
$self
->_render_info();
}
}
my
@info_fields_order
= (
qw(work author channel tagline)
);
my
%info_fields_order_map
=
(
map
{
$info_fields_order
[
$_
] =>
$_
+1 } (0 ..
$#info_fields_order
));
sub
_info_field_value
{
my
$self
=
shift
;
my
$field
=
shift
;
return
$info_fields_order_map
{
$field
->localname()} || (-1);
}
sub
_render_info
{
my
(
$self
) =
@_
;
my
$fortune
=
$self
->_fortune();
$self
->_out(
"\n"
);
my
(
$info
) =
$fortune
->findnodes(
"descendant::info"
);
my
@fields
=
$info
->findnodes(
"*"
);
foreach
my
$field_node
(
reverse
(
sort
{
$self
->_info_field_value(
$a
) <=>
$self
->_info_field_value(
$b
)
}
@fields
)
)
{
my
$name
=
$field_node
->localname();
if
(
$name
eq
"author"
)
{
$self
->_out((
" "
x 4) .
"-- "
.
$field_node
->textContent() .
"\n"
);
}
elsif
((
$name
eq
"work"
) || (
$name
eq
"tagline"
))
{
my
$url
=
""
;
if
(
$field_node
->hasAttribute(
"href"
))
{
$url
=
" ( "
.
$field_node
->getAttribute(
"href"
) .
" )"
;
}
$self
->_out(
(
" "
x 4) .
"-- "
.
$field_node
->textContent()
.
$url
.
"\n"
);
}
elsif
(
$name
eq
"channel"
)
{
my
$channel
=
$field_node
->textContent();
my
$network
=
$info
->findnodes(
"network"
)->
shift
()->textContent();
$self
->_out(
(
" "
x 4) .
"-- "
.
"$channel, $network"
.
"\n"
);
}
}
}
1;