While exploring the documented example raised in this perl6 question that was asked here recently, I found that the final implementation option - (my interpretation of the example is that it provides three different ways to do something) - doesn't work. Running this;
class HTTP::Header does Associative {
has %!fields handles <iterator list kv keys values>;
sub normalize-key ($key) { $key.subst(/\w+/, *.tc, :g) }
method EXISTS-KEY ($key) { %!fields{normalize-key $key}:exists }
method DELETE-KEY ($key) { %!fields{normalize-key $key}:delete }
method push (*#_) { %!fields.push: #_ }
multi method AT-KEY (::?CLASS:D: $key) is rw {
my $element := %!fields{normalize-key $key};
Proxy.new(
FETCH => method () { $element },
STORE => method ($value) {
$element = do given $value».split(/',' \s+/).flat {
when 1 { .[0] } # a single value is stored as a string
default { .Array } # multiple values are stored as an array
}
}
);
}
}
my $header = HTTP::Header.new;
say $header.WHAT; #-> (Header)
$header<Accept> = "text/plain";
$header{'Accept-' X~ <Charset Encoding Language>} = <utf-8 gzip en>;
$header.push('Accept-Language' => "fr"); # like .push on a Hash
say $header<Accept-Language>.perl; #-> $["en", "fr"]
... produces the expected output. Note that the third last line with the X meta-operator assigns a literal list (built with angle brackets) to a hash slice (given a flexible definition of "hash"). My understanding is this results in three seperate calls to method AT-KEY each with a single string argument (apart from self) and therefore does not exersise the default clause of the given statement. Is that correct?
When I invent a use case that excersises that part of the code, it appears to fail;
... as above ...
$header<Accept> = "text/plain";
$header{'Accept-' X~ <Charset Encoding Language>} = <utf-8 gzip en>;
$header{'Accept-Language'} = "en, fr, cz";
say $header<Accept-Language>.perl; #-> ["en", "fr", "cz"] ??
# outputs
(Header)
This Seq has already been iterated, and its values consumed
(you might solve this by adding .cache on usages of the Seq, or
by assigning the Seq into an array)
in block at ./hhorig.pl line 20
in method <anon> at ./hhorig.pl line 18
in block <unit> at ./hhorig.pl line 32
The error message provides an awesome explanation - the topic is a sequence produced by the split and is now spent and hence can't be referenced in the when and/or default clauses.
Have I correctly "lifted" and implemented the example? Is my invented use case of several language codes in the one string wrong or is the example code wrong/out-of-date? I say out-of-date as my recollection is that Seq's came along pretty late in the perl6 development process - so perhaps, this code used to work but doesn't now. Can anyone clarify/confirm?
Finally, taking the error message into account, the following code appears to solve the problem;
... as above ...
STORE => method ($value) {
my #values = $value».split(/',' \s+/) ;
$element = do given #values.flat {
when 1 { $value } # a single value is stored as a string
default { #values } # multiple values are stored as an array
}
}
... but is it an exact equivalent?
That code works now (Rakudo 2018.04) and prints
$["en", "fr", "cz"]
as intended. It was probably a bug which was eventually solved.
Using tcl, i want to pass variable parameters to function.
i tried this code
proc launch_proc { msg proc_name {params {}} } {
puts "params launch_proc is $params \n"
}
proc test { param } {
puts "param test is $param \n"
launch_proc "1.5.2 test param" test_standard {{*}$param param1 param2 param3"
}
}
test value
--> params launch_proc is {*}$param param1 param2 param3"
$param is not evaluated (i use tcl 8.5)
Tcl has support for this using the keyword args as the last parameter in the argument list.
Here is an example directly from the wiki:
proc demo {first {second "none"} args} {
puts "first = $first"
puts "second = $second"
puts "args = $args"
}
demo one
demo one two
demo one two three four five
results in
first = one
second = none
args =
first = one
second = two
args =
first = one
second = two
args = three four five
You can use the expand syntax for this as well which makes the following two calls to demo equivalent.
demo one two three four five
set params {three four five}
demo one two {*}$params
You're passing a list and need to instead send each item as a parameter to the proc.
proc test {p1 p2 p3} {
puts "$p1 - $p2 - $p3"
}
set value {one two three}
# This should work in tcl 8.5+
test {*}$value
set value {four five six}
# For tcl < 8.5
foreach {p1 p2 p3} $value {
test $p1 $p2 $p3
break
}
# or
set value {seven eight nine}
test [lindex $value 0] [lindex $value 1] [lindex $value 2]
Output:
$ tclsh test.tcl
one - two - three
four - five - six
seven - eight - nine
You need upvar, and use list when you construct the params list for launch_proc
proc test {varname} {
upvar 1 $varname value
puts "param test is $varname => $value"
launch_proc "1.5.2 test param" test_standard [list {*}$value par1 par2 par3]
}
proc launch_proc {msg proc_name {params {}}} {
puts "params launch_proc: [join $params ,]"
}
set value {"a b c" "d e f" "g h i"}
test value
param test is value => "a b c" "d e f" "g h i"
params launch_proc: a b c,d e f,g h i,par1,par2,par3
I have several semantic triples. Some examples:
Porky,species,pig // Porky's species is "pig"
Bob,sister,May // Bob's sister is May
May,brother,Sam // May's borther is Sam
Sam,wife,Jane // Sam's wife is Jane
... and so on ...
I store each triple in 6 different hashes. Example:
$ijk{Porky}{species}{pig} = 1;
$ikj{Porky}{pig}{species} = 1;
$jik{species}{Porky}{pig} = 1;
$jki{species}{pig}{Porky} = 1;
$kij{pig}{Porky}{species} = 1;
$kji{pig}{species}{Porky} = 1;
This lets me efficiently ask questions like:
What species is Porky (keys %{$ijk{Porky}{species}})
List all pigs (keys %{$jki{species}{pig}})
What information do I have on Porky? (keys %{$ijk{Porky}})
List all species (keys %{$jik{species}})
and so on. Note that none of the examples above go through a list one element at a time. They all take me "instantly" to my answer. In other words, each answer is a hash value. Of course, the answer itself may be a list, but I don't traverse any lists to get to that answer.
However, defining 6 separate hashes seems really inefficient. Is there
an easier way to do this without using an external database engine
(for this question, SQLite3 counts as an external database engine)?
Or have I just replicated a small subset of SQL into Perl?
EDIT: I guess what I'm trying to say: I love associative arrays, but they seem to be the wrong data structure for this job. What's the right data structure here, and what Perl module implements it?
Have you looked at using RDF::Trine? It has DBI-backed stores, but it also has in-memory stores, and can parse/serialize in RDF/XML, Turtle, N-Triples, etc if you need persistence.
Example:
use strict;
use warnings;
use RDF::Trine qw(statement literal);
my $ns = RDF::Trine::Namespace->new("http://example.com/");
my $data = RDF::Trine::Model->new;
$data->add_statement(statement $ns->Peppa, $ns->species, $ns->Pig);
$data->add_statement(statement $ns->Peppa, $ns->name, literal 'Peppa');
$data->add_statement(statement $ns->George, $ns->species, $ns->Pig);
$data->add_statement(statement $ns->George, $ns->name, literal 'George');
$data->add_statement(statement $ns->Suzy, $ns->species, $ns->Sheep);
$data->add_statement(statement $ns->Suzy, $ns->name, literal 'Suzy');
print "Here are the pigs...\n";
for my $pig ($data->subjects($ns->species, $ns->Pig)) {
my ($name) = $data->objects($pig, $ns->name);
print $name->literal_value, "\n";
}
print "Let's dump all the data...\n";
my $ser = RDF::Trine::Serializer::Turtle->new;
print $ser->serialize_model_to_string($data), "\n";
RDF::Trine is quite a big framework, so has a bit of a compile-time penalty. At run-time it's relatively fast though.
RDF::Trine can be combined with RDF::Query if you wish to query your data using SPARQL.
use RDF::Query;
my $q = RDF::Query->new('
PREFIX : <http://example.com/>
SELECT ?name
WHERE {
?thing :species :Pig ;
:name ?name .
}
');
my $r = $q->execute($data);
print "Here are the pigs...\n";
while (my $row = $r->next) {
print $row->{name}->literal_value, "\n";
}
RDF::Query supports both SPARQL 1.0 and SPARQL 1.1. RDF::Trine and RDF::Query are both written by Gregory Williams who was a member of the SPARQL 1.1 Working Group. RDF::Query was one of the first implementations to achieve 100% on the SPARQL 1.1 Query test suite. (It may have even been the first?)
"Efficient" is not really the right word here since you're worried about improving speed in exchange for memory, which is generally how it works.
Only real alternative is to store the triplets as distinct values, and then just have three "indexes" into them:
$row = [ "Porky", "species", "pig" ];
push #{$subject_index{Porky}}, $row;
push #{$relation_index{species}}, $row;
push #{$target_index{pig}}, $row;
To do something like "list all pigs", you'd have to find the intersection of $relation_index{species} and $target_index{pig}. Which you can do manually, or with your favorite set implementation.
Then wrap it all up in a nice object interface, and you've basically implemented INNER JOIN. :)
A single hash of hash should be sufficient:
use strict;
use warnings;
use List::MoreUtils qw(uniq);
use Data::Dump qw(dump);
my %data;
while (<DATA>) {
chomp;
my ($name, $type, $value) = split ',';
$data{$name}{$type} = $value;
}
# What species is Porky?
print "Porky's species is: $data{Porky}{species}\n";
# List all pigs
print "All pigs: " . join(',', grep {defined $data{$_}{species} && $data{$_}{species} eq 'pig'} keys %data) . "\n";
# What information do I have on Porky?
print "Info on Porky: " . dump($data{Porky}) . "\n";
# List all species
print "All species: " . join(',', uniq grep defined, map $_->{species}, values %data) . "\n";
__DATA__
Porky,species,pig
Bob,sister,May
May,brother,Sam
Sam,wife,Jane
Outputs:
Porky's species is: pig
All pigs: Porky
Info on Porky: { species => "pig" }
All species: pig
I think you are mixing categories and values, such as name=Porky, and species=pig.
Given your example, I'd go with something like this:
my %hash;
$hash{name}{Porky}{species}{pig} = 1;
$hash{species}{pig}{name}{Porky} = 1;
$hash{name}{Bob}{sister}{May} = 1;
$hash{sister}{May}{name}{Bob} = 1;
$hash{name}{May}{brother}{Sam} = 1;
$hash{brother}{Sam}{name}{May} = 1;
$hash{name}{Sam}{wife}{Jane} = 1;
$hash{wife}{Jane}{name}{Sam} = 1;
Yes, this has some apparent redundancy, since we can easily distinguish most names from other values. But the 3rd-level hash key is also a top level hash key, which can be used to get more information on some element.
Or have I just replicated a small subset of SQL into Perl?
It's pretty easy to start using actual SQL, using an SQLite in memory database.
#!/usr/bin/perl
use warnings; use strict;
use DBI;
my $dbh = DBI->connect("dbi:SQLite::memory:", "", "", {
sqlite_use_immediate_transaction => 0,
RaiseError => 1,
});
$dbh->do("CREATE TABLE triple(subject,predicate,object)");
$dbh->do("CREATE INDEX 'triple(subject)' ON triple(subject)");
$dbh->do("CREATE INDEX 'triple(predicate)' ON triple(predicate)");
$dbh->do("CREATE INDEX 'triple(object)' ON triple(object)");
for ([qw<Porky species pig>],
[qw<Porky color pink>],
[qw<Sylvester species cat>]) {
$dbh->do("INSERT INTO triple(subject,predicate,object) VALUES (?, ?, ?)", {}, #$_);
}
use JSON;
print to_json( $dbh->selectall_arrayref('SELECT * from triple WHERE predicate="species"', {Slice => {}}) );
Gives:
[{"object":"pig","predicate":"species","subject":"Porky"},
{"object":"cat","predicate":"species","subject":"Sylvester"}]
You can then query and index the data in a familiar manner. Very scalable as well.
I got a list of variables to loop through the database. How can I detect the variable is not in the database? What query should I use? How to print out error message once detected the variable is not in database.
My Code:
$variable = $sql->{'variable'};
foreach my $sql (#Records){
**Below statement will select existed variable, what should I change to make it select not existed variable**
$sqlMySQL = "Select LOT from table where LOT like '%$variable%'";
}
**If not exist**{
print("Not exist")
}
Expected result:
While the $variable loop through the database, if the $variable not exist in the database then print out the $variable or not exist.
Thanks for viewing, comments and answers.
I would go about it similar to the below.
A list of variables - Place those variables in an array (aka a list)
What query should I use - One that will only select exactly what you need and store it in the best dataset for traversal (selectall_hashref)
While the $variable loop through the database - Would require a DBI call for each $variable, so instead loop through your array to check for existence in the hash.
EXAMPLE
#!/usr/bin/perl
use strict;
use warnings;
use DBI;
my $dbh =
DBI->connect( "dbi:SQLite:dbname=test.db", "USERNAME", "PASSWORD",
{ RaiseError => 1 },
) or die $DBI::errstr;
my #vars = ( 25, 30, 40 );
my $hash_ref =
$dbh->selectall_hashref( q / SELECT LOT FROM table /, q / LOT / );
$dbh->disconnect();
foreach (#vars) {
if ( exists $hash_ref->{$_} ) {
print $_ . "\n";
}
else {
print "Does not exist\n";
}
}
Something similar to that will pull all the LOT column values for your table into a hash key value pair that you can then compare against your array in a foreach loop.
main.pl:
#!/usr/bin/perl
use strict;
use warnings;
use v5.14;
use ReadData;
my $read = ReadData->new();
my #name = $read->getNames();
$read->printNames(#name);
ReadData.pm:
#!/usr/bin/perl
package ReadData;
use strict;
use warnings;
use v5.14;
#
sub new {
my $class = shift;
my $self = {};
bless $self, $class;
return($self);
}
sub getNames {
# read in data
my #data;
print "\nName of first matrix? ";
chomp($data[0] = <>);
print "\nName of second matrix? ";
chomp($data[1] = <>);
return(#data);
}
sub printNames {
my #name = #_;
print "\nname1: " . $name[0];
print "\nname2: " . $name[1];
}
1;
I have these subroutines in another version of the main program, and everything works fine there. I don't call the object, and the input names are reflected correctly in the output as seen bleow:
my #name = getNames();
printNames(#name);
sub getNames { same as above . . . }
sub printNames{ same as above . . . }
The code I have pasted at the very top technically WORKS, because it runs, and gives output, but the output is incorrect.
When I enter "A" as the first name, and "B" as the second name, this is what I get back:
>>> perl alt.pl
Name of first matrix? A
Name of second matrix? B
name1: ReadData=HASH(0x1d082f0)
name2: A
Can anyone help me to fix this? I've been reading like 50 perl tutorials online and I can't wrap my brain around what I'm supposed to be doing. My only other real programming experience is OOP in Java, and I don't follow this perl constructor stuff . . .
I think the main thing you're missing is that when you call a method on an object:
$read->printNames(#name);
the object itself ($read) is passed into the method (printNames) as the first argument, before all the regular arguments. (In Java this happens implicitly — the object is just magically made available as this — but in Perl it's explicit — the object is $_[0].) So, you can change printNames to this:
sub printNames {
my $this = shift;
my #name = #_;
print "\nname1: " . $name[0];
print "\nname2: " . $name[1];
}
(Of course, in Perl, as in Java, it's more usual for instance methods to have something to do with the object. Your printNames method is strange in that it never uses $this at all. But this should get you started.)
You probably want to store the data within the object rather than copying it back and forth:
alt.pl:
#!/usr/bin/perl
use strict;
use warnings;
use ReadData;
my $read = ReadData->new();
$read->getNames();
$read->printNames();
ReadData.pm:
package ReadData;
use strict;
use warnings;
#
sub new {
my $class = shift;
my $self = {};
bless $self, $class;
return($self);
}
sub getNames {
my $self = shift;
# read in data
print "\nName of first matrix? ";
chomp($self->{name1} = <>);
print "\nName of second matrix? ";
chomp($self->{name2} = <>);
return;
}
sub printNames {
my $self = shift;
print "\nname1: " . $self->{name1};
print "\nname2: " . $self->{name2};
}
1;