r46783 - in /trunk/libanyevent-irc-perl: ./ debian/ debian/patches/ lib/AnyEvent/ lib/AnyEvent/IRC/
angelabad-guest at users.alioth.debian.org
angelabad-guest at users.alioth.debian.org
Thu Nov 5 12:48:58 UTC 2009
Author: angelabad-guest
Date: Thu Nov 5 12:48:39 2009
New Revision: 46783
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=46783
Log:
New upstream 0.95
Added:
trunk/libanyevent-irc-perl/debian/README.source
trunk/libanyevent-irc-perl/debian/patches/
trunk/libanyevent-irc-perl/debian/patches/00_fix_pod2man
trunk/libanyevent-irc-perl/debian/patches/series
Modified:
trunk/libanyevent-irc-perl/Changes
trunk/libanyevent-irc-perl/META.yml
trunk/libanyevent-irc-perl/Makefile.PL
trunk/libanyevent-irc-perl/README
trunk/libanyevent-irc-perl/debian/changelog
trunk/libanyevent-irc-perl/debian/control
trunk/libanyevent-irc-perl/debian/copyright
trunk/libanyevent-irc-perl/debian/rules
trunk/libanyevent-irc-perl/lib/AnyEvent/IRC.pm
trunk/libanyevent-irc-perl/lib/AnyEvent/IRC/Client.pm
trunk/libanyevent-irc-perl/lib/AnyEvent/IRC/Connection.pm
trunk/libanyevent-irc-perl/lib/AnyEvent/IRC/Util.pm
Modified: trunk/libanyevent-irc-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libanyevent-irc-perl/Changes?rev=46783&op=diff
==============================================================================
--- trunk/libanyevent-irc-perl/Changes (original)
+++ trunk/libanyevent-irc-perl/Changes Thu Nov 5 12:48:39 2009
@@ -1,4 +1,11 @@
Revision history for AnyEvent::IRC
+
+0.95 Thu Nov 5 00:15:55 CET 2009
+ - added away_status method and events for tracking your away status.
+ - implemented send_long_message.
+ - added send_initial_whois option to ::Client constructor.
+ - added dependency to Encode.
+ - fixed a bug in ident handling, it now also detects nick changes.
0.9 Mon Sep 28 14:51:29 CEST 2009
- made AnyEvent::IRC::Client connection object reusable.
Modified: trunk/libanyevent-irc-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libanyevent-irc-perl/META.yml?rev=46783&op=diff
==============================================================================
--- trunk/libanyevent-irc-perl/META.yml (original)
+++ trunk/libanyevent-irc-perl/META.yml Thu Nov 5 12:48:39 2009
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: AnyEvent-IRC
-version: 0.9
+version: 0.95
abstract: An event system independend IRC protocol module
author:
- Robin Redeker <elmex at ta-sa.org>
@@ -13,6 +13,7 @@
requires:
AnyEvent: 5.111
common::sense: 0
+ Encode: 0
Object::Event: 0.6
Scalar::Util: 0
Test::More: 0
Modified: trunk/libanyevent-irc-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libanyevent-irc-perl/Makefile.PL?rev=46783&op=diff
==============================================================================
--- trunk/libanyevent-irc-perl/Makefile.PL (original)
+++ trunk/libanyevent-irc-perl/Makefile.PL Thu Nov 5 12:48:39 2009
@@ -15,6 +15,7 @@
'Object::Event' => '0.6',
'common::sense' => 0,
'Scalar::Util' => 0,
+ 'Encode' => 0,
},
dist => {
COMPRESS => 'gzip -9f',
Modified: trunk/libanyevent-irc-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libanyevent-irc-perl/README?rev=46783&op=diff
==============================================================================
--- trunk/libanyevent-irc-perl/README (original)
+++ trunk/libanyevent-irc-perl/README Thu Nov 5 12:48:39 2009
@@ -2,7 +2,7 @@
AnyEvent::IRC - An event system independend IRC protocol module
VERSION
- Version 0.9
+ Version 0.95
SYNOPSIS
Using the simplistic AnyEvent::IRC::Connection:
Added: trunk/libanyevent-irc-perl/debian/README.source
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libanyevent-irc-perl/debian/README.source?rev=46783&op=file
==============================================================================
--- trunk/libanyevent-irc-perl/debian/README.source (added)
+++ trunk/libanyevent-irc-perl/debian/README.source Thu Nov 5 12:48:39 2009
@@ -1,0 +1,58 @@
+This package uses quilt to manage all modifications to the upstream
+source. Changes are stored in the source package as diffs in
+debian/patches and applied during the build.
+
+To configure quilt to use debian/patches instead of patches, you want
+either to export QUILT_PATCHES=debian/patches in your environment
+or use this snippet in your ~/.quiltrc:
+
+ for where in ./ ../ ../../ ../../../ ../../../../ ../../../../../; do
+ if [ -e ${where}debian/rules -a -d ${where}debian/patches ]; then
+ export QUILT_PATCHES=debian/patches
+ break
+ fi
+ done
+
+To get the fully patched source after unpacking the source package, cd to
+the root level of the source package and run:
+
+ quilt push -a
+
+The last patch listed in debian/patches/series will become the current
+patch.
+
+To add a new set of changes, first run quilt push -a, and then run:
+
+ quilt new <patch>
+
+where <patch> is a descriptive name for the patch, used as the filename in
+debian/patches. Then, for every file that will be modified by this patch,
+run:
+
+ quilt add <file>
+
+before editing those files. You must tell quilt with quilt add what files
+will be part of the patch before making changes or quilt will not work
+properly. After editing the files, run:
+
+ quilt refresh
+
+to save the results as a patch.
+
+Alternately, if you already have an external patch and you just want to
+add it to the build system, run quilt push -a and then:
+
+ quilt import -P <patch> /path/to/patch
+ quilt push -a
+
+(add -p 0 to quilt import if needed). <patch> as above is the filename to
+use in debian/patches. The last quilt push -a will apply the patch to
+make sure it works properly.
+
+To remove an existing patch from the list of patches that will be applied,
+run:
+
+ quilt delete <patch>
+
+You may need to run quilt pop -a to unapply patches first before running
+this command.
Modified: trunk/libanyevent-irc-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libanyevent-irc-perl/debian/changelog?rev=46783&op=diff
==============================================================================
--- trunk/libanyevent-irc-perl/debian/changelog (original)
+++ trunk/libanyevent-irc-perl/debian/changelog Thu Nov 5 12:48:39 2009
@@ -1,3 +1,14 @@
+libanyevent-irc-perl (0.95-1) unstable; urgency=low
+
+ * New upstream release
+ * Depends on quilt (>= 0.46-7) and debhelper (>= 7.0.8)
+ * debian/rules: Add --with-quilt for quilt support
+ * debian/patches:
+ - Add 00_fix_pod2man: Fix pod2man errors in lib/AnyEvent/IRC/Util.pm
+ * Add README.source with quilt documentation
+
+ -- Angel Abad <angelabad at gmail.com> Thu, 05 Nov 2009 13:44:52 +0100
+
libanyevent-irc-perl (0.90-1) unstable; urgency=low
[ Jonathan Yu ]
Modified: trunk/libanyevent-irc-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libanyevent-irc-perl/debian/control?rev=46783&op=diff
==============================================================================
--- trunk/libanyevent-irc-perl/debian/control (original)
+++ trunk/libanyevent-irc-perl/debian/control Thu Nov 5 12:48:39 2009
@@ -1,12 +1,13 @@
Source: libanyevent-irc-perl
Section: perl
Priority: optional
-Build-Depends: debhelper (>= 7)
-Build-Depends-Indep: perl, libanyevent-perl, libobject-event-perl,
- libcommon-sense-perl
+Build-Depends: debhelper (>= 7.0.8), quilt (>= 0.46-7)
+Build-Depends-Indep: libanyevent-perl, libcommon-sense-perl,
+ libobject-event-perl, perl
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
Uploaders: Maximilian Gass <mxey at cloudconnected.org>,
- Jonathan Yu <jawnsy at cpan.org>
+ Jonathan Yu <jawnsy at cpan.org>,
+ Angel Abad <angelabad at gmail.com>
Standards-Version: 3.8.3
Homepage: http://search.cpan.org/dist/AnyEvent-IRC/
Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libanyevent-irc-perl/
@@ -14,8 +15,8 @@
Package: libanyevent-irc-perl
Architecture: all
-Depends: ${perl:Depends}, ${misc:Depends}, libobject-event-perl,
- libanyevent-perl, libcommon-sense-perl
+Depends: ${misc:Depends}, ${perl:Depends}, libanyevent-perl,
+ libcommon-sense-perl, libobject-event-perl
Description: Perl module for handling IRC connections
AnyEvent::IRC is a Perl module that can be conceptualized as a toolbox for
handling Internet Relay Chat (IRC) connections and communications. It won't
Modified: trunk/libanyevent-irc-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libanyevent-irc-perl/debian/copyright?rev=46783&op=diff
==============================================================================
--- trunk/libanyevent-irc-perl/debian/copyright (original)
+++ trunk/libanyevent-irc-perl/debian/copyright Thu Nov 5 12:48:39 2009
@@ -10,7 +10,8 @@
License: Artistic | GPL-1+
Files: debian/*
-Copyright: 2009, Jonathan Yu <jawnsy at cpan.org>
+Copyright: 2009, Angel Abad <angelabad at gmail.com>
+ 2009, Jonathan Yu <jawnsy at cpan.org>
2009, Maximilian Gass <mxey at cloudconnected.org>
License: Artistic | GPL-1+
Added: trunk/libanyevent-irc-perl/debian/patches/00_fix_pod2man
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libanyevent-irc-perl/debian/patches/00_fix_pod2man?rev=46783&op=file
==============================================================================
--- trunk/libanyevent-irc-perl/debian/patches/00_fix_pod2man (added)
+++ trunk/libanyevent-irc-perl/debian/patches/00_fix_pod2man Thu Nov 5 12:48:39 2009
@@ -1,0 +1,20 @@
+--- libanyevent-irc-perl-0.95.orig/lib/AnyEvent/IRC/Util.pm
++++ libanyevent-irc-perl-0.95/lib/AnyEvent/IRC/Util.pm
+@@ -502,6 +502,8 @@
+ return $RFC_NUMCODE_MAP{$code} || $code;
+ }
+
++=over
++
+ =item my (@lines) = split_unicode_string ($encoding, $string, $maxlinebytes)
+
+ This function splits up C<$string> into multiple C<@lines> which are
+@@ -535,6 +537,8 @@
+ @lines
+ }
+
++=back
++
+ =head1 AUTHOR
+
+ Robin Redeker, C<< <elmex at ta-sa.org> >>
Added: trunk/libanyevent-irc-perl/debian/patches/series
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libanyevent-irc-perl/debian/patches/series?rev=46783&op=file
==============================================================================
--- trunk/libanyevent-irc-perl/debian/patches/series (added)
+++ trunk/libanyevent-irc-perl/debian/patches/series Thu Nov 5 12:48:39 2009
@@ -1,0 +1,1 @@
+00_fix_pod2man
Modified: trunk/libanyevent-irc-perl/debian/rules
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libanyevent-irc-perl/debian/rules?rev=46783&op=diff
==============================================================================
--- trunk/libanyevent-irc-perl/debian/rules (original)
+++ trunk/libanyevent-irc-perl/debian/rules Thu Nov 5 12:48:39 2009
@@ -1,4 +1,4 @@
#!/usr/bin/make -f
%:
- dh $@
+ dh $@ --with quilt
Modified: trunk/libanyevent-irc-perl/lib/AnyEvent/IRC.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libanyevent-irc-perl/lib/AnyEvent/IRC.pm?rev=46783&op=diff
==============================================================================
--- trunk/libanyevent-irc-perl/lib/AnyEvent/IRC.pm (original)
+++ trunk/libanyevent-irc-perl/lib/AnyEvent/IRC.pm Thu Nov 5 12:48:39 2009
@@ -8,11 +8,11 @@
=head1 VERSION
-Version 0.9
+Version 0.95
=cut
-our $VERSION = '0.9';
+our $VERSION = '0.95';
=head1 SYNOPSIS
Modified: trunk/libanyevent-irc-perl/lib/AnyEvent/IRC/Client.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libanyevent-irc-perl/lib/AnyEvent/IRC/Client.pm?rev=46783&op=diff
==============================================================================
--- trunk/libanyevent-irc-perl/lib/AnyEvent/IRC/Client.pm (original)
+++ trunk/libanyevent-irc-perl/lib/AnyEvent/IRC/Client.pm Thu Nov 5 12:48:39 2009
@@ -3,11 +3,13 @@
use Scalar::Util qw/weaken/;
+use Encode;
use AnyEvent::Socket;
use AnyEvent::Handle;
use AnyEvent::IRC::Util
qw/prefix_nick decode_ctcp split_prefix
- is_nick_prefix join_prefix encode_ctcp/;
+ is_nick_prefix join_prefix encode_ctcp
+ split_unicode_string mk_msg/;
use base AnyEvent::IRC::Connection::;
@@ -170,6 +172,20 @@
Emitted when C<$old_nick> is renamed to C<$new_nick>.
C<$is_myself> is true when yourself was the one who changed the nick.
+=item away_status_change => $bool
+
+Emitted whenever a presence/away status change for you was detected.
+C<$bool> is true if you are now away, or false/undef if you are not
+away anymore.
+
+You can change your away status by emitting the C<AWAY> IRC command:
+
+ $cl->send_srv (AWAY => "I'm not here right now");
+
+Or reset it:
+
+ $cl->send_srv ('AWAY');
+
=item ctcp => $src, $target, $tag, $msg, $type
Emitted when a CTCP message was found in either a NOTICE or PRIVMSG
@@ -292,12 +308,29 @@
=over 4
-=item $cl = AnyEvent::IRC::Client->new ()
-
-This constructor takes no arguments.
+=item $cl = AnyEvent::IRC::Client->new (%args)
+
+This is the constructor of a L<AnyEvent::IRC::Client> object,
+which stands logically for a client connected to ONE IRC server.
+You can reuse it and call C<connect> once it disconnected.
B<NOTE:> You are free to use the hash member C<heap> to store any associated
data with this object. For example retry timers or anything else.
+
+C<%args> may contain these options:
+
+=over 4
+
+=item send_initial_whois => $bool
+
+If this option is enabled an initial C<WHOIS> command is sent to your own
+NICKNAME to determine your own I<ident>. See also the method C<nick_ident>.
+This is necessary to ensure that the information about your own nickname
+is available as early as possible for the C<send_long_message> method.
+
+C<$bool> is C<false> by default.
+
+=back
=cut
@@ -325,6 +358,8 @@
$self->reg_cb (irc_366 => \&endofnames_cb);
$self->reg_cb (irc_352 => \&whoreply_cb);
$self->reg_cb (irc_311 => \&whoisuser_cb);
+ $self->reg_cb (irc_305 => \&away_change_cb);
+ $self->reg_cb (irc_306 => \&away_change_cb);
$self->reg_cb (irc_ping => \&ping_cb);
$self->reg_cb (irc_pong => \&pong_cb);
@@ -343,6 +378,8 @@
$self->reg_cb (ctcp => \&ctcp_auto_reply_cb);
$self->reg_cb (registered => \®istered_cb);
+
+ $self->reg_cb (nick_change => \&update_ident_nick_change_cb);
$self->{def_nick_change} = $self->{nick_change} =
sub {
@@ -373,6 +410,7 @@
irc_433 => \&change_nick_login_cb,
);
+ delete $self->{away_status};
delete $self->{dcc};
delete $self->{dcc_id};
delete $self->{_tmp_namereply};
@@ -658,6 +696,88 @@
$self->{chan_queue}->{$self->lower_case ($chan)} = [];
}
+=item my (@lines) = $cl->send_long_message ($encoding, $overhead, $cmd, @params, $msg)
+
+As IRC only allows 512 byte blocks of messages and sometimes
+your messages might get longer, you have a problem. This method
+will solve your problem:
+
+This method can be used to split up long messages into multiple
+commands.
+
+C<$cmd> and C<@params> are the IRC command and it's first parameters,
+except the last one: the C<$msg>. C<$msg> can be a Unicode string,
+which will be encoded in C<$encoding> before sending.
+
+If you want to send a CTCP message you can encode it in the C<$cmd> by
+appending the CTCP command with a C<"\001">. For example if you want to
+send a CTCP ACTION you have to give this C<$cmd>:
+
+ $cl->send_long_message (undef, 0, "PRIVMSG\001ACTION", "#test", "rofls");
+
+C<$encoding> can be undef if you don't need any recoding of C<$msg>.
+But in case you want to send Unicode it is necessary to determine where
+to split a message exactly, to not break the encoding.
+
+Please also note that the C<nick_ident> for your own nick is necessary to
+compute this. To ensure best performance as possible use the
+C<send_initial_whois> option if you want to use this method.
+
+But note that this method might not work 100% correct and you might still get
+at least partially chopped off lines if you use C<send_long_message> before the
+C<WHOIS> reply to C<send_initial_whois> arrived.
+
+To be on the safest side you might want to wait until that initial C<WHOIS>
+reply arrived.
+
+The return value of this method is the list of the actually sent lines (but
+without encoding applied).
+
+=cut
+
+sub send_long_message {
+ my ($self, $encoding, $overhead, $cmd, @params) = @_;
+ my $msg = pop @params;
+
+ my $ctcp;
+ ($cmd, $ctcp) = split /\001/, $cmd;
+
+ my $id = $self->nick_ident ($self->nick);
+ if ($id eq '') {
+ $id = "X" x 60; # just in case the ident is not available...
+ }
+
+ my $init_len = length mk_msg ($id, $cmd, @params, " "); # i know off by 1
+
+ if ($ctcp ne '') {
+ $init_len += length ($ctcp) + 3; # CTCP cmd + " " + "\001" x 2
+ }
+
+ my $max_len = 500; # give 10 bytes extra margin
+
+ my $line_len = $max_len - $init_len;
+
+ # split up the multiple lines in the message:
+ my @lines = split /\n/, $msg;
+
+ # splitup long lines into multiple ones:
+ @lines =
+ map split_unicode_string ($encoding, $_, $line_len), @lines;
+
+ # send lines line-by-line:
+ for my $line (@lines) {
+ my $smsg = encode ($encoding, $line);
+
+ if ($ctcp ne '') {
+ $smsg = encode_ctcp ([$ctcp, $smsg])
+ }
+
+ $self->send_srv ($cmd => @params, $smsg);
+ }
+
+ @lines
+}
+
=item $cl->enable_ping ($interval, $cb)
This method enables a periodical ping to the server with an interval of
@@ -840,6 +960,9 @@
This method returns the whole ident of the C<$nick> if the informations is available.
If the nick's ident hasn't been seen yet, undef is returned.
+B<NOTE:> If you want to rely on the C<nick_ident> of your own nick you should
+make sure to enable the C<send_initial_whois> option in the constructor.
+
=cut
sub nick_ident {
@@ -847,7 +970,16 @@
$self->{idents}->{$self->lower_case ($nick)}
}
+=item my $bool = $cl->away_status
+
+Returns a true value if you are away or undef if you are not away.
+
+=cut
+
+sub away_status { $_[0]->{away_status} }
+
=item $cl->ctcp_auto_reply ($ctcp_command, @msg)
+
=item $cl->ctcp_auto_reply ($ctcp_command, $coderef)
This method installs an auto-reply for the reception of the C<$ctcp_command>
@@ -1266,6 +1398,9 @@
sub registered_cb {
my ($self, $msg) = @_;
+ $self->send_srv (WHOIS => $self->nick)
+ if $self->{send_initial_whois};
+
for (@{$self->{con_queue}}) {
$self->send_msg (@$_);
}
@@ -1347,11 +1482,11 @@
}
}
+ $self->event (nick_change => $nick, $newnick, $wasme);
+
for (@chans) {
$self->event (channel_change => $_, $nick, $newnick, $wasme);
}
-
- $self->event (nick_change => $nick, $newnick, $wasme);
}
sub namereply_cb {
@@ -1407,7 +1542,7 @@
my $chan = $msg->{params}->[0];
my $nick = prefix_nick ($msg);
- $self->event (part => $nick, $chan, $self->_was_me ($msg), $msg->{params}->[1]);
+ $self->event (part => $nick, $chan, $self->_was_me ($msg), $msg->{params}->[1]);
$self->channel_remove ($msg, $chan, [$nick]);
$self->event (channel_remove => $msg, $chan, $nick);
}
@@ -1453,6 +1588,18 @@
}
}
+sub away_change_cb {
+ my ($self, $msg) = @_;
+
+ if ($msg->{command} eq '305') { # no longer away
+ delete $self->{away_status};
+ } else { # away
+ $self->{away_status} = 1;
+ }
+
+ $self->event (away_status_change => $self->{away_status});
+}
+
sub debug_cb {
my ($self, $msg) = @_;
$self->event (debug_recv => $msg);
@@ -1513,6 +1660,17 @@
}
}
+sub update_ident_nick_change_cb {
+ my ($self, $old, $new) = @_;
+
+ my $oldid = $self->nick_ident ($old);
+ return unless defined $oldid;
+
+ my ($n, $u, $h) = split_prefix ($oldid);
+
+ $self->update_ident (join_prefix ($new, $u, $h));
+}
+
sub ctcp_auto_reply_cb {
my ($self, $src, $targ, $tag, $msg, $type) = @_;
Modified: trunk/libanyevent-irc-perl/lib/AnyEvent/IRC/Connection.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libanyevent-irc-perl/lib/AnyEvent/IRC/Connection.pm?rev=46783&op=diff
==============================================================================
--- trunk/libanyevent-irc-perl/lib/AnyEvent/IRC/Connection.pm (original)
+++ trunk/libanyevent-irc-perl/lib/AnyEvent/IRC/Connection.pm Thu Nov 5 12:48:39 2009
@@ -223,7 +223,12 @@
sub _feed_irc_data {
my ($self, $line) = @_;
+ #d# warn "LINE:[" . $line . "][".length ($line)."]";
+
my $m = parse_irc_msg ($line);
+ #d# warn "MESSAGE{$m->{params}->[-1]}[".(length $m->{params}->[-1])."]\n";
+ #d# warn "HEX:" . join ('', map { sprintf "%2.2x", ord ($_) } split //, $line)
+ #d# . "\n";
$self->event (read => $m);
$self->event ('irc_*' => $m);
Modified: trunk/libanyevent-irc-perl/lib/AnyEvent/IRC/Util.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libanyevent-irc-perl/lib/AnyEvent/IRC/Util.pm?rev=46783&op=diff
==============================================================================
--- trunk/libanyevent-irc-perl/lib/AnyEvent/IRC/Util.pm (original)
+++ trunk/libanyevent-irc-perl/lib/AnyEvent/IRC/Util.pm Thu Nov 5 12:48:39 2009
@@ -1,11 +1,13 @@
package AnyEvent::IRC::Util;
use common::sense;
use Exporter;
+use Encode;
our @ISA = qw/Exporter/;
our @EXPORT_OK =
qw(mk_msg parse_irc_msg split_prefix prefix_nick
decode_ctcp encode_ctcp filter_ctcp_text_attr prefix_user prefix_host
- rfc_code_to_name filter_colors is_nick_prefix join_prefix);
+ rfc_code_to_name filter_colors is_nick_prefix join_prefix
+ split_unicode_string);
=head1 NAME
@@ -188,6 +190,13 @@
}
$line =~ s/\001[^\001]*\001//g;
+
+ # try to parse broken ctcp messages anyway
+ if ($line =~ s/\001([^\001]*)$//) {
+ my $msg = unescape_ctcp ($1);
+ my ($tag, $data) = split / /, $msg, 2;
+ push @ctcp, [$tag, $data];
+ }
return ($line, \@ctcp)
}
@@ -493,6 +502,39 @@
return $RFC_NUMCODE_MAP{$code} || $code;
}
+=item my (@lines) = split_unicode_string ($encoding, $string, $maxlinebytes)
+
+This function splits up C<$string> into multiple C<@lines> which are
+not longer than C<$maxlinebytes> bytes. Encoding can be given in C<$encoding>.
+(eg. 'utf-8'). But the output will not be encoded.
+
+This function takes care that your characters are not garbled.
+
+=cut
+
+sub split_unicode_string {
+ my ($enc, $str, $maxlen) = @_;
+
+ return $str unless length (encode ($enc, $str)) > $maxlen;
+
+ my $cur_out = '';
+ my @lines;
+
+ while (length ($str) > 0) {
+
+ while (length (encode ($enc, $cur_out)) <= $maxlen
+ && length ($str) > 0) {
+
+ $cur_out .= substr $str, 0, 1, '';
+ }
+
+ push @lines, $cur_out;
+ $cur_out = '';
+ }
+
+ @lines
+}
+
=head1 AUTHOR
Robin Redeker, C<< <elmex at ta-sa.org> >>
More information about the Pkg-perl-cvs-commits
mailing list