Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

Seekers of Perl Wisdom

( #479=superdoc: print w/replies, xml ) Need Help??

If you have a question on how to do something in Perl, or you need a Perl solution to an actual real-life problem, or you're unsure why something you've tried just isn't working... then this section is the place to ask. Post a new question!

However, you might consider asking in the chatterbox first (if you're a registered user). The response time tends to be quicker, and if it turns out that the problem/solutions are too much for the cb to handle, the kind monks will be sure to direct you here.

User Questions
No Clickable button with name.... in WWW::Scripter
1 direct reply — Read more / Contribute
by trahulprajapati
on Jun 28, 2017 at 14:53

    Hello Everyone

    I'm facing an issue while clicking the button after login to the webpage

    What I want to do is , First login to the webpage then click the OK button. I'm using WWW::Scripter(plugin javascript) as login page is using javascript while loading.

    Here is the code that I have tried

    use strict; use warnings; use WWW::Scripter; my $username = "abc"; my $password = "abc\@123"; my $w= WWW::Scripter->new( cookie_jar => { autosave => 1} ); $w->use_plugin('JavaScript'); $w->get('abc.xyz.com'); $w->submit_form( with_fields => { username => $username, password => $ +password }); print $w->title(); #Till here it is working, I'm able to login ############## Clicking OK button ################ $w->click(name=>'successOK'); print $w->title(); #it is giving me that no clickable button with name successOK

    Here is OK button code

    <div id="srv_successok"><input type="button" name="successOK" value=" + OK " onClick="redir();"></div>

    Please suggest how can I resolve it

    Thank you

execute if date is greater then 2hours
2 direct replies — Read more / Contribute
by snehit.ar
on Jun 28, 2017 at 03:11
    Want to compare 2 date and if hour is more then 2 hours then its should enter if condition and perform the action .
    #!/usr/bin/perl use warnings; use strict; use DateTime; use DateTime::Duration; # my $file = 'C:/Users/snehit.rahate/Perl/events.xml'; # #my $xpath = q{//custom_attribute_list/custom_attribute[normalize-sp +ace(name)='SLB_SSRID']/value}; # my $xp = XML::XPath->new(filename=>$file); # my $nodeset = $xp->find("//custom_attribute_list/custom_attribute[no +rmalize-space(name)='SLB_SSRID']/value"); # for my $node ($nodeset->get_nodelist) { # print " XML::XPath: ",$node->string_value,"\n"; # } use DateTime::Format::Duration; my $dtnow = DateTime->now; $dtnow =~ s/T/ /; $dtnow =~ m/(\d+)-(\d+)-(\d+)\s(\d+):(\d+):(\d+)/gi; my $now_hour = $4; my $now_minute = $5; my $now_second = $6; my $dtevent = '2017-06-15 13:14:31'; $dtevent =~ m/(\d+)-(\d+)-(\d+)\s(\d+):(\d+):(\d+)/gi; my $event_hour = $4; my $event_minute = $5; my $event_second = $6; my $diffhour = $now_hour - $event_hour; my $diffminute = $now_minute - $event_minute; my $diffsecond = $now_second - $event_second; my $event_time = $diffhour.":".$diffminute.":".$diffsecond; print $event_time; if ($event_time > "2:00:00") { print "Start the service if time is more then 2 hours"; }
    Error :Argument "2:00:00" isn't numeric in numeric gt (>) at test.pl line 37. Argument "-6:-8:15" isn't numeric in numeric gt (>) at test.pl line 37. -6:-8:15
Minimally changing combinations
5 direct replies — Read more / Contribute
by Yary
on Jun 28, 2017 at 03:08
    There are a few modules on CPAN for generating combinations. For example given the lists
    [ 'a','b','c' ] , [ 1, 2 ]
    they produce

    a 1
    a 2
    b 1 # two changes this iteration
    b 2
    c 1 # two changes this iteration
    c 2
    

    There's another ordering, where only one position at a time changes. And there's a name for that ordering which I've forgotten, so I haven't been able to search CPAN for it. It would produce the tuples in an order like so:

    a 1
    a 2
    b 2
    b 1
    c 1
    c 2
    

    Can anyone refresh my memory as to what that ordering is called, and as a bonus, find me a module on CPAN that already produces combinations that way?

    ... I have tried the the obvious keywords "permute" and "combination" on metacpan but suspect I'm missing the right word... yes I could implement it from scratch, or take the output of one of the CPAN modules and reverse some records to get the desired ordering. But why re-invent a wheel, if it's already been invented.

Replace value in the text file
4 direct replies — Read more / Contribute
by mhoang
on Jun 28, 2017 at 01:17

    Hello guys, I have two text files: file1.txt

    "A123","valueA1","valueB1" "B234","valueA2","valueB2" "C345","valueA3","valueB3" "D456","valueA4","valueB4" "E567","valueA5","valueB5" "F678","valueA6","valueB6"
    file2.txt
    "C345","valueX1","valueY1" "D456","valueX2","valueY2"
    I want to replace the value in file 1 with the second column value in file 2 if the key is matched.
    "A123","valueA1","valueB1" "B234","valueA2","valueB2" "C345","valueX1","valueB3" "D456","valueX2","valueB4" "E567","valueA5","valueB5" "F678","valueA6","valueB6"
    and here is my code, but I actually don't know how to write back to file1 with new value. Pls shed some light into it thanks.

    #!/usr/bin/perl #use strict; #use warnings; open fh1,"<C:/Perl-Script/file1.txt"; open fh2,"<C:/Perl-Script/file2.txt"; open fh3,">>C:/Perl-Script/file3.txt"; @a=<fh1>; @b=<fh2>; foreach $b(@b) { @k = split ' ', $b; $hash2{$k[0]} = $k[1]; } foreach $a(@a) { @k = split ' ', $a; $hash1{$k[0]} = $k[1]; } while(($k,$v)= each %hash1) {$hash1{$k} = $hash2{$k} if (exists $hash2{$k})}; foreach $value (@a) { print fh1 $value; }
SELECT LAST_INSERT_ID does not work
6 direct replies — Read more / Contribute
by Vagabundo
on Jun 28, 2017 at 00:49
    Hi, I have two scripts using the same mysql-database with DBI and the same table. One of this scripts add sometimes a lot of inserts.
    The other script than has a problem to get the correct LAST_INSERT_ID.
    It looks like the busy script makes entries at the same time between my Insert and my SELECT LAST_INSERT_ID.
    Is that real possible and how can I prevent it.

    My Code is:
    my $sthopen = $dbh->prepare("INSERT INTO..... $sthopen->execute; &ErrorDBI; my $resid = $dbh->prepare("SELECT LAST_INSERT_ID()"); $resid->execute; &ErrorDBI; my @idrow = $resid->fetchrow_array;
    for example:

    The auto_increment entry is 2201 and the last_insert is 2203
    or 2504 and 2505
    and so on.....
    Has anybody an idea for an solution?
perl6 install fail
2 direct replies — Read more / Contribute
by freakcoco
on Jun 28, 2017 at 00:07

    I try to build perl6 on my ubuntu system(version => "Ubuntu 15.04",architectures=>ARM Cortex-A7)

    sudo apt-get install build-essential git libssl-dev git clone https://github.com/tadzik/rakudobrew ~/.rakudobrew echo 'export PATH=~/.rakudobrew/bin:$PATH' >> ~/.bashrc source ~/.bashrc rakudobrew build moar

    when i build moar I got this :

    ###############################################################################
    e4f3358fa81b8359fab2eb4dd3fb32e8eace8799 HEAD is now at e4f3358... Make Any (-) Map|Iterable about 2x faster ATTENTION: no --prefix supplied, building and installing to /home/oran +gepi/.rakudobrew/moar-nom/install sh: 1: /home/orangepi/.rakudobrew/moar-nom/install/bin/nqp-m: not foun +d HEAD is now at 0b45398... Stub setbuffersizefh for JVM. Building NQP ... /usr/bin/perl Configure.pl --prefix=/home/orangepi/.rakudobrew/moar-no +m/install --backends=moar --make-install --git-protocol=https --git-r +eference=/home/orangepi/.rakudobrew/bin/../git_reference --gen-moar Creating tools/build/install-jvm-runner.pl ... Can't exec "/home/orangepi/.rakudobrew/moar-nom/install/bin/moar": No +such file or directory at tools/lib/NQP/Configure.pm line 287. Use of uninitialized value $moar_version_output in pattern match (m//) + at tools/lib/NQP/Configure.pm line 300. HEAD is now at 7405dfa... Implement output buffering for sync file han +dles. Configuring and building MoarVM ... /usr/bin/perl Configure.pl --optimize --prefix=/home/orangepi/.rakudob +rew/moar-nom/install --make-install Welcome to MoarVM! Updating submodules .................................... OK Configuring native build environment ................... OK trying to compile a simple C program ............... YES probing whether your compiler thinks that it is gcc YES probing how your compiler does static inline ....... static __inli +ne__ your CPU can read unaligned values for only int32 probing the size of pointers ....................... 4 JIT isn't supported on platforms with 4 byte pointers. probing C type support for: _Bool, bool ............ YES: _Bool,bo +ol probing computed goto support ...................... YES probing pthread_yield support ...................... NO probing support of rdtscp intrinsic ................ NO make: make compile: gcc -Wdeclaration-after-statement -Werror=declaration-af +ter-statement -O3 -DNDEBUG -D_REENTRANT -D_FILE_OFFSET_BITS=64 -fPIC includes: -I3rdparty/libuv/include -I3rdparty/libuv/src -I3rdpart +y/libatomic_ops/src -I3rdparty/libtommath -I3rdparty/dynasm -I3rdpart +y/dyncall/dynload -I3rdparty/dyncall/dyncall -I3rdparty/dyncall/dynca +llback link: gcc -O3 -DNDEBUG -Wl,-rpath,"/@libdir@" libs: -lm -lpthread -lrt -ldl byte order: little endian Configuring 3rdparty libs .............................. OK 3rdparty: 3rdparty/dyncall/dyncall/libdyncall_s.a 3rdparty/dyncall/dyncallback/libdyncallback_s.a 3rdparty/dyncall/dynload/libdynload_s.a 3rdparty/libatomic_ops/src/libatomic_ops.a 3rdparty/libtommath/libtommath.a 3rdparty/libuv/libuv.a 3rdparty/sha1/libsha1.a 3rdparty/tinymt/libtinymt.a Generating src/gen/config.c ............................ OK Generating src/gen/config.h ............................ OK Generating Makefile .................................... OK Generating tools/check.mk .............................. OK Generating build/mk-moar-pc.pl ......................... OK Configuration SUCCESS. Type 'make' to build and 'make help' to see a list of available make targets. compiling src/main.o compiling src/core/callsite.o compiling src/core/args.o compiling src/core/exceptions.o src/core/exceptions.c: In function ‘handler_can_handle’: src/core/exceptions.c:79:57: warning: cast from pointer to integer of +different size [-Wpointer-to-int-cast] MVMuint64 block_label = block_has_label ? (MVMuint64)(f +->work[fh->label_reg].o) : 0; ^ src/core/exceptions.c:80:49: warning: cast from pointer to integer of +different size [-Wpointer-to-int-cast] MVMuint64 thrown_label = payload ? (MVMuint64)payload : +0; ^ compiling src/core/interp.o src/core/interp.c: In function ‘MVM_interp_run’: src/core/interp.c:1878:42: warning: cast from pointer to integer of di +fferent size [-Wpointer-to-int-cast] GET_REG(cur_op, 0).i64 = (MVMint64)GET_REG(cur_op, 2) +.o; ^ src/core/interp.c:5622:39: warning: cast to pointer from integer of di +fferent size [-Wint-to-pointer-cast] char *cache = (char *)MVM_BC_get_I64(cur_op, +12); ^ compiling src/core/threadcontext.o compiling src/core/compunit.o compiling src/core/bytecode.o compiling src/core/frame.o compiling src/core/callstack.o compiling src/core/validation.o compiling src/core/bytecodedump.o compiling src/core/threads.o compiling src/core/ops.o compiling src/core/hll.o compiling src/core/loadbytecode.o compiling src/math/num.o compiling src/core/coerce.o compiling src/core/dll.o compiling src/core/ext.o compiling src/core/nativecall.o compiling src/core/nativecall_dyncall.o src/core/nativecall_dyncall.c: In function ‘MVM_nativecall_invoke’: src/core/nativecall_dyncall.c:786:25: warning: cast from pointer to in +teger of different size [-Wpointer-to-int-cast] (MVMint64)*(DCpointer *)free_rws[num_rws]); ^ compiling src/core/continuation.o compiling src/core/intcache.o compiling src/core/fixedsizealloc.o compiling src/core/regionalloc.o compiling src/gen/config.o compiling src/gc/orchestrate.o compiling src/gc/allocation.o compiling src/gc/worklist.o compiling src/gc/roots.o compiling src/gc/collect.o compiling src/gc/gen2.o compiling src/gc/wb.o compiling src/gc/objectid.o src/gc/objectid.c: In function ‘MVM_gc_object_id’: src/gc/objectid.c:11:14: warning: cast from pointer to integer of diff +erent size [-Wpointer-to-int-cast] id = (MVMuint64)obj; ^ src/gc/objectid.c:33:14: warning: cast from pointer to integer of diff +erent size [-Wpointer-to-int-cast] id = (MVMuint64)entry->gen2_addr; ^ compiling src/gc/finalize.o compiling src/gc/debug.o compiling src/io/io.o compiling src/io/eventloop.o compiling src/io/syncfile.o compiling src/io/syncstream.o compiling src/io/syncpipe.o compiling src/io/syncsocket.o compiling src/io/fileops.o compiling src/io/dirops.o compiling src/io/procops.o compiling src/io/timers.o compiling src/io/filewatchers.o compiling src/io/signals.o compiling src/io/asyncsocket.o compiling src/io/asyncsocketudp.o compiling src/6model/reprs.o compiling src/6model/reprconv.o compiling src/6model/containers.o compiling src/6model/parametric.o compiling src/6model/reprs/MVMString.o compiling src/6model/reprs/VMArray.o compiling src/6model/reprs/MVMHash.o compiling src/6model/reprs/MVMCFunction.o compiling src/6model/reprs/KnowHOWREPR.o compiling src/6model/reprs/KnowHOWAttributeREPR.o compiling src/6model/reprs/P6str.o compiling src/6model/reprs/P6opaque.o compiling src/6model/reprs/MVMCode.o compiling src/6model/reprs/MVMOSHandle.o compiling src/6model/reprs/MVMCompUnit.o compiling src/6model/reprs/MVMStaticFrame.o compiling src/6model/reprs/P6int.o compiling src/6model/reprs/P6num.o compiling src/6model/reprs/Uninstantiable.o compiling src/6model/reprs/HashAttrStore.o compiling src/6model/reprs/MVMThread.o compiling src/6model/reprs/MVMIter.o compiling src/6model/reprs/MVMContext.o compiling src/6model/reprs/SCRef.o compiling src/6model/reprs/Lexotic.o compiling src/6model/reprs/MVMCallCapture.o compiling src/6model/reprs/P6bigint.o compiling src/6model/reprs/NFA.o compiling src/6model/reprs/MVMException.o compiling src/6model/reprs/MVMDLLSym.o compiling src/6model/reprs/MVMMultiCache.o compiling src/6model/reprs/MVMContinuation.o compiling src/6model/reprs/NativeCall.o compiling src/6model/reprs/CPointer.o compiling src/6model/reprs/CStr.o compiling src/6model/reprs/CArray.o compiling src/6model/reprs/CStruct.o compiling src/6model/reprs/CUnion.o compiling src/6model/reprs/ReentrantMutex.o compiling src/6model/reprs/ConditionVariable.o compiling src/6model/reprs/Semaphore.o compiling src/6model/reprs/ConcBlockingQueue.o compiling src/6model/reprs/MVMAsyncTask.o compiling src/6model/reprs/MVMNull.o compiling src/6model/reprs/CPPStruct.o compiling src/6model/reprs/NativeRef.o compiling src/6model/reprs/MultiDimArray.o compiling src/6model/reprs/Decoder.o compiling src/6model/6model.o compiling src/6model/bootstrap.o compiling src/6model/sc.o compiling src/6model/serialization.o compiling src/mast/compiler.o compiling src/mast/driver.o compiling src/spesh/dump.o compiling src/spesh/graph.o compiling src/spesh/codegen.o compiling src/spesh/candidate.o compiling src/spesh/manipulate.o compiling src/spesh/args.o compiling src/spesh/facts.o compiling src/spesh/optimize.o src/spesh/optimize.c: In function ‘optimize_coverage_log’: src/spesh/optimize.c:1230:26: warning: cast to pointer from integer of + different size [-Wint-to-pointer-cast] char *cache = (char *)ins->operands[3].lit_i64; ^ compiling src/spesh/deopt.o compiling src/spesh/log.o compiling src/spesh/threshold.o compiling src/spesh/inline.o compiling src/spesh/osr.o compiling src/spesh/lookup.o compiling src/jit/graph.o src/jit/graph.c: In function ‘jgb_consume_ins’: src/jit/graph.c:1910:59: warning: cast from pointer to integer of diff +erent size [-Wpointer-to-int-cast] { MVM_JIT_LITERAL_PTR, { (MVMint64)h +ll_config } }, ^ src/jit/graph.c:2382:59: warning: cast from pointer to integer of diff +erent size [-Wpointer-to-int-cast] { MVM_JIT_LITERAL_PTR, { (MVMint64)" +decodertakeline" } } }; ^ compiling src/jit/compile.o src/jit/compile.c: In function ‘MVM_jit_enter_code’: src/jit/compile.c:138:18: warning: format ‘%lu’ expects argument of ty +pe ‘long unsigned int’, but argument 5 has type ‘size_t’ [-Wformat=] tc->cur_frame->sequence_nr, code->seq_nr); ^ src/jit/compile.c:138:18: warning: format ‘%li’ expects argument of ty +pe ‘long int’, but argument 6 has type ‘int’ [-Wformat=] compiling src/jit/log.o compiling src/strings/decode_stream.o compiling src/strings/ascii.o compiling src/strings/parse_num.o compiling src/strings/utf8.o compiling src/strings/utf8_c8.o compiling src/strings/nfg.o compiling src/strings/ops.o compiling src/strings/unicode.o compiling src/strings/normalize.o compiling src/strings/latin1.o compiling src/strings/utf16.o compiling src/strings/windows1252.o compiling src/math/bigintops.o compiling src/profiler/instrument.o src/profiler/instrument.c: In function ‘dump_call_graph_node’: src/profiler/instrument.c:359:23: warning: cast from pointer to intege +r of different size [-Wpointer-to-int-cast] box_i(tc, (MVMint64)pcn->sf)); ^ src/profiler/instrument.c:375:23: warning: cast from pointer to intege +r of different size [-Wpointer-to-int-cast] box_i(tc, (MVMint64)pcn->native_target_name)); ^ src/profiler/instrument.c:436:68: warning: cast from pointer to intege +r of different size [-Wpointer-to-int-cast] MVM_repr_bind_key_o(tc, alloc_info, pds->id, box_i(tc, (M +VMint64)type)); ^ compiling src/profiler/log.o src/profiler/log.c: In function ‘MVM_profile_log_allocated’: src/profiler/log.c:230:31: warning: cast from pointer to integer of di +fferent size [-Wpointer-to-int-cast] MVMuint32 distance = ((MVMuint64)tc->nursery_alloc - (MVMuint +64)obj); ^ src/profiler/log.c:230:62: warning: cast from pointer to integer of di +fferent size [-Wpointer-to-int-cast] MVMuint32 distance = ((MVMuint64)tc->nursery_alloc - (MVMuint +64)obj); ^ src/profiler/log.c:238:13: warning: cast from pointer to integer of di +fferent size [-Wpointer-to-int-cast] if ((MVMuint64)obj > (MVMuint64)tc->nursery_tospace && distan +ce <= obj->header.size && obj != ptd->last_counted_allocation) { ^ src/profiler/log.c:238:30: warning: cast from pointer to integer of di +fferent size [-Wpointer-to-int-cast] if ((MVMuint64)obj > (MVMuint64)tc->nursery_tospace && distan +ce <= obj->header.size && obj != ptd->last_counted_allocation) { ^ compiling src/profiler/profile.o compiling src/profiler/heapsnapshot.o compiling src/profiler/telemeh.o compiling src/instrument/crossthreadwrite.o compiling src/instrument/line_coverage.o src/instrument/line_coverage.c: In function ‘instrument_graph’: src/instrument/line_coverage.c:135:36: warning: cast from pointer to i +nteger of different size [-Wpointer-to-int-cast] ins->operands[3].lit_i64 = (MVMint64)line_report_store; ^ compiling src/platform/sys.o compiling src/moar.o compiling src/platform/posix/mmap.o compiling src/platform/posix/time.o compiling src/jit/stub.o building dyncall... In file included from dyncall_callvm.c:57:0: dyncall_callvm_arm32_arm_armhf.c: In function ‘a_double’: dyncall_callvm_arm32_arm_armhf.c:119:5: error: ISO C90 forbids mixed d +eclarations and code [-Werror=declaration-after-statement] union { ^ cc1: some warnings being treated as errors make[2]: *** [dyncall_callvm.o] Error 1 make[1]: *** [libdyncall] Error 2 Makefile:614: recipe for target '3rdparty/dyncall/dyncall/libdyncall_s +.a' failed make: *** [3rdparty/dyncall/dyncall/libdyncall_s.a] Error 2 sh: 1: /home/orangepi/.rakudobrew/moar-nom/install/bin/moar: not found Cleaning up ... /usr/bin/perl -MExtUtils::Command -e mkpath gen/moar/stage1/gen /usr/bin/perl tools/build/gen-cat.pl moar src/how/Archetypes.nqp src/h +ow/RoleToRoleApplier.nqp src/how/NQPConcreteRoleHOW.nqp src/how/RoleT +oClassApplier.nqp src/how/NQPCurriedRoleHOW.nqp src/how/NQPParametric +RoleHOW.nqp src/how/NQPClassHOW.nqp src/how/NQPNativeHOW.nqp src/how/ +NQPAttribute.nqp src/how/NQPModuleHOW.nqp src/how/EXPORTHOW.nqp > ge +n/moar/stage1/nqpmo.nqp /home/orangepi/.rakudobrew/moar-nom/install/bin/moar --libpath=src/vm/ +moar/stage0 src/vm/moar/stage0/nqp.moarvm --bootstrap --setting=NULL +--no-regex-lib --target=mbc \ --output=gen/moar/stage1/nqpmo.moarvm gen/moar/stage1/nqpmo.nqp sh: 1: /home/orangepi/.rakudobrew/moar-nom/install/bin/moar: not found Makefile:240: recipe for target 'gen/moar/stage1/nqpmo.moarvm' failed make: *** [gen/moar/stage1/nqpmo.moarvm] Error 127 Command failed (status 512): make Command failed (status 512): /usr/bin/perl Configure.pl --prefix=/home +/orangepi/.rakudobrew/moar-nom/install --backends=moar --make-install + --git-protocol=https --git-reference=/home/orangepi/.rakudobrew/bin/ +../git_reference --gen-moar Failed running /usr/bin/perl Configure.pl --backends=moar --gen-moar - +-git-reference="/home/orangepi/.rakudobrew/bin/../git_reference" --ma +ke-install at /home/orangepi/.rakudobrew/bin/rakudobrew line 57. main::run("/usr/bin/perl Configure.pl --backends=moar --gen-moar - +-git-r"...) called at /home/orangepi/.rakudobrew/bin/rakudobrew line +382 main::build_impl("moar", undef, "") called at /home/orangepi/.raku +dobrew/bin/rakudobrew line 115

    how to fix this problem?

Why perl with strict allows to use -bareword?
2 direct replies — Read more / Contribute
by hurricup
on Jun 27, 2017 at 16:04

    According to docs for strict subs:

    This disables the poetry optimization, generating a compile-time error if you try to use a bareword identifier that's not a subroutine, unless it is a simple identifier (no colons) and that it appears in curly braces or on the left hand side of the => symbol.

    But use Some::Thing -base;, for example, works and not looks like example in docs. Also, it may cause a surprise, when sub with name 'base' been defined before this use.

tblastn unix
5 direct replies — Read more / Contribute
by Nicpetbio23!
on Jun 27, 2017 at 16:02
    Hi, I am trying to do a tblastn search within a perl script.

     # one genome one query unix command
     my ($failcheck) = system(“tblastn -query -db -genome -out output.blast.tab”);
     die(“Error: could not execute system command\n”) if ($failcheck != 0);

    My main question is how do I change my unix command so that I can go through a list of query and genome sequences and return the tblastn results for each?

    Eventually I plan to look for sequences that I expect to find in the protein searches, which are similar to those found in close relatives of the genome I am searching. Although this may not be relevant to the question above.
parse multiple text files keep unique lines only
4 direct replies — Read more / Contribute
by Anonymous Monk
on Jun 27, 2017 at 15:33

    Hi Monks, who are always smarter than me. I'm trying to use the following code but rather than modify just one file to contain only unique lines I'm trying to modify many files in a directory.

    I've successfully erased my data 5 times with some not so successful modifications so far so I'm seeking some wisdom. Here's the first bit of code:

    #!/usr/bin/perl –w open(INF,"db.txt"); @data = <INF>; close(INF); @sd = sort(@data); for(@sd){ push @out, $_ if (not @out) or ($out[-1] ne $_); }; open(OUTF,">outdb.txt"); print OUTF; close(OUTF);

    I'm pretty sure I'm overthinking it and the solution is very, very simple. Here's my code to find the files. See below. I just can't seem to get the two bits of code together properly.

    #find the files I want to change my @files; find( sub { return unless -f; # Files only return unless /\.txt$/; # Name must end in ".txt" push @files, $File::Find::name; }, $directory );
Very Odd Issue When Using pp to Create an .exe File Including Date::Calc
3 direct replies — Read more / Contribute
by perldigious
on Jun 27, 2017 at 10:46

    I figured out how to fix an issue I first had shortly after I began programming in Perl and that has plagued me since, but I'm at a loss to explain how this could possibly matter. This is definitely one for Monks more knowledgeable than I, and especially (I presume) those familiar with the pp module. I'm using Strawberry Perl on Windows 7, and of course can provide more information than that if necessary. I simply enter pp -o my_name.exe my_script.pl on the command line.

    When I have the following code and and am trying to use pp to make an .exe, it makes the .exe, but the .exe doesn't seem to do anything at all when run (it won't even pause on the my $pause_here = <STDIN> line here.

    #!/usr/bin/perl use utf8; use 5.022; use strict; use List::Util qw(max); use Date::Cal +c qw(Delta_Days); say "FINISHED"; my $pause_here = <STDIN>;

    However, when I do the following, it works just fine, makes the .exe, and the .exe runs and performs as expected. Yes, the only difference is the one newline after use 5.022.

    #!/usr/bin/perl use utf8; use 5.022; use strict; use List::Util qw(max); use Date::Calc qw(Delta_Days); say "FINISHED"; my $pause_here = <STDIN>;

    It's the use Date::Calc qw(Delta_Days) that always caused me trouble. Without it, and even with all the other use statements on a single line, it also all works perfectly fine.

    #!/usr/bin/perl use utf8; use 5.022; use strict; use List::Util qw(max); say "FINISHED"; my $pause_here = <STDIN>;

    Am I crazy? Can anyone else repeat this behavior or explain it?

    Now I always put one use statement per line anyway, but I had this problem in several old scripts I wrote where I wasn't yet in that habit, and I never found this as the "fix" until now. This plagued me so much until now that I literally have written and rewritten (because of course it didn't work the first time I reinvented the wheel) my own days_diff subroutine and simple single day difference test of it to deal with this.

    use utf8; use 5.022; use strict; use warnings; for (my $year=1970; $year<=2100; $year++) { for (my $month=1; $month<=12; $month++) { for (my $day=1; $day<=31; $day++) { next if ( ($month == 2 && ($day == 30 || $day == 31)) || ($month == 2 && $day == 29 && ($year%4 != 0 || ($year +%100 == 0 && $year%400 != 0))) || ($month == 4 && $day == 31) || ($month == 6 && $day == 31) || ($month == 9 && $day == 31) || ($month == 11 && $day == 31) ); my $date1 = $month. "/" . $day . "/" . $year; my $date2 = $month . "/" . ($day+1) . "/" . $year; $date2 = ($month+1) . "/1/" . $year if ( ($day+1 == 32) || ($month == 2 && ($day+1 == 30 || $day+1 == 31)) || ($month == 2 && $day+1 == 29 && ($year%4 != 0 || ($ye +ar%100 == 0 && $year%400 != 0))) || ($month == 4 && $day+1 == 31) || ($month == 6 && $day+1 == 31) || ($month == 9 && $day+1 == 31) || ($month == 11 && $day+1 == 31) ); $date2 = "1/1/" . ($year+1) if ($month+1 == 13 && $day+1 +== 32); my $difference = days_diff($date2, $date1); say "$date1\t$date2\t$difference" if ($difference != 1); } } } say "Hit Enter to quit."; my $pause = <STDIN>; sub days_diff { my ($month1, $day1, $year1) = split /\//, $_[0]; my ($month2, $day2, $year2) = split /\//, $_[1]; # The Date::Calc module function "Delta_Days" was used for this an +d worked great, but it would not compile in to an .exe using pp. # use Date::Calc qw(Delta_Days); # use is here for convenient copy +/paste # return Delta_Days($year2, $month2, $day2, $year1, $month1, $day1 +); # This crude (not precise over long timeframes or short ones spann +ing the end of February and March, but this was fine for the applicat +ion) method was used for a long time, # but it fails (in an unacceptable way) when subtracting a day tha +t falls on the 1st of the next month from a day that falls on the 31s +t the prior month (gives -0, not -1), # return sprintf("%.0f", ($year1-$year2)*365.25+($month1-$month2)* +365.25/12+($day1-$day2)); # Here a Gergorian calendar date to Julian day number conversion i +s used on both dates and then they are subtracted. # https://en.wikipedia.org/wiki/Julian_day#Converting_Julian_or_Gr +egorian_calendar_date_to_Julian_day_number use POSIX qw(floor); # use is here for convenient copy/paste my $a1 = floor((14-$month1)/12); my $a2 = floor((14-$month2)/12); my $y1 = $year1 + 4800 - $a1; my $y2 = $year2 + 4800 - $a2; my $m1 = $month1 + 12*$a1 - 3; my $m2 = $month2 + 12*$a2 - 3; my $JDN1 = $day1 + floor((153*$m1+2)/5) + 365*$y1 + floor($y1/4) - + floor($y1/100) + floor($y1/400) - 32045; my $JDN2 = $day2 + floor((153*$m2+2)/5) + 365*$y2 + floor($y2/4) - + floor($y2/100) + floor($y2/400) - 32045; return $JDN1-$JDN2; }

    Just another Perl hooker - But the purist monks keep telling me I should do it for love, not money.

Add your question
Title:
Your question:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and all is quiet...

    How do I use this? | Other CB clients
    Other Users?
    Others about the Monastery: (3)
    As of 2017-06-29 01:05 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      How many monitors do you use while coding?















      Results (653 votes). Check out past polls.