Using Perl module AnyEvent::IRC::Connection I am able to connect to Twitch server as follows:
use AnyEvent;
use AnyEvent::IRC::Connection;
use Data::Dumper;
use constant IRC_ADDR => 'irc.chat.twitch.tv';
use constant IRC_PORT => 6667;
use constant IRC_AUTH => 'my_token'; # http://www.twitchapps.com/tmi/
use constant IRC_NICK => 'my_nick';
use constant IRC_CHAN => 'some_channel';
my $c = AnyEvent->condvar;
my $con = new AnyEvent::IRC::Connection;
$con->connect(IRC_ADDR, IRC_PORT);
$con->reg_cb (
connect => sub {
my ($con) = #_;
$con->send_msg (PASS => 'oauth:' . IRC_AUTH);
$con->send_msg (NICK => IRC_NICK);
$con->send_msg (JOIN => IRC_CHAN);
},
'irc_*' => sub {
my ($con, $msg) = #_;
print ">> " . Dumper($msg) . "\n";
},
dcc_chat_msg => sub {
my ($con, $id, $msg) = #_;
print "DCC $id> $msg\n";
},
);
$c->wait;
However, I can't get read any public chat messages.
How can I access them?
Rooms on IRC are prefixed by # so you joined some_channel which doesn't exist instead of #some_channel which does.
Also note that channels on Twitch are ALWAYS lower case, so #barrycarlyon not #BarryCarlyon
Related
I have a requirement to fetch many http urls and I use AnyEvent::HTTP to do this
For every URL I need to measure the time taken how can I do this ?
My code (stripped down) is here
#!/usr/bin/perl
use strict;
use AnyEvent::HTTP;
use AnyEvent::Socket;
use Data::Dumper;
my $internal_ip=v192.168.2.103; #Use this ip to bind instead of default ip. Harcoding necessary :-( using v$ip
sub prep_cb {
my ($socket)=#_;
my $bind = AnyEvent::Socket::pack_sockaddr undef, $internal_ip;
# I need to start the time here
bind $socket, $bind
or die "bind: $!";
}
my $url="http://192.168.2.105/echo.php";
my $anyevent = AnyEvent->condvar;
$anyevent->begin;
http_request(
"GET" => $url,
on_prepare =>\&prep_cb,
sub {
my ($data, $hdr) = #_;
$anyevent->end;
# I need to measure the time taken
print Dumper([$data,$hdr]);
}
);
$anyevent->recv;
What if you replace your http_request() with the following:
my $timer;
http_request(
"GET" => $url,
on_prepare => sub {$timer = time; prep_cb},
sub {
my ($data, $hdr) = #_;
$anyevent->end;
print "Took " . (time - $timer) . " seconds.\n";
print Dumper([$data,$hdr]);
}
);
Simpler way is to have a variable and update it on on_prepare and log it after $anyevent->end as mentioned by TheAmigo
A general way to profile/time any function:
Assuming your function is fetchHttpUrl($url),
you could call it like this
profile(\&fetchHttpUrl, $url);
sub profile {
my($function, #arguments) = #_;
my $startTime = currentTimeInMilliseconds();
$function->(#arguments);
my $durationInMs = currentTimeInMilliseconds() - $startTime;
print"{".getMethodNameFromPointer($function)."(".join(",", #arguments).")"."} : $durationInMs ms";
}
I have this script that use a hash table:
#!/usr/bin/env perl
use strict; use warnings;
my $hash = {
'cat' => {
"félin" => '0.500000',
'chat' => '0.600000',
'chatterie' => '0.300000'
'chien' => '0.01000'
},
'rabbit' => {
'lapin' => '0.600000'
},
'canteen' => {
"ménagère" => '0.400000',
'cantine' => '0.600000'
}
};
my $text = "I love my cat and my rabbit canteen !\n";
foreach my $word (split "\s+", $text) {
print $word;
exists $hash->{$word}
and print "[" . join(";", keys %{ $hash->{$word} }) . "]";
print " ";
}
For now, I have this output:
I love my cat[chat;félin;chatterie;chien] and my rabbit[lapin] canteen[cantine;ménagère] !
I need to have the nbest key value according to the frequencies (stored in my hash). For example, I want to have the 3 best translations according to the frequencies like this:
I love my cat[chat;félin;chatterie] and my rabbit[lapin] canteen[cantine;ménagère] !
How can I change my code to take into account the frequencies of each values and also to print the nbest values ?
Thanks for your help.
The tidiest way to do this is to write a subroutine that returns the N most frequent translations for a given word. I have written best_n in the program below to do that. It uses rev_nsort_by from List::UtilsBy to do the sort succinctly. It isn't a core module, and so may well need to be installed.
I have also used an executable substitution to modify the string in-place.
use utf8;
use strict;
use warnings;
use List::UtilsBy qw/ rev_nsort_by /;
my $hash = {
'cat' => {
'félin' => '0.500000',
'chat' => '0.600000',
'chatterie' => '0.300000',
'chien' => '0.01000',
},
'rabbit' => {
'lapin' => '0.600000',
},
'canteen' => {
'ménagère' => '0.400000',
'cantine' => '0.600000',
}
};
my $text = "I love my cat and my rabbit canteen !\n";
$text =~ s{(\S+)}{
$hash->{$1} ? sprintf '[%s]', join(';', best_n($1, 3)) : $1;
}ge;
print $text;
sub best_n {
my ($word, $n) = #_;
my $item = $hash->{$word};
my #xlate = rev_nsort_by { $item->{$_} } keys %$item;
$n = $n > #xlate ? $#xlate : $n - 1;
#xlate[0..$n];
}
output
I love my [chat;félin;chatterie] and my [lapin] [cantine;ménagère] !
I'm using the AnyEvent::Twitter::Stream module to grab tweets. Ultimately I'm trying to print the tweets to a file but I'm unable (I think) to get the tweet as a JSON object. My code is as follows:
#!/Applications/XAMPP/xamppfiles/bin/perl
use AnyEvent::Twitter::Stream;
my $done = AnyEvent->condvar;
BEGIN {
use Exporter;
our #ISA = qw(Exporter);
our #EXPORT = qw{
&init
};
}
sub print_tweet {
my $tweet = shift;
print $tweet;
}
# receive updates from #following_ids
my $listener = AnyEvent::Twitter::Stream->new(
username => XXXXXX
password => XXXXXX
method => 'sample', # "firehose" for everything, "sample" for sample timeline
decode_json => 1,
on_tweet => sub {
my $tweet = shift;
print_tweet($tweet);
},
on_keepalive => sub {
warn "ping\n";
},
on_delete => sub {
my ($tweet_id, $user_id) = #_; # callback executed when twitter send a delete notification
},
timeout => 45,
);
$done->recv;
Yet when I print out the tweet in the print_tweet subroutine all I get is:
HASH(0x8f0ad0)HASH(0x8f0640)HASH(0x875990)HASH(0x8f0ab0)HASH(0x8e0d80)HASH(0x8f06e0)HASH(0x8f08f0)HASH(0x93ef30)HASH(0x876190)HASH(0x93ee60)HASH(0x8f0610)HASH(0x8f0b00)HASH(0x8e13e0)HASH(0x93ee20)HASH(0x8f0a20)HASH(0x8e1970)HASH(0x8f0900)
I've even tried to print out the tweet assuming it is a hash as follows:
sub print_tweet {
my ($jsonref, $tweet) = #_;
my $tweet = shift;
print %tweet;
}
Yet that produced nothing. It appears that AnyEvent::Twitter::Stream is returning $tweet as an object based on their sample code of:
on_tweet => sub {
my $tweet = shift;
warn "$tweet->{user}{screen_name}: $tweet->{text}\n";
},
And I know I can print out individual objects, but can I get teh raw JSON object? I must be missing something or my 'noob'ness is greater than I thought...
UPDATE
I was able to ALMOST get it by changing print_tweet to the following:
sub print_tweet {
my $tweet = shift;
my $json_output = to_json($tweet);
print $json_output;
}
It prints out MOST of the JSON object but complains about wide characters, which I believe is an issue with the output being utf8 format? I'm unsure how to solve this issue though....
Looks like it's returning a hashref. If you're not sure, you could try doing something like this.
use Data::Dumper;
...
print Dumper $tweet;
That should give you an idea of what's being passed, then you can grab what you want - probably something like this:
print "$tweet->{user}{screen_name}: $tweet->{text}\n";
In print_tweet, you're declaring $tweet twice. First, you assign it the second element of the #_ array, then you redeclare it and assign it the first element of #_, because shift operated on #_ by default.
Of course, if you had use warnings turned on, you would have seen
"my" variable $tweet masks earlier declaration in same scope
That's why you should always use strict; use warnings; at the top of your code.
The strings of output that you're seeing are hash references, the result of printing what's in the first argument to print_tweet (what you initially assign to $json_ref). If you want to print out the value of $tweet, get rid of the line where you clobber it with shift.
Figured it out. Need to use the JSON module and encode. When encoding you MUST use the {utf8 => 1} option to account for the utf8 characters you get form Twitter. Final code is here:
#!/Applications/XAMPP/xamppfiles/bin/perl
use JSON;
use utf8;
use AnyEvent::Twitter::Stream;
my $done = AnyEvent->condvar;
BEGIN {
use Exporter;
our #ISA = qw(Exporter);
our #EXPORT = qw{
&init
};
}
sub print_tweet {
my $tweet = shift;
my $json_output = to_json($tweet, {utf8 => 1});
print $json_output;
print "\n";
}
# receive updates from #following_ids
my $listener = AnyEvent::Twitter::Stream->new(
username => XXXXXXXX
password => XXXXXXXX
method => 'sample', # "firehose" for everything, "sample" for sample timeline
on_tweet => sub {
my $tweet = shift;
print_tweet($tweet);
},
on_keepalive => sub {
warn "ping\n";
},
on_delete => sub {
my ($tweet_id, $user_id) = #_; # callback executed when twitter send a delete notification
},
timeout => 45,
);
$done->recv;
Thanks to the help you guys gave, the DataDumper at least let me verify the format, it just didn't produce the final result.
I have data dumper outputting a remotely hosted xml file into a local text file and I am getting the following info:
$VAR1 = {
'resource' => {
'005cd410-41d6-4e3a-a55f-c38732b73a24.xml' => {
'standard' => 'DITA',
'area' => 'holding',
'id' => 'Comp_UKCLRONLINE_UKCLR_2000UKCLR0278',
},
'003c2a5e-4af3-4e70-bf8b-382d0b4edda1.xml' => {
'standard' => 'DITA',
'area' => 'holding',
'id' => 'Comp_UKCLRONLINE_UKCLR_2000UKCLR0278',
},
etc. What I want to do is work with just one/key and value in each resource. Ie pick out the ID and then create a url from that.
I would normally use a regex on the file and pull the info I need from that but I'm thinking there must be an easier/proper way but can't think of the right term to use in a search and am therefore not finding it.
Here is the code I am using to write this output to a file:
#-----------------------------------------------
sub request_url {
#-----------------------------------------------
my $useragent = LWP::UserAgent->new;
my $request = HTTP::Request->new( GET => "http://digitalessence.net/resource.xml" );
$resource = $useragent->request( $request );
}
#-----------------------------------------------
sub file_write {
#-----------------------------------------------
open OUT, ">$OUT" or Log_message ("\n$DATE - $TIME - Could not create filelist.doc \t");
Log_message ("\n$DATE - $TIME - Opened the output file");
print OUT Dumper (XML::Simple->new()->XMLin( $resource->content ));
Log_message ("\n$DATE - $TIME - Written the output file");
}
thanks
I'm not really understanding your question, but I'm guessing you want to access some data from the hash.
You don't need a regex or other strage stuff; just `do` your data and get the value from the hassref you get back:
A simple one liner as an example (assuming your file is called `dumper.out`):
perl -Mstrict -wE 'my $hashref = do{ do "dumper.out" }; say $hashref->{resource}{"005cd410-41d6-4e3a-a55f-c38732b73a24.xml"}{id}'
HTH, Paul
Maybe you want to walk the data structure built by XML::Simple.
Each resource is inside an ARRAYREF you get using the resource key with $doc data structure.
use XML::Simple;
use LWP;
use Data::Dumper;
my $ua = LWP::UserAgent->new;
my $req = HTTP::Request->new( GET => "http://digitalessence.net/resource.xml" );
my $res = $ua->request( $req );
my $xs = XML::Simple->new();
my $doc = $xs->XMLin( $res->content );
printf "resources: %s\n", scalar keys %{ $doc->{ resource } };
foreach ( keys %{ $doc->{ resource } } ) {
printf "resource => %s, id => %s\n", $_, $doc->{ resource }->{ $_ }->{ id };
}
The output is this:
resources: 7
resource => 005cd410-41d6-4e3a-a55f-c38732b73a24.xml, id => Comp_UKCLRONLINE_UKCLR_2000UKCLR0278
resource => 003c2a5e-4af3-4e70-bf8b-382d0b4edda1.xml, id => Comp_UKCLRONLINE_UKCLR_2002UKCLR0059
resource => 0033d4d3-c397-471f-8cf5-16fb588b0951.xml, id => Comp_UKCLRONLINE_UKCLR_navParentTopic_67
resource => 002a770a-db47-41ef-a8bb-0c8aa45a8de5.xml, id => Comp_UKCLRONLINE_UKCLR_navParentTopic_308
resource => 000fff79-45b8-4ac3-8a57-def971790f16.xml, id => Comp_UKCLRONLINE_UKCLR_2002UKCLR0502
resource => 00493372-c090-4734-9a50-8f5a06489591.xml, id => Comp_UKCLRONLINE_COMPCS_2010_10_0002
resource => 004377bf-8e24-4a69-9411-7c6baca80b87.xml, id => Comp_CLJONLINE_CLJ_2002_01_11
I need some help regarding the arrays in Perl
This is the constructor I have.
BuildPacket.pm
sub new {
my $class = shift;
my $Packet = {
_PacketName => shift,
_Platform => shift,
_Version => shift,
_IncludePath => [#_],
};
bless $Packet, $class;
return $Packet;
}
sub SetPacketName {
my ( $Packet, $PacketName ) = #_;
$Packet->{_PacketName} = $PacketName if defined($PacketName);
return $Packet->{_PacketName};
}
sub SetIncludePath {
my ( $Packet, #IncludePath ) = #_;
$Packet->{_IncludePath} = \#IncludePath;
}
sub GetPacketName {
my( $Packet ) = #_;
return $Packet->{_PacketName};
}
sub GetIncludePath {
my( $Packet ) = #_;
#{ $Packet->{_IncludePath} };
}
(The code has been modified according to the suggestions from 'gbacon', thank you)
I am pushing the relative paths into 'includeobjects' array in a dynamic way. The includepaths are being read from an xml file and are pushed into this array.
# PacketInput.pm
if($element eq 'Include')
{
while( my( $key, $value ) = each( %attrs ))
{
if($key eq 'Path')
push(#includeobjects, $value);
}
}
So, the includeobject will be this way:
#includeobjects = (
"./input/myMockPacketName",
"./input/myPacket/my3/*.txt",
"./input/myPacket/in.html",
);
I am using this line for set include path
$newPacket->SetIncludePath(#includeobjects);
Also in PacketInput.pm, I have
sub CreateStringPath
{
my $packet = shift;
print "printing packet in CreateStringPath".$packet."\n";
my $append = "";
my #arr = #{$packet->GetIncludePath()};
foreach my $inc (#arr)
{
$append = $append + $inc;
print "print append :".$append."\n";
}
}
I have many packets, so I am looping through each packet
# PacketCreation.pl
my #packets = PacketInput::GetPackets();
foreach my $packet (PacketInput::GetPackets())
{
print "printing packet in loop packet".$packet."\n";
PacketInput::CreateStringPath($packet);
$packet->CreateTar($platform, $input);
$packet->GetValidateOutputFile($platform);
}
The get and set methods work fine for PacketName. But since IncludePath is an array, I could not get it to work, I mean the relative paths are not being printed.
If you enable the strict pragma, the code doesn't even compile:
Global symbol "#_IncludePath" requires explicit package name at Packet.pm line 15.
Global symbol "#_IncludePath" requires explicit package name at Packet.pm line 29.
Global symbol "#_IncludePath" requires explicit package name at Packet.pm line 30.
Global symbol "#_IncludePath" requires explicit package name at Packet.pm line 40.
Don't use # unquoted in your keys because it will confuse the parser. I recommend removing them entirely to avoid confusing human readers of your code.
You seem to want to pull all the attribute values from the arguments to the constructor, so continue peeling off the scalar values with shift, and then everything left must be the include path.
I assume that the components of the include path will be simple scalars and not references; if the latter is the case, then you'll want to make deep copies for safety.
sub new {
my $class = shift;
my $Packet = {
_PacketName => shift,
_Platform => shift,
_Version => shift,
_IncludePath => [ #_ ],
};
bless $Packet, $class;
}
Note that there's no need to store the blessed object in a temporary variable and then immediately return it because of the semantics of Perl subs:
If no return is found and if the last statement is an expression, its value is returned.
The methods below will also make use of this feature.
Given the constructor above, GetIncludePath becomes
sub GetIncludePath {
my( $Packet ) = #_;
my #path = #{ $Packet->{_IncludePath} };
wantarray ? #path : \#path;
}
There are a couple of things going on here. First, note that we're careful to return a copy of the include path rather than a direct reference to the internal array. This way, the user can modify the value returned from GetIncludePath without having to worry about mucking up the packet's state.
The wantarray operator allows a sub to determine the context of its call and respond accordingly. In list context, GetIncludePath will return the list of values in the array. Otherwise, it returns a reference to a copy of the array. This way, client code can call it either as in
foreach my $path (#{ $packet->GetIncludePath }) { ... }
or
foreach my $path ($packet->GetIncludePath) { ... }
SetIncludePath is then
sub SetIncludePath {
my ( $Packet, #IncludePath ) = #_;
$Packet->{_IncludePath} = \#IncludePath;
}
Note that you could have used similar code in the constructor rather than removing one parameter at a time with shift.
You might use the class defined above as in
#! /usr/bin/perl
use strict;
use warnings;
use Packet;
sub print_packet {
my($p) = #_;
print $p->GetPacketName, "\n",
map(" - [$_]\n", $p->GetIncludePath),
"\n";
}
my $p = Packet->new("MyName", "platform", "v1.0", qw/ foo bar baz /);
print_packet $p;
my #includeobjects = (
"./input/myMockPacketName",
"./input/myPacket/my3/*.txt",
"./input/myPacket/in.html",
);
$p->SetIncludePath(#includeobjects);
print_packet $p;
print "In scalar context:\n";
foreach my $path (#{ $p->GetIncludePath }) {
print $path, "\n";
}
Output:
MyName
- [foo]
- [bar]
- [baz]
MyName
- [./input/myMockPacketName]
- [./input/myPacket/my3/*.txt]
- [./input/myPacket/in.html]
In scalar context:
./input/myMockPacketName
./input/myPacket/my3/*.txt
./input/myPacket/in.html
Another way to reduce typing is to use Moose.
package Packet;
use Moose::Policy 'Moose::Policy::JavaAccessors';
use Moose;
has 'PacketName' => (
is => 'rw',
isa => 'Str',
required => 1,
);
has 'Platform' => (
is => 'rw',
isa => 'Str',
required => 1,
);
has 'Version' => (
is => 'rw',
isa => 'Int',
required => 1,
);
has 'IncludePath' => (
is => 'ro',
isa => 'ArrayRef[Str]',
default => sub {[]},
traits => [ 'Array' ],
handles => {
getIncludePath => 'elements',
getIncludePathMember => 'get',
setIncludePathMember => 'set',
},
);
__PACKAGE__->meta->make_immutable;
no Moose;
1;
Check out Moose::Manual::Unsweetened for another example of how Moose saves time.
If you are adamant in your desire to learn classical Perl OOP, read the following perldoc articles: perlboot, perltoot, perlfreftut and perldsc.
A great book about classical Perl OO is Damian Conway's Object Oriented Perl. It will give you a sense of the possibilities in Perl's object.
Once you understand #gbacon's answer, you can save some typing by using Class::Accessor::Fast:
#!/usr/bin/perl
package My::Class;
use strict; use warnings;
use base 'Class::Accessor::Fast';
__PACKAGE__->follow_best_practice;
__PACKAGE__->mk_accessors( qw(
IncludePath
PacketName
Platform
Version
));
use overload '""' => 'to_string';
sub to_string {
my $self = shift;
sprintf(
"%s [ %s:%s ]: %s",
$self->get_PacketName,
$self->get_Platform,
$self->get_Version,
join(':', #{ $self->get_IncludePath })
);
}
my $obj = My::Class->new({
PacketName => 'dummy', Platform => 'Linux'
});
$obj->set_IncludePath([ qw( /home/include /opt/include )]);
$obj->set_Version( '1.05b' );
print "$obj\n";