Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

erix's scratchpad

by erix (Parson)
on Oct 15, 2004 at 21:01 UTC ( #399662=scratchpad: print w/replies, xml ) Need Help??

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 '&auml' 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
Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (12)
As of 2019-10-23 15:35 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Notices?