In Perl 6 the Str type is immutable, so it seems reasonable to use a mutable buffer instead of concatenating a lot of strings. Next, I like being able to use the same API regardless if my function is writing to stdout, file or to an in-memory buffer.
In Perl, I can create an in-memory file like so
my $var = "";
open my $fh, '>', \$var;
print $fh "asdf";
close $fh;
print $var; # asdf
How do I achieve the same thing in Perl 6?
There's a minimal IO::String in the ecosystem backed by an array.
For a one-off solution, you could also do someting like
my $string;
my $handle = IO::Handle.new but role {
method print(*#stuff) { $string ~= #stuff.join };
method print-nl { $string ~= "\n" }
};
$handle.say("The answer you're looking for is 42.");
dd $string;
What I currently do is that I wrapped string concatenation in a class as a temporary solution.
class Buffer {
has $!buf = "";
multi method print($string) {
$!buf ~= $string;
}
multi method say($string) {
$!buf ~= $string ~ "\n";
}
multi method Str() {
return $!buf;
}
}
With that, I can do
my $buf = Buffer.new();
say $buf: "asdf";
print $buf.Str;
Related
Use of global arrays in different threads
I'm going to use Dancer2 and File::Tail to use Tail on the web. So when the Websocket is opened, it stores the $conn in an array, and when File::Tail is detected, it tries to send data to the socket stored in the array. But it doesn't work as expected.
The array that is saved when a websocket connection occurs is probably not a global variable.
# it doesn't works.
foreach (#webs) {
$_->send_utf8("test2!!!!!!!!");
}
I tried to use threads::shared and Cache:::Memcached etc, but I failed.
I don't know perl very well. I tried to solve it myself, but I couldn't solve it for too long, so I leave a question.
This is the whole code.
use File::Tail ();
use threads;
use threads::shared;
use Net::WebSocket::Server;
use strict;
use Dancer2;
my #webs = ();
# my %clients :shared = ();
my $conns :shared = 4;
threads->create(sub {
print "start-end:", "$conns", "\n";
my #files = glob( $ARGV[0] . '/*' );
my #fs = ();
foreach my $fileName(#files) {
my $file = File::Tail->new(name=>"$fileName",
tail => 1000,
maxinterval=>1,
interval=>1,
adjustafter=>5,resetafter=>1,
ignore_nonexistant=>1,
maxbuf=>32768);
push(#fs, $file);
}
do {
my $timeout = 1;
(my $nfound,my $timeleft,my #pending)=
File::Tail::select(undef,undef,undef,$timeout,#fs);
unless ($nfound) {
} else {
foreach (#pending) {
my $str = $_->read;
print $_->{"input"} . " ||||||||| ".localtime(time)." ||||||||| ".$str;
# it doesn't works.
foreach (#webs) {
$_->send_utf8("test!!!!!!!!");
}
}
}
} until(0);
})->detach();
threads->create(sub {
Net::WebSocket::Server->new(
listen => 8080,
on_connect => sub {
my ($serv, $conn) = #_;
push(#webs, $conn);
$conn->on(
utf8 => sub {
my ($conn, $msg) = #_;
$conn->send_utf8($msg);
# it works.
foreach (#webs) {
$_->send_utf8("test!!!!!!!!");
}
},
);
},
)->start;
})->detach();
get '/' => sub {
my $ws_url = "ws://127.0.0.1:8080/";
return <<"END";
<html>
<head><script>
var urlMySocket = "$ws_url";
var mySocket = new WebSocket(urlMySocket);
mySocket.onmessage = function (evt) {
console.log( "Got message " + evt.data );
};
mySocket.onopen = function(evt) {
console.log("opening");
setTimeout( function() {
mySocket.send('hello'); }, 2000 );
};
</script></head>
<body><h1>WebSocket client</h1></body>
</html>
END
};
dance;
Threads in perl are not lightweight. They're separate instances of the program.
The only thing that threads have in common, are things that exist prior to the threads instantating.
You can - with declaring shared variables - allow data structures to share between threads, however I'd warn you to be cautious here - without some manner of locking, you potentially create yourself a race condition.
In your case, you could declare #webs as : shared. This will mean values inserted into it will be visible to all your threads. But you still need a degree of caution there, because 'when stuff is added' is still nondeterministic.
But anyway, this basically works:
#!/usr/bin/env perl
use strict;
use warnings;
use threads;
use threads::shared;
use Data::Dumper;
my #shared_struct : shared;
sub reader {
print "Starting reader\n";
for ( 1..10 ) {
print threads -> self() -> tid(), ":", join (",", #shared_struct ), "\n";
sleep 1;
}
}
sub writer {
print "starting writer\n";
for ( 1..10 ) {
push #shared_struct, rand(10);
print Dumper \#shared_struct;
sleep 1;
}
}
## start the threads;
my $reader = threads -> create ( \&reader );
my $writer = threads -> create ( \&writer );
while ( 1 ) {
print #shared_struct;
sleep 1;
}
More generally, I'd suggest you almost never actually want to detach a thread in perl - in doing so, what you're saying is 'I don't care about your execution'. And clearly that's not the case in your code - you're trying to talk to the threads.
Just creating the thread accomplishes what you want - parallel execution and you can have:
for my $thread ( threads -> list ) {
$thread -> join;
}
As and when you're ready for the thread to terminate.
I like to share a complex-datastructure between threads.
As far I know that is not possible with threads:shared (only basic types are shareable).
So I think about serialize/deserialize the structure with JSON or Storable so it is just a string that I can share perfectly. But I need to unpack it before use and pack it after a change.
Is that a common way to work on that problem?
Are there better ways?
Whould you prefer JSON or Storable or something else?
Thanks for help!
EDIT
I just did some tests with Storable and JSON. JSON is quicker and produces smaller serialized strings. I did not expect that.
When dealing with this problem, I use Thread::Queue to pass my objects around, and usually use Storable to serialise.
I haven't bothered doing performance comparisons, because usually my data-passing overhead isn't the limiting factor.
Note - the key advantage of Storable is that it allows some limited object support (Not - be careful - it only works if your object is self contained):
#!/usr/bin/env perl
use strict;
use warnings;
package MyObject;
sub new {
my ( $class, $id ) = #_;
my $self = {};
$self -> {id} = $id;
$self -> {access_count} = 0;
bless $self, $class;
return $self;
}
sub access_thing {
my ( $self ) = #_;
return $self -> {access_count}++;
}
sub get_id {
my ( $self ) = #_;
return $self -> {id};
}
package main;
use threads;
use Thread::Queue;
use Storable qw ( freeze thaw );
my $thread_count = 10;
my $work_q = Thread::Queue -> new;
sub worker {
while ( my $item = $work_q -> dequeue ) {
my $obj = thaw ( $item );
print $obj -> get_id, ": ", $obj -> access_thing,"\n";
}
}
for (1..$thread_count) {
threads -> create (\&worker);
}
for my $id ( 0..1000 ) {
my $obj = MyObject -> new ( $id );
$work_q -> enqueue ( freeze ( $obj ) );
}
$work_q -> end;
$_ -> join for threads -> list;
If JSON would limit you to array/hash data structures - which may be fine for your use case.
Complex data structures can be shared using shared_clone. The components of the data structure need be cloned before being added to it.
use strict;
use feature 'say';
use Data::Dump qw(dd);
use threads;
use threads::shared;
my $cds = {
k1 => shared_clone( { k1_l2 => [ 1..2 ] } ),
k2 => shared_clone( { k2_l2 => [10..11] } )
};
my #threads = map { async(\&proc_ds, $cds->{$_}) } keys %$cds;
$_->join() for #threads;
dd $cds;
sub proc_ds {
my ($ds) = #_;
lock $ds;
push #{$ds->{$_}}, 10+threads->tid for keys %$ds;
}
Note that you don't want to allow autovivification when working with shared values, as it would create unshared (and empty) components in the structure. Check explicitly for existence.
A ready data structure needs to be cloned-and-shared
my $cds = { k => [ 5..7 ] }; # already built, need be shared
my $cds_share = shared_clone( $cds );
my #threads = map { async(\&proc_ds, $cds_share) } 1..3;
$_->join() for #threads;
With the same proc_ds() as above this prints the structure (condensed output)
{ 'k' => [ '5', '6', '7', '11', '12', '13' ] };
When data structure is populated for sharing, as in the first example, then there is less overhead to pay. Otherwise there is a data copy involved, as in the second example, and whether that is OK depends on details (data size, how often a copy is made, etc).
The idea of serializing data is workable as well, but how suitable it is again depends on details since in that case you'd not only copy data but would go to disks as well.
In that case JSON is certainly one good way to go, being a data format that is simple and readable, and can also be shared between tools. The Storable is binary, works directly with Perl data structures, and is supposed to be fast (what should show with larger data).
One other option is to use a worker model and pass data over a message queue. Then you'd use Thread::Queue, or perhaps make use of Thread::Queue::Any, for communication channels.
Problem
I have a hash/array structure, some of the hash keys are not in the same case though.
I would like to know if there is a way to handle this case without manually checking the keys of every hash.
In the example below i would like all ID/iD/id/Id fields to be printed.
Example code
use warnings;
use strict;
my $Hash = {
Server => [
{
Id=>123
},
{
iD=>456
},
{
ID=>789
}
]
};
for (#{$Hash->{Server}}){
print "$_->{ID}\n"
#This is the problematic part
}
Other
perl version: v5.10.0
This data is recieved from elsewhere and must remain the same case, the example above is minimal and i cannot just simply change them all to the same case.
Any more info needed let me know.
Well, it depends a little bit on your source of information. This looks like you've parsed something, so there may be a better solution.
However, with what we've got here, I'd do it like this:
for my $entry (#{$Hash->{Server}}){
#grep, find first match. Dupes discarded.
my ( $key ) = grep { /^id$/i } keys %$entry;
print "$key => ",$entry -> {$key},"\n";
}
This works by using grep with an i regex for case insensitive on keys, and grabbing whatever comes out first. So if you have multiple matches for /id/i then it'll be random which one you get. (sort could help with that though)
Given you're working with XML though, I'd probably backtrack a bit, throw out XML::Simple and do it like this instead:
#!/usr/bin/perl
use strict;
use warnings;
use XML::Twig;
my $twig = XML::Twig -> new ( twig_handlers => { '_all_' => sub { $_ -> lc_attnames }} );
$twig -> parse ( \*DATA );
print "XML looks like:\n";
$twig -> set_pretty_print ( 'indented_a');
$twig -> print;
print "Output:\n";
foreach my $server ( $twig -> get_xpath('//Server') ) {
print $server -> att('id'),"\n";
}
__DATA__
<XML>
<Server ID="123" />
<Server Id="456" />
<Server id="789" />
</XML>
Or you can just:
foreach my $server ( $twig -> get_xpath('//Server') ) {
$server -> lc_attnames;
print $server -> att('id'),"\n";
}
in lieu of doing it in the twig handlers. The first answer will 'fix' all of your XML to having lower case attributes, which might not be what you want. But then, it might be useful for other scenarios, which is why I've given two examples.
There is no built-in way to do that. What you could do is use List::Util's first to at least get less checks, and then still try until one fits for each of the keys.
use strict;
use warnings;
use feature 'say';
use List::Util 'first';
my $Hash = {
Server => [
{
Id => 123
},
{
iD => 456
},
{
ID => 789
}
]
};
foreach my $thing ( #{ $Hash->{Server} } ) {
# this returns the first match in the list, like grep
# so we need to use it here to return the actual value
say $thing->{ first { $thing->{$_} } qw/id ID iD Id/ };
}
If there are a lot of other keys in the data structure, this is cheaper than looking at all the keys, because you at max look up all possible id keys plus one, and at best two.
If you want the list of possible keys to auto-generate and the uppercase and lowercase letters can be arbitrarily mixed, take a look at this answer.
I would suggest you to use regex to ignore case of keys using i flag.
for my $item ( # { $Hash->{Server} }) {
for(keys %{$item}) {
print $item -> {$_},"\n" if /^ID$/i;
}
}
I have a Perl subroutine that creates a file, like so:
sub createFile {
if (open (OUTFILEHANDLE, ">$fileName")) {
print OUTFILEHANDLE "$desiredVariable\n";
}
close(OUTFILEHANDLE);
}
where $fileName and $desiredVariable have been previously defined. I call that, and then call the following subroutine, which reads from the file, takes the first (only) line, and saves it into the variable $desiredVariable:
sub getInfoFromFile {
if (existFile($fileName)) {
if (open (READFILEHANDLE, "<$fileName")) {
my #entire_file=<READFILEHANDLE>; # Slurp
$desiredVariable = $entire_file[0];
chop $desiredVariable;
close(READFILEHANDLE);
}
}
}
If I leave out the "chop" line, $desiredVariable is what I want, but with a trailing space newline. If I include the "chop" line, $desiredVariable is an empty string. For some reason, "chop" is killing the whole string. I've tried it with $desiredVariable =~ s/\s*$//; and several other string manipulation tricks.
What am I doing wrong?
The code you included does not reproduce the problem. I'm guessing it was lost in translation somehow while you were anonymizing it. I ran the script as follows, the only adjustment I made was -f instead of existsFile().
#!/usr/bin/perl
sub createFile {
if (open (OUTFILEHANDLE, ">$fileName")) {
print OUTFILEHANDLE "$desiredVariable\n";
}
close(OUTFILEHANDLE);
}
sub getInfoFromFile {
if (-f $fileName) {
if (open (READFILEHANDLE, "<$fileName")) {
my #entire_file=<READFILEHANDLE>; # Slurp
$desiredVariable = $entire_file[0];
chop $desiredVariable;
close(READFILEHANDLE);
}
}
}
$fileName = "test.txt";
$desiredVariable = "Hello World!";
createFile();
$desiredVariable = "";
getInfoFromFile();
print "Got '$desiredVariable'\n"; # Got 'Hello World!'
How do I convert function input parameters to the right type?
I want to return a string that has part of the URL passed into it removed.
This works, but it uses a hard-coded string:
function CleanUrl($input)
{
$x = "http://google.com".Replace("http://", "")
return $x
}
$SiteName = CleanUrl($HostHeader)
echo $SiteName
This fails:
function CleanUrl($input)
{
$x = $input.Replace("http://", "")
return $x
}
Method invocation failed because [System.Array+SZArrayEnumerator] doesn't contain a method named 'Replace'.
At M:\PowerShell\test.ps1:13 char:21
+ $x = $input.Replace( <<<< "http://", "")
Steve's answer works. The problem with your attempt to reproduce ESV's script is that you're using $input, which is a reserved variable (it automatically collects multiple piped input into a single variable).
You should, however, use .Replace() unless you need the extra feature(s) of -replace (it handles regular expressions, etc).
function CleanUrl([string]$url)
{
$url.Replace("http://","")
}
That will work, but so would:
function CleanUrl([string]$url)
{
$url -replace "http://",""
}
Also, when you invoke a PowerShell function, don't use parenthesis:
$HostHeader = "http://google.com"
$SiteName = CleanUrl $HostHeader
Write-Host $SiteName
Hope that helps. By the way, to demonstrate $input:
function CleanUrls
{
$input -replace "http://",""
}
# Notice these are arrays ...
$HostHeaders = #("http://google.com","http://stackoverflow.com")
$SiteNames = $HostHeader | CleanUrls
Write-Output $SiteNames
The concept here is correct.
The problem is with the variable name you have chosen. $input is a reserved variable used by PowerShell to represent an array of pipeline input. If you change your variable name, you should not have any problem.
PowerShell does have a replace operator, so you could make your function into
function CleanUrl($url)
{
return $url -replace 'http://'
}
function CleanUrl([string] $url)
{
return $url.Replace("http://", "")
}
This worked for me:
function CleanUrl($input)
{
return $input.Replace("http://", "")
}