Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

erix's scratchpad

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

Added still later: I found the problem (xlsx2csv, line 48). The 's' is specified both for + infile (s='sheet'?) and separator. This line: "s|sep=s" => \ my $opt_s, should be made to be: "sep=s" => \ my $opt_s, because the s is already in use, higher up, for the infile name "i|s|in=s" => \ my $xls, (perhaps the 's' could be removed there instead) (I have not looked at the other programs, they might suffer the same a +mbiguity) Added later: Interesting: $ xlsx2csv --version Duplicate specification "s|sep=s" for option "s" xlsx2csv [3.9] ----- /home/aardvark/perl-5.39/bin/perl This is perl 5, version 39, subversion 6 (v5.39.6 (v5.39.5-49-gcf76a26 +6bc)) built for x86_64-linux-thread-multi mymod = Text::CSV_XS::VERSION module = Text::CSV_XS perl = 5.39.6 Text::CSV_XS::VERSION = 1.53 ----- BUG (I think): A stray error message "Duplicate specification "s|sep=s" for option "s +"" Afterward everything seems fine. Still, maybe it can be fixed. # repeat : I have no Windows or Excel so with LibreOffice (6.2) I made a simple 3 +-line .xlsx file with 2 data lines, 1 header line (saved in ~/tmp/tes +t.xlsx). Then: $ inf=~/tmp/test.xlsx ; outf=~/tmp/test.csv ; xlsx2csv -U -s \\t -o "$ +{outf}" -i "${inf}" Duplicate specification "s|sep=s" for option "s" <-- culprit Converting /home/aardvark/tmp/test.xlsx to /home/aardvark/tmp/test.csv + ... 3 x 3 # yet, all seems fine: $ less ~/tmp/test.csv head1 head2 head3 A1 B1 C1 A2 B2 C2
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

Newest Nodes
Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others imbibing at the Monastery: (3)
As of 2025-07-20 12:41 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?
    erzuuliAnonymous Monks are no longer allowed to use Super Search, due to an excessive use of this resource by robots.