• Your recent searches
Aion-Query
5 results

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN 


0.0.4 2024-07-06T17:18:44Z

    - add subroutine query_attach
    - writes test-cases for subroutine query_slice
    - requires license GPL_3 in cpanfile

0.0.3 2023-11-30T15:23:52Z

    - add query param-masks :^x, :~x, and :.x for set typed value
    - add x*>> :_ in query_prepare. This is inline map

0.0.2 2023-11-01T10:55:12Z

    - fix dependency

0.0.1 2023-11-01T09:11:21Z

    - tested sqlite engine

0.01 2018-04-19T11:17:54Z

README.md  view on Meta::CPAN 


# use in: INSERT INTO author VALUES :x
quote [[1, 2], [3, "4"]]  # => (1, 2), (3, '4')

# use in multiupdate: UPDATE author SET name=CASE id :x ELSE null END
quote \[2=>'Pushkin A.', 1=>'Pushkin A.S.']  # => WHEN 2 THEN 'Pushkin A.' WHEN 1 THEN 'Pushkin A.S.'

# use for UPDATE SET :x or INSERT SET :x
quote {name => 'A.S.', id => 12}   # => id = 12, name = 'A.S.'

[map quote, -6, "-6", 1.5, "1.5"] # --> [-6, "'-6'", 1.5, "'1.5'"]

```

## query_prepare ($query, %param)

Заменяет параметры (`%param`) в запросе (`$query`) и возвращает его. Параметры заключаются в кавычки через подпрограмму `quote`.

Параметры вида `:x` будут квотироваться с учётом флагов скаляра, которые укажут, что в нём находится: строка, целое или число с плавающей зÐ...

Чтобы явно указать тип скаляра используйте префиксы: `:^x` – целое, `:.x` – строка, `:~x` – плавающее.

lib/Aion/Query.md  view on Meta::CPAN 


# use in: INSERT INTO author VALUES :x
quote [[1, 2], [3, "4"]]  # => (1, 2), (3, '4')

# use in multiupdate: UPDATE author SET name=CASE id :x ELSE null END
quote \[2=>'Pushkin A.', 1=>'Pushkin A.S.']  # => WHEN 2 THEN 'Pushkin A.' WHEN 1 THEN 'Pushkin A.S.'

# use for UPDATE SET :x or INSERT SET :x
quote {name => 'A.S.', id => 12}   # => id = 12, name = 'A.S.'

[map quote, -6, "-6", 1.5, "1.5"] # --> [-6, "'-6'", 1.5, "'1.5'"]

```

## query_prepare ($query, %param)

Заменяет параметры (`%param`) в запросе (`$query`) и возвращает его. Параметры заключаются в кавычки через подпрограмму `quote`.

Параметры вида `:x` будут квотироваться с учётом флагов скаляра, которые укажут, что в нём находится: строка, целое или число с плавающей зÐ...

Чтобы явно указать тип скаляра используйте префиксы: `:^x` – целое, `:.x` – строка, `:~x` – плавающее.

lib/Aion/Query.pm  view on Meta::CPAN 


our @DEBUG;
sub sql_debug(@) {
	my ($fn, $query) = @_;
	my $msg = "$fn: " . (ref $query? np($query): $query);
	push @DEBUG, $msg;
	print STDERR $msg, "\n" if DEBUG;
}

# sub debug_html {
# 	join "", map { ("<p class='debug'>", to_html($_), "</p>\n") } @DEBUG;
# }

# sub debug_text {
# 	return "" if !@DEBUG;
# 	join "", map { "$_\n\n" } @DEBUG, "";
# }

# sub debug_array {
# 	return if !@DEBUG;
# 	$_[0]->{SQL_DEBUG} = \@DEBUG;
# 	return;
# }


sub LAST_INSERT_ID() {

lib/Aion/Query.pm  view on Meta::CPAN 

	$s
}

sub quote(;$);
sub quote(;$) {
	my $k = @_ == 0? $_: $_[0];
	my $ref;

	!defined($k)? "NULL":
	ref $k eq "ARRAY" && ref $k->[0] eq "ARRAY"?
		join(", ", map { join "", "(", join(", ", map quote, @$_), ")" } @$k):
	ref $k eq "ARRAY"? join("", join(", ", map quote, @$k)):
	ref $k eq "HASH"?
		join(", ", map { join "", $_, " = ", quote $k->{$_} } sort keys %$k):
	ref $k eq "REF" && ref $$k eq "ARRAY"?
		join(" ", List::Util::pairmap { join " ", "WHEN", quote $a, "THEN", quote $b } @$$k):
	ref $k eq "SCALAR"? $$k:
	Scalar::Util::blessed $k ? $k:
	ref $k ne ""? die "Something strange: `$k`":
	$k =~ /^-?(?:0|[1-9]\d*)(\.\d+)?\z/a
		&& ($ref = ref B::svref_2object(@_ == 0? \$_: \$_[0])
		) ne "B::PV"? (
			!$1 && $ref eq "B::NV"? "$k.0": $k
		):
	!utf8::is_utf8($k)? (
		$k =~ /[^\t\n -~]/a ? _to_hex_str($k): #$base->quote($k, DBI::SQL_BINARY):
			Aion::Format::to_str($k)
	):
	Aion::Format::to_str(_recode_cp1251($k))
}

sub _set_type {
	my ($type, $x) = @_;
	if(ref $x eq "ARRAY") {
		[map _set_type($type, $_), @$x]
	}
	elsif(ref $x eq "HASH") {
		+{ map ($_ => _set_type($type, $type->{$_})), keys %$x }
	}
	elsif(ref $type eq "SCALAR") {
		\_set_type($type, $$x);
	}
	elsif($type eq "^") {
		int $x
	}
	elsif($type eq "~") {
		"$x"
	}

lib/Aion/Query.pm  view on Meta::CPAN 

	my ($query, %param) = @_;

	$query =~ s!
		^(?<sep>[\ \t]*) (?<if>\w+)>> [\ \t]* (?<code>.*)
		| ^(?<sep>[\ \t]*) (?<for>\w+)\*>> [\ \t]* (?<code>.*)
		| (?<param> : [~\.^]? [a-z_]\w*)
	!
		exists $+{if}? ($param{$+{if}}? $+{sep} . _set_params($+{code}, \%param): ""):
		exists $+{for}? do {
			my ($sep, $param, $code) = @+{qw/sep for code/};
			join "\n", map { local $param{'_'} = $_; _set_params("$sep$code", \%param) } @{$param{$param}}
		}:
		_set_params($+{param}, \%param)
	!imgex;
	$query
}

# Выполняет sql-запрос
sub query_do($;$) {
	my ($query, $columns) = @_;
	sql_debug query => $query;

lib/Aion/Query.pm  view on Meta::CPAN 

			0 + $base->do($query)
		}
	};
	die +(length($query)>MAX_QUERY_ERROR? substr($query, 0, MAX_QUERY_ERROR) . " ...": $query) . "\n\n$@" if $@;

	$res
}

sub query_ref(@) {
	my ($query, %kw) = @_;
	my $map = delete $kw{MAP};
	$query = query_prepare($query, %kw) if @_>1;
	my $res = query_do($query);
	if($map && ref $res eq "ARRAY") {
		eval "require $map" or die unless UNIVERSAL::can($map, "new");
		[map { $map->new(%$_) } @$res]
	} else {
		$res
	}
}

sub query(@) {
	my $ref = query_ref(@_);
	wantarray && ref $ref? @$ref: $ref;
}

lib/Aion/Query.pm  view on Meta::CPAN 

	if($is_array) {
		my %x; my @x;
		for(@$rows) {
			my $k = $_->{$key};
			push @x, $x{$k} = [] if !exists $x{$k};
			push @{$x{$k}}, $_;
		}
		@x
	}
	elsif(ref $val eq "HASH") {
		map { $_->{$key} => $_ } @$rows
	}
	elsif(ref $val eq "ARRAY") {
		if(@$val) {
			my $col = $val->[0];
			my %x;
			push @{$x{$_->{$key}}}, $_->{$col} for @$rows;
			%x
		} else {
			my %x;
			push @{$x{$_->{$key}}}, $_ for @$rows;
			%x
		}
	}
	else {
		map { $_->{$key} => $_->{$val} } @$rows
	}
}

# Подсоединить в результат запроса результат другого запроса
# 
# $authors = query "SELECT id, name FROM author";
# # $authors as [{id => 1, name => "..."}, ...];
#
# query_attach $authors => 'books:id:author_id' => "SELECT author_id, title FROM book"
#
sub query_attach {
	my ($rows, $attach, $query, %kw) = @_;
	
	($attach, my $key1, my $key2) = split /:/, $attach;

	my %row1 = map { $_->{$attach} = []; ($_->{$key1} => $_) } @$rows;

	my $rows2 = query $query, %kw;

	for my $row2 (@$rows2) {
		my $id = $row2->{$key2} // die "Not $key2 in query!";
		my $row1 = $row1{$id} // die "Not $key1=$id in main rows!";
		push @{$row1->{$attach}}, $row2;
	}

	wantarray? @$rows2: $rows2

lib/Aion/Query.pm  view on Meta::CPAN 

#
#   query_col "SELECT id FROM word WHERE word in (1,2,3)" 	-> 	[1,2,3]
#
sub query_col(@);
sub query_col(@) {
	return [query_col @_] if !wantarray;

	my $rows = query_ref(@_);
	die "Only one column is acceptable!" if @$rows and 1 != keys %{$rows->[0]};

	map { my ($k, $v) = %$_; $v } @$rows
}

# Выбрать строку
#
#   query_row_ref "SELECT id, word FROM word WHERE word = 1" 	-> 	{id=>1, word=>"серебро"}
#
sub query_row_ref(@) {
	my $rows = query_ref(@_);
	die "A few lines!" if @$rows>1;
	$rows->[0]

lib/Aion/Query.pm  view on Meta::CPAN 

# Выбрать строку
#
#   ($id, $word) = query_row_ref "SELECT id, word FROM word WHERE word = 1"
#
sub query_row(@) {
	return query_row_ref(@_) unless wantarray;
	my $sql = query_prepare(@_);
	my $rows  = query_do($sql, my $columns);
	die "A few lines!" if @$rows > 1;
	my $row = $rows->[0];
	map $row->{$_}, @$columns
}

# Выбрать значение
#
#   query_scalar "SELECT word FROM word WHERE id = 1" 	-> 	"золото"
#
sub query_scalar(@) {
	my $rows = query_ref(@_);
	die "A few lines!" if @$rows>1;
	die "Only one column is acceptable! " . keys %{$rows->[0]} if @$rows and 1 != keys %{$rows->[0]};

lib/Aion/Query.pm  view on Meta::CPAN 

#
# ("concat(size,',',likes)", "(size < 10 OR size = 10 AND likes >= 12)", ["size", "likes"]) = make_query_for_order "size desc, likes", "10,12"
#
# ("concat(size,',',likes)", 1) = make_query_for_order "size desc, likes", ""
#
sub make_query_for_order(@) {
	my ($order, $next) = @_;

	my @orders = split /\s*,\s*/, $order;
	my @order_direct;
	my @order_sel = map { my $x=$_; push @order_direct, $x=~s/\s+(asc|desc)\s*$//ie ? lc $1: "asc"; $x } @orders;

	my $select = @order_sel==1? $order_sel[0]: 
		_check_drv($base, "mysql|mariadb")? 
			join("", "concat(", join(",',',", @order_sel), ")"):
			join " || ',' || ", @order_sel
	;

	return $select, 1 if $next eq "";

	my @next = split /,/, $next;
	$next[$#orders] //= "";
	@next = map quote($_), @next;
	my @op = map { /^a/ ? ">": "<" } @order_direct;

	# id -> id >= next[0]
	# id, update -> id > next[0] OR id = next[0] and
	my @whr;
	for(my $i=0; $i<@orders; $i++) {
		my @opr;
		for(my $j=0; $j<=$i; $j++) {
			#my $eq = $j == $#orders? "=": "";
			if($j != $i) {
				push @opr, "$order_sel[$j] = $next[$j]";
			} elsif($j != $#orders) {
				push @opr, "$order_sel[$j] $op[$j] $next[$j]";
			} else {
				push @opr, "$order_sel[$j] $op[$j]= $next[$j]";
			}
		}
		push @whr, join " AND ", @opr;
	}
	my $where = join "\nOR ", map "$_", @whr;

	return $select, "($where)", \@order_sel;
}

# Устанавливает или возвращает ключ из таблицы settings
sub settings($;$) {
	my ($id, $value) = @_;
	if(@_ == 1) {
		my $v = query_scalar("SELECT value FROM settings WHERE id=:id", id => $id);
		return defined($v)? Aion::Format::Json::from_json($v): $v;

lib/Aion/Query.pm  view on Meta::CPAN 

# Возвращает ключ по другим полям
#
#	query_id "tab", word => 123 						-> 6
#
sub query_id(@) {
	my $tab = shift; my %row = @_;

	my $pk = delete($row{'-pk'}) // "id";
	my $fields = ref $pk? join(", ", @$pk): $pk;

	my $where = join " AND ", map { my $v = $row{$_}; defined($v)? "$_ = ${\ quote($v) }": "$_ is NULL" } sort keys %row;
	my $query = "SELECT $fields FROM $tab WHERE $where LIMIT 2";

	my $v = query_row($query);

	ref $pk? $v: $v->{$pk}
}

# UPSERT: сохраняет данные (update или insert)
#
#	stores "tab", [{word=>1}, {word=>2}];
#
sub stores(@);
sub stores(@) {
	my ($tab, $rows, %opt) = @_;

	my ($ignore, $insert) = delete @opt{qw/ignore insert/};
	die "Keys ${\ join('', )}" if keys %opt;



	my @keys = sort keys %{+{map %$_, @$rows}};
	die "No fields in bean $tab!" if !@keys;

	my $fields = join ", ", @keys;

	my $values = join ",\n", map { my $row = $_; join "", "(", quote([map $row->{$_}, @keys]), ")" } @$rows;

	if($insert) {
		my $query = "INSERT INTO $tab ($fields) VALUES $values";
		query_do($query);
	}
	elsif(_check_drv($base, "mysql|mariadb")) {
		if($ignore) {
			my $query = "INSERT IGNORE INTO $tab ($fields) VALUES $values";
			query_do($query);
		}
		else {
			my $fupdate = join ", ", map "$_ = values($_)", @keys;
			my $query = "INSERT INTO $tab ($fields) VALUES $values ON DUPLICATE KEY UPDATE $fupdate";
			query_do($query);
		}
	}
	elsif(_check_drv($base, 'Pg|sqlite')) {
		if($ignore) {
			my $query = "INSERT INTO $tab ($fields) VALUES $values ON CONFLICT DO NOTHING";
			query_do($query);
		} else {
			my $fupdate = join ", ", map "$_ = excluded.$_", @keys;
			my $query = "INSERT INTO $tab ($fields) VALUES $values ON CONFLICT DO UPDATE SET $fupdate";
			query_do($query);
		}
	}
	else {
		my $count = 0;
		if($ignore) {
			$count += eval { stores $tab, [$_], insert => 1 } for @$rows;
		} else {
			$count += stores $tab, [$_] for @$rows;

lib/Aion/Query.pm  view on Meta::CPAN 

	
	# use in: INSERT INTO author VALUES :x
	quote [[1, 2], [3, "4"]]  # => (1, 2), (3, '4')
	
	# use in multiupdate: UPDATE author SET name=CASE id :x ELSE null END
	quote \[2=>'Pushkin A.', 1=>'Pushkin A.S.']  # => WHEN 2 THEN 'Pushkin A.' WHEN 1 THEN 'Pushkin A.S.'
	
	# use for UPDATE SET :x or INSERT SET :x
	quote {name => 'A.S.', id => 12}   # => id = 12, name = 'A.S.'
	
	[map quote, -6, "-6", 1.5, "1.5"] # --> [-6, "'-6'", 1.5, "'1.5'"]
	

=head2 query_prepare ($query, %param)

Replaces the parameters (C<%param>) in a query (C<$query>) and returns it. Parameters are enclosed in quotes via the C<quote> routine.

Parameters of the form C<:x> will be quoted taking into account the scalar flags, which indicate whether it contains a string, an integer or a floating point number.

To explicitly indicate the type of a scalar, use the prefixes: C<:^x> – integer, C<:.x> – string, C<:~x> – floating.

t/aion/query.t  view on Meta::CPAN 


# use in: INSERT INTO author VALUES :x
::is scalar do {quote [[1, 2], [3, "4"]]}, "(1, 2), (3, '4')", 'quote [[1, 2], [3, "4"]]  # => (1, 2), (3, \'4\')';

# use in multiupdate: UPDATE author SET name=CASE id :x ELSE null END
::is scalar do {quote \[2=>'Pushkin A.', 1=>'Pushkin A.S.']}, "WHEN 2 THEN 'Pushkin A.' WHEN 1 THEN 'Pushkin A.S.'", 'quote \[2=>\'Pushkin A.\', 1=>\'Pushkin A.S.\']  # => WHEN 2 THEN \'Pushkin A.\' WHEN 1 THEN \'Pushkin A.S.\'';

# use for UPDATE SET :x or INSERT SET :x
::is scalar do {quote {name => 'A.S.', id => 12}}, "id = 12, name = 'A.S.'", 'quote {name => \'A.S.\', id => 12}   # => id = 12, name = \'A.S.\'';

::is_deeply scalar do {[map quote, -6, "-6", 1.5, "1.5"]}, scalar do {[-6, "'-6'", 1.5, "'1.5'"]}, '[map quote, -6, "-6", 1.5, "1.5"] # --> [-6, "\'-6\'", 1.5, "\'1.5\'"]';


# 
# ## query_prepare ($query, %param)
# 
# Заменяет параметры (`%param`) в запросе (`$query`) и возвращает его. Параметры заключаются в кавычки через подпрограмму `quote`.
# 
# Параметры вида `:x` будут квотироваться с учётом флагов скаляра, которые укажут, что в нём находится: строка, целое или число с плавающей Ð...
# 
# Чтобы явно указать тип скаляра используйте префиксы: `:^x` – целое, `:.x` – строка, `:~x` – плавающее.



( run in 0.823 second using v1.01-cache-2.11-cpan-3b35f9de6a3 )