Improve KoralQuery Import
diff --git a/lib/Krawfish/Koral/Query.pm b/lib/Krawfish/Koral/Query.pm
index 07193a5..b9b0721 100644
--- a/lib/Krawfish/Koral/Query.pm
+++ b/lib/Krawfish/Koral/Query.pm
@@ -1,12 +1,13 @@
package Krawfish::Koral::Query;
use parent 'Krawfish::Info';
use Krawfish::Koral::Query::Builder;
-use strict;
+use Krawfish::Koral::Query::Importer;
use warnings;
+use strict;
sub new {
my $class = shift;
- bless {
+ my $self = bless {
any => 0,
optional => 0,
null => 0,
@@ -15,6 +16,12 @@
extended_left => 0,
extended_right => 0
}, $class;
+
+ if ($_[0]) {
+ return $self->from_koral(shift);
+ };
+
+ $self;
};
#########################################
@@ -80,8 +87,34 @@
#############################
# Deserialization of KoralQuery
+# TODO: export this method from Importer
sub from_koral {
- ...
+ my ($class, $kq) = @_;
+ my $importer = Krawfish::Koral::Query::Importer->new;
+
+ my $type = $kq->{'@type'};
+ if ($type eq 'koral:group') {
+ my $op = $kq->{operation};
+ if ($op eq 'operation:sequence') {
+ return $importer->seq($kq);
+ }
+
+ elsif ($op eq 'operation:class') {
+ return $importer->class($kq);
+ }
+ else {
+ warn 'Operation ' . $op . ' not supported';
+ };
+ }
+
+ elsif ($type eq 'koral:token') {
+ return $importer->token($kq);
+ }
+ else {
+ warn $type . ' unknown';
+ };
+
+ return;
};
# Overwritten
@@ -98,6 +131,11 @@
return Krawfish::Koral::Query::Builder->new;
};
+# Create KoralQuery builder
+sub importer {
+ return Krawfish::Koral::Query::Importer->new;
+};
+
1;
diff --git a/lib/Krawfish/Koral/Query/Class.pm b/lib/Krawfish/Koral/Query/Class.pm
index e7263ae..343ff96 100644
--- a/lib/Krawfish/Koral/Query/Class.pm
+++ b/lib/Krawfish/Koral/Query/Class.pm
@@ -95,4 +95,17 @@
sub is_classed { 1 };
+
+sub from_koral {
+ my ($class, $kq) = @_;
+ my $importer = $class->importer;
+
+ my $nr = $kq->{'classOut'} or warn 'No class defined';
+
+ # Import operand
+ my $op = $importer->all($kq->{operands}->[0]);
+
+ return $class->new($op, $nr);
+};
+
1;
diff --git a/lib/Krawfish/Koral/Query/Importer.pm b/lib/Krawfish/Koral/Query/Importer.pm
new file mode 100644
index 0000000..bc196c6
--- /dev/null
+++ b/lib/Krawfish/Koral/Query/Importer.pm
@@ -0,0 +1,41 @@
+package Krawfish::Koral::Query::Importer;
+use Krawfish::Koral::Query;
+use Krawfish::Koral::Query::Sequence;
+use Krawfish::Koral::Query::Token;
+use Krawfish::Koral::Query::Term;
+use Krawfish::Koral::Query::Class;
+use warnings;
+use strict;
+
+sub new {
+ my $var;
+ bless \$var, shift;
+};
+
+sub all {
+ shift;
+ return Krawfish::Koral::Query->from_koral(shift);
+};
+
+sub seq {
+ shift;
+ return Krawfish::Koral::Query::Sequence->from_koral(shift);
+};
+
+sub token {
+ shift;
+ return Krawfish::Koral::Query::Token->from_koral(shift);
+}
+
+sub term {
+ shift;
+ return Krawfish::Koral::Query::Term->from_koral(shift);
+};
+
+
+sub class {
+ shift;
+ return Krawfish::Koral::Query::Class->from_koral(shift);
+}
+
+1;
diff --git a/lib/Krawfish/Koral/Query/Sequence.pm b/lib/Krawfish/Koral/Query/Sequence.pm
index b95ee9e..dbe564d 100644
--- a/lib/Krawfish/Koral/Query/Sequence.pm
+++ b/lib/Krawfish/Koral/Query/Sequence.pm
@@ -185,6 +185,16 @@
return join '', map { $_->to_string } @{$_[0]->{array}};
};
+sub from_koral {
+ my $class = shift;
+ my $kq = shift;
+
+ my $importer = $class->importer;
+
+ return $class->new(
+ map { $importer->all($_) } @{$kq->{operands}}
+ );
+};
1;
diff --git a/lib/Krawfish/Koral/Query/Span.pm b/lib/Krawfish/Koral/Query/Span.pm
index bfc2ebf..e03ef7f 100644
--- a/lib/Krawfish/Koral/Query/Span.pm
+++ b/lib/Krawfish/Koral/Query/Span.pm
@@ -55,6 +55,9 @@
sub maybe_unsorted { 0 };
+sub from_koral;
+# Todo: Change the term_type!
+
sub to_string {
return '<' . $_[0]->wrap->to_string . '>';
};
diff --git a/lib/Krawfish/Koral/Query/Term.pm b/lib/Krawfish/Koral/Query/Term.pm
index f648c30..39a1196 100644
--- a/lib/Krawfish/Koral/Query/Term.pm
+++ b/lib/Krawfish/Koral/Query/Term.pm
@@ -63,10 +63,27 @@
sub term_type {
my $self = shift;
- return 'token' unless $self->prefix;
- return 'span' if $self->prefix eq '<>';
- return 'attribute' if $self->prefix eq '@';
- return 'relation';
+ if ($_[0]) {
+ if ($_[0] eq 'span') {
+ $self->prefix('<>');
+ }
+ elsif ($_[0] eq 'attribute') {
+ $self->prefix('@');
+ }
+ elsif ($_[0] eq 'relation') {
+
+ # Todo: This doesn't respect
+ # direction
+ $self->prefix('>');
+ };
+ return $self;
+ }
+ else {
+ return 'token' unless $self->prefix;
+ return 'span' if $self->prefix eq '<>';
+ return 'attribute' if $self->prefix eq '@';
+ return 'relation';
+ };
};
@@ -91,11 +108,27 @@
# Operation
sub match {
- if ($_[1]) {
- $_[0]->[4] = $_[1];
- return $_[0];
+ my $self = shift;
+ if ($_[0]) {
+ my $match = shift;
+
+ if ($match =~ s/^match://) {
+ if ($match eq 'eq') {
+ $match = '=';
+ }
+ elsif ($match eq 'ne') {
+ $match = '!=';
+ }
+ else {
+ warn 'Unknown match';
+ return;
+ }
+ };
+
+ $self->[4] = $match;
+ return $self;
};
- $_[0]->[4] // '=';
+ $self->[4] // '=';
};
@@ -136,6 +169,10 @@
$hash->{layer} = $self->layer if $self->layer;
$hash->{value} = $self->value if $self->value;
+ if ($self->match eq '!=') {
+ $hash->{match} = 'match:ne';
+ };
+
# TODO: REGEX!
return $hash;
@@ -255,4 +292,17 @@
sub is_extended_left { 0 };
sub maybe_unsorted { 0 };
+sub from_koral {
+ my $class = shift;
+ my $kq = shift;
+ my $term = $class->new;
+ $term->foundry('' . $kq->{foundry}) if $kq->{foundry};
+ $term->layer('' . $kq->{layer}) if $kq->{layer};
+ $term->key('' . $kq->{key}) if $kq->{key};
+ $term->match('' . $kq->{match}) if $kq->{match};
+
+ # TODO: Support deserialization of regex!
+ return $term;
+};
+
1;
diff --git a/lib/Krawfish/Koral/Query/Token.pm b/lib/Krawfish/Koral/Query/Token.pm
index a47f93c..33957d8 100644
--- a/lib/Krawfish/Koral/Query/Token.pm
+++ b/lib/Krawfish/Koral/Query/Token.pm
@@ -7,8 +7,6 @@
use warnings;
use Scalar::Util qw/blessed/;
-# TODO: Support multiple tokens in a term group!
-
sub new {
my $class = shift;
my $token = shift;
@@ -104,5 +102,29 @@
sub maybe_unsorted { 0 };
+sub from_koral {
+ my $class = shift;
+ my $kq = shift;
+ my $importer = $class->importer;
+
+ # No wrap
+ unless ($kq->{'wrap'}) {
+ return $class->new;
+ }
+
+ # Wrap is a term
+ else {
+ my $wrap = $kq->{wrap};
+ if ($wrap->{'@type'} eq 'koral:term') {
+ return $class->new($importer->term($wrap));
+ }
+ elsif ($wrap->{'@type'} eq 'koral:termGroup') {
+ return $class->new($importer->term_group($wrap));
+ }
+ else {
+ warn 'Wrap type not supported!'
+ };
+ }
+};
1;