add generate upsert

diff --git a/perl/generate_upsert.pm b/perl/generate_upsert.pm
new file mode 100644 (file)
index 0000000..c492281
--- /dev/null
+++ b/perl/generate_upsert.pm
@@ -0,0 +1,71 @@
+# WITH new_values (chr,pos,ref_allele,alt_allele,rsid) AS (
+#   VALUES 
+#      (?,?,?,?,?)
+# ),
+# upsert AS
+# ( 
+#     UPDATE snpinfo s 
+#         SET ref_allele = nv.ref_allele,
+#             alt_allele = nv.alt_allele,
+#                   rsid = nv.rsid::integer
+#     FROM new_values nv
+#     WHERE s.chr::text = nv.chr AND s.pos = nv.pos::integer
+#     RETURNING s.*
+# )
+# INSERT INTO snpinfo (chr,pos,ref_allele,alt_allele,rsid)
+# SELECT chr,pos::integer,ref_allele,alt_allele,rsid::integer
+# FROM new_values
+# WHERE NOT EXISTS (SELECT 1
+#                   FROM upsert up
+#                   WHERE up.chr::text = new_values.chr AND up.pos = new_values.pos::integer);
+
+use warnings;
+use strict;
+
+package generate_upsert;
+
+use Params::Validate qw(validate_with :types);
+
+sub generate_upsert{
+    my %param = validate_with(params => \@_,
+                              spec => {table => SCALAR,
+                                       keys  => {type => ARRAYREF,
+                                                },
+                                       columns => {type => ARRAYREF,
+                                                  },
+                                      },
+                             );
+    my @keys = map {ref($_)?$_->[0]:$_} @{$param{keys}};
+    my @cols = map {ref($_)?$_->[0]:$_} @{$param{columns}};
+    my %cols_types;
+    @cols_types{@keys,@cols} = map {ref($_)?($_->[0].'::'.$_->[1]):$_} @{$param{keys}},@{$param{columns}};
+    my $cols = join(',',@keys,@cols);
+    my $cols_types = join(',',map{$cols_types{$_}} @cols);
+    my $placeholders = join(',',('?') x (@cols + @keys));
+    my $set = join(",\n",map {qq($_ = new_values.$cols_types{$_})} @cols);
+    my $where_up = join(' AND ',map {qq(up.$cols_types{$_} = new_values.$cols_types{$_})} @keys);
+    my $where_set = join(' AND ',map {qq(t.$cols_types{$_} = new_values.$cols_types{$_})} @keys);
+return <<"END";
+WITH new_values ($cols) AS (
+  VALUES
+     ($placeholders)
+),
+upsert AS
+( 
+    UPDATE $param{table} t
+        SET $set
+    FROM new_values
+    WHERE $where_set
+    RETURNING t.*
+)
+INSERT INTO $param{table} ($cols)
+SELECT $cols_types
+FROM new_values
+WHERE NOT EXISTS (SELECT 1
+                  FROM upsert up
+                  WHERE $where_up);
+END
+}
+
+
+1;