Can you color Ratty?
___
/ \\
______ \ //
/ \/ o \
________/ \
\_ \__\ \-----o
\____|\__|
my $h = {};
$h->{ "key1" } = 10;
$h->{ "key2" } = 20;
$h->{ "key3" } = 30;
use constant { KEY => "key2", };
my $x = KEY;
print $x , " (x)\n";
print KEY, " (KEY)\n";
print $h->{ $x }, " (x)\n"; # ok
print $h->{ KEY }, " (KEY)\n"; # error: Use of uninitialized value
I'm trying to capture data from user-input. The below regex captures only the 1st and last parts of the details, i.e., the schema1 data and the schema 3 data. How can I capture also the middle part, the schema2 data. (Eventually it should be able to capture a dozen or so of these lines so that I can create a SQL statement out of that)
#!/usr/bin/env perl
use strict;
use warnings;
my $ls = '';
my $str2 = "(schema1.table1(ratio:1.2-1.5))
union(column)
(schema2.table2(ratio:1.3-1.6))
union(column)
(schema3.table3(ratio:1.4-1.8))
";
my $re = '
^
[\s\n]*
# group 1
(
[(]
([\w]+) # schema name
[.]
([\w]+) # table name
(?:
[(]
( ratio | unique ) # condition
[:=]
([\d.]+)
(?:-([\d.]+) )?
[)]
)
[)]
[\n]
)
(?:
(?: ( union | intersect | except | minus ) )
[(]
([\w]+)
[)]
[\n]
(
[(]
([\w]+) # schema name
[.]
([\w]+) # table name
(?:
[(]
( ratio | unique ) # condition
[:=]
([\d.]+)
(?:-([\d.]+) )?
[)]
)
[)]
[\n]
)
# \g{1}
)+
# [\n*]*
$
';
for my $s ($str2) {
if ($s =~ m/${re}/xsm) {
for (my$i=0;$i<scalar(@-);$i++) {
$ls .= "-- $i: [" . $+[$i] ."] [" . substr($s, $-[$i], $+[$
+i] - $-[$i] ) . "]\n";
}
print $ls, "\n";
}
else {
print "-- no match\n";
}
print "\n";
print ">>>", $s, "<<<\n";
}
# captured output:
-- 0: [124] [(schema1.table1(ratio:1.2-1.5))
union(column)
(schema2.table2(ratio:1.3-1.6))
union(column)
(schema3.table3(ratio:1.4-1.8))
]
-- 1: [32] [(schema1.table1(ratio:1.2-1.5))
]
-- 2: [8] [schema1]
-- 3: [15] [table1]
-- 4: [21] [ratio]
-- 5: [25] [1.2]
-- 6: [29] [1.5]
-- 7: [83] [union]
-- 8: [90] [column]
-- 9: [124] [(schema3.table3(ratio:1.4-1.8))
]
-- 10: [100] [schema3]
-- 11: [107] [table3]
-- 12: [113] [ratio]
-- 13: [117] [1.4]
-- 14: [121] [1.8]
# note: schema2 and its detail is missing
# t/02_free_unref_scalar.t complains
# eerlijk gezegd was dat daarnet, voor je nieuwe fix, ook al.
# Zoals je ziet gaat t/20_createdrop.t nu ok. Bedankt!
# ik begrijp niet precies wat 02_free_unref_scalar.t doet of test.
# als ik de $SIG{__WARN__} sub outcomment verloopt het zonder probleme
+n
# maar dat zal het test-doel wel voorbijschieten...
$ perl Makefile.PL && make && make test
Enable the use of /tmp for tests? [y] y
Checking if your kit is complete...
Looks good
Generating a Unix-style Makefile
Writing Makefile for DBD::CSV
Writing MYMETA.yml and MYMETA.json
cp lib/DBD/CSV/GetInfo.pm blib/lib/DBD/CSV/GetInfo.pm
cp lib/DBD/CSV.pm blib/lib/DBD/CSV.pm
cp lib/Bundle/DBD/CSV.pm blib/lib/Bundle/DBD/CSV.pm
cp lib/DBD/CSV/TypeInfo.pm blib/lib/DBD/CSV/TypeInfo.pm
Manifying 2 pod documents
PERL_DL_NONLAZY=1 "/opt/perl-5.26/bin/perl" "-MExtUtils::Command::MM"
+"-MTest::Harness" "-e" "undef *Test::Harness::Switches; test_harness(
+0, 'blib/lib', 'blib/arch')" t/*.t
t/02_free_unref_scalar.t .. 194/405
# Failed test 'there was an attempt to free unreferenced scalar'
# at /opt/perl-5.26/lib/5.26.0/Test/Builder.pm line 135.
# Attempt to free unreferenced scalar: SV 0x1921a18 during global dest
+ruction.
t/02_free_unref_scalar.t .. All 405 subtests passed
t/10_base.t ............... 2/? # Showing relevant versions (DBI_SQL_N
+ANO = not set)
# Using DBI version 1.636
# Using DBD::File version 0.44
# Using SQL::Statement version 1.412
# Using Text::CSV_XS version 1.29
# DBD::CSV 0.50 using Text::CSV_XS (1.29)
# DBD::File 0.44 using IO::File (1.16)
# DBI::DBD::SqlEngine 0.06 using SQL::Statement 1.412
# DBI 1.636
# OS linux (2.6.32-504.1.3.el6.x86_64)
# Perl 5.026000 (x86_64-linux)
t/10_base.t ............... ok
t/11_dsnlist.t ............ ok
t/20_createdrop.t ......... ok
t/30_insertfetch.t ........ ok
t/31_delete.t ............. ok
t/32_update.t ............. ok
t/40_numrows.t ............ ok
t/41_nulls.t .............. ok
t/42_bindparam.t .......... ok
t/43_blobs.t .............. ok
t/44_listfields.t ......... ok
t/48_utf8.t ............... ok
t/50_chopblanks.t ......... ok
t/51_commit.t ............. ok
t/55_dir_search.t ......... ok
t/60_misc.t ............... ok
t/61_meta.t ............... ok
t/70_csv.t ................ ok
t/71_csv-ext.t ............ ok
t/72_csv-schema.t ......... ok
t/73_csv-case.t ........... ok
t/80_rt.t ................. ok
t/85_error.t .............. ok
Test Summary Report
-------------------
t/02_free_unref_scalar.t (Wstat: 0 Tests: 406 Failed: 1)
Failed test: 406
Parse errors: Bad plan. You planned 405 tests but ran 406.
Files=24, Tests=1169, 9 wallclock secs ( 0.30 usr 0.08 sys + 7.02 c
+usr 0.84 csys = 8.24 CPU)
Result: FAIL
Failed 1/24 test programs. 1/1169 subtests failed.
make: *** [test_dynamic] Error 255
Can you color Ratty?
___
/ \\
______ \ //
/ \/ o \
________/ \
\_ \__\ \-----o
\____|\__|
use strict;
use warnings;
my $regex_orig = qr{(?:^.* Electronic \s* Signature\(s\)\n)?
(?:.* Signed \s* By:.* \n?
(?:Date: \s* \S .*\n
|Date:\n
(?:\s* \S .*\n)+
)+
)+
(.*)
(?:Entered \s* By:.*)?}xmi;
my $regex_fixed = qr{(?:^.* Electronic \s* Signature\(s\)\n)?
(?:.* Signed \s* By:.* \n?
(?:Date: \s* \S .*\n
|Date:\n
)+
)+
(?:\s* \S .*\n)+
(?:Entered \s* By:.*)?}xmi;
my $input_data = "Electronic Signature(s)
Signed By:
Date:
Myself, Me 08/01/2014 12:18:41 PM
Myself, Me 08/01/2014 12:18:42 PM
Them
Entered By: Myself, Me on 08/01/2014 8:44:43 AM";
my $input_data2 = "Electronic Signature(s)
Signed By: Myself, Me
Date: 08/01/2014 12:18:41 PM
Signed By: Myself, Me
Date: 08/01/2014 12:18:42 PM
7/31/2014 3:51:51 PM Version Signed By:
Date:
Myself, Me 7/31/2014 4:07:12 PM
Myself, Me 7/31/2014 4:07:12 PM
7/31/2014 2:40:50 PM Version Signed By:
Date:
Myself, Me 7/31/2014 2:41:24 PM
Entered By: Myself, Me on 08/01/2014 8:04:05 AM";
my $found;
print "-- orig:\n";
if ($input_data2 =~ $regex_orig) {
$found = substr($input_data2, $-[0], $+[0]-$-[0]);
}
print $found . "\n\n\n";
print "-- fixed:\n";
if ($input_data2 =~ $regex_fixed) {
$found = substr($input_data2, $-[0], $+[0]-$-[0]);
}
print $found . "\n";
output:
-- orig:
Electronic Signature(s)
Signed By: Myself, Me
Date: 08/01/2014 12:18:41 PM
Signed By: Myself, Me
Date: 08/01/2014 12:18:42 PM
7/31/2014 3:51:51 PM Version Signed By:
Date:
Myself, Me 7/31/2014 4:07:12 PM
Myself, Me 7/31/2014 4:07:12 PM
-- fixed:
Electronic Signature(s)
Signed By: Myself, Me
Date: 08/01/2014 12:18:41 PM
Signed By: Myself, Me
Date: 08/01/2014 12:18:42 PM
7/31/2014 3:51:51 PM Version Signed By:
Date:
Myself, Me 7/31/2014 4:07:12 PM
Myself, Me 7/31/2014 4:07:12 PM
7/31/2014 2:40:50 PM Version Signed By:
Date:
Myself, Me 7/31/2014 2:41:24 PM
Entered By: Myself, Me on 08/01/2014 8:04:05 AM
Trying to load dblp.org
http://dblp.uni-trier.de/xml/dblp.xml.gz
# Problem was: I want no 'ä' in the database (which is a utf8 data
+base).
# Solution was HTML::Entities qw/decode_entities/;
#!/bin/sh
time zcat ~/dl/dblp.uni-trier.de/xml/dblp.xml.gz \
| perl -MEncode -MHTML::Entities -ne '
if( m/^<title>([^\n]*)<.title>/ ) {
my $title = $1;
$title =~ s{\\}{}g;
next if ($title eq "Home Page"
|| $title eq "Editorial."
|| $title eq "Preface."
|| $title eq "Introduction."
|| $title eq "Foreword."
|| $title eq "Guest Editorial."
|| $title eq "Book Reviews."
);
print encode("UTF8", (decode_entities($title) . "\n" ), Encode
+::FB_CROAK);
}' \
| psql -c "
drop table if exists dblp;
create table dblp (title text);
copy dblp from stdin;
" ;
echo "select count(*) from dblp " | psql ;
echo "select * from dblp where position ('&' in title) > 0 limit 40"
+ | psql ;
----------------------------------------------------
-- data of the OP:
select * from (values(1,'A'),(2,'A'),(3,'A'),(3,'B'),(4,'B')) as f(id,
+ type);
select *
from (
select id
, sum(case type when 'A' then 1 else 0 end) as a_count
, sum(case type when 'B' then 1 else 0 end) as b_count
from (values(1,'A'),(2,'A'),(3,'A'),(3,'B'),(4,'B')) as f1(id, ty
+pe) -- your_table
group by 1
) as f2
where a_count > 0 and b_count > 0;
----------------------------------------------------
--
-- Windows dev Install:
--
Installing postgres on windows as a unpriviledged user (avoiding the n
+ecessity of administrator rights):
-- dependency: Visual C Runtime dynamic library (msvcredist_x64)
(so if necessary install this first)
-- download zip file;
https://www.enterprisedb.com/download-postgresql-binaries
"Binaries from installer Version 11.5"
-- unzip the pgsql directory somewhere, and cd into it:
cd pgsql
-- run initdb:
bin\initdb -D 11\data
-- to start postgres:
"bin\pg_ctl" -D "11/data" -l logfile start
-- to stop: close all connections, and then run:
"bin\pg_ctl" -D "11/data" -l logfile stop
default port will be: 5432
(Install DBI + DBD::Pg to connect via perl )
I ran this on a rather old win2k, but it will probably also work on ne
+wer windows.
(tweak the slashes a bit and it will work on linux too (with the prope
+r file download, of course))
perl -MDBI -Mstrict -e 'my$dbh=DBI->connect("dbi:Pg:port=5432;db=postg
+res;", undef, undef,{RaiseError=>1}); print $dbh, "\n"';
output:
DBI::db=HASH(0x1b5a808)
-> apparently the connection succeeded
|
