Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
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
Need Raw Binary Output
1 direct reply — Read more / Contribute
by Anonymous Monk
on Dec 05, 2016 at 15:35

    I'm generating random 32 bit integers based on Math::Random::MTwist. I want to pipe the raw binary output, but (obviously) print() won't do. Neither will syswrite() to STDOUT.

    Am I missing something simple?

Stupid UTF-8 issue with CSV file
3 direct replies — Read more / Contribute
by ultranerds
on Dec 05, 2016 at 12:48
    I'm trying to get my head around this. I have created a CSV file:

    https://steampunkjunkies.net/it_other.csv

    ...yet when I import into Amazon, the description is screwed:

    https://www.amazon.it/Steampunk-Junkies-alimentazione-connettore-micro-USB/dp/B01CO672AS/

    The .csv file shows as "ANSI as UTF-8" for me ("Encoded in UTF8, without BOM" in Notepad++) ... and Excel / LibreCalc show all the characters fine.

    I'm at a loss as to where this issue is coming from. Any suggestions are much welcome.

    The code is pretty simple:

    open (WRITE_IT,">$CFG->{admin_root_path}/amazon_template_tmp/it_other. +csv") || die "Cant write $CFG->{admin_root_path}/amazon_template_tmp/ +it_other.csv. Reason: $!"; binmode(WRITE_IT, ":utf8"); print WRITE_IT $the_contents; close(WRITEIT);


    The mySQL table is stored in UTF-8, so there shouldn't be any need to convert.

    Thanks!

    Andy
no feedback when running a script?
3 direct replies — Read more / Contribute
by flieckster
on Dec 05, 2016 at 12:32
    hello, i recently move from mac scripting to PC world. for the most part things are ok. I ran into one script where i can't seem to see whats wrong with it. when its open in padre it shows no syntax errors and when i modify the directory to that of my mac this script works fine. When I run it on my PC it just seems to sit there doing nothing. i even tried running the script right from the cmd line using perl -d C:path to .pl file. i just get this...
    Microsoft Windows [Version 6.1.7601] Copyright (c) 2009 Microsoft Corporation. All rights reserved. C:\Windows\System32>perl -d Z:\Perl\Mother\Wilsons\Upload\Wilsonsuploa +d.pl Loading DB routines from perl5db.pl version 1.49_04 Editor support available. Enter h or 'h h' for help, or 'perldoc perldebug' for more help. IO::Socket::SSL::CODE(0x3464058)(C:/Perl64/lib/IO/Socket/SSL.pm:215): 215: INIT { init() } DB<1>
    here's my script.
    #!/usr/bin/perl -w use Net::FTP; use File::Copy; use Net::SMTP; use File::Basename; use Email::Send::SMTP::Gmail; use POSIX qw(strftime); my $date = strftime("%m-%d-%y",localtime); my $time = strftime("%I:%M:%S",localtime); my $ftpdate = strftime("%m-%d-%y",localtime); #PC my $logfile = "/Users/bflieck/Documents/Wilsons_push.txt"; #mac # my $logfile = "/Users/flieckb/Documents/Wilsons_push.txt"; my $log = ">> $logfile"; #"//10.55.11.15/ ###############define all the folders in this game############## my $PSD = "//10.55.11.15/photorepos/Partners/Wilsons/Done/"; my $JPG = "//10.55.11.15/photorepos/Partners/Wilsons/2push/"; my $repos = "//10.55.11.15/photorepos/Weekly_Product_Folders/Wilsons/" +; my $reposdate = "//10.55.11.15/photorepos/Weekly_Product_Folders/Wilso +ns/$date/"; my $repospsddate = "//10.55.11.15/photorepos/Weekly_Product_Folders/Wi +lsons/$date/PSD/"; my $repostiffdate = "//10.55.11.15/photorepos/Weekly_Product_Folders/W +ilsons/$date/JPEG/"; my $mybadmatch="_s.jpg"; my $badswatches= "//10.55.11.15/photorepos/Perl/Mother/Wilsons/badswat +ches/"; ################################################################ my $current = `date +%m/%d/%Y`; chomp $current; chomp $date; #############Sort the JPG's for bad swatch files chdir( $JPG ) or warn "Cant chanage to $JPG $!"; (@upload_JPG) = glob "*"; my $upload_count_JPG = @upload_JPG; foreach my $file (@upload_JPG) { if ($file =~ m/$mybadmatch/is) { my $old = "$JPG$file"; my $new = "$badswatches"; move ($old, $new) or warn print "can't copy the badswatches $file\n"; open FILE, '>> //10.55.11.15/photorepos/Perl/Mother/Wilsons/Upload/Rem +ovedSwatches.txt' or warn $!; print FILE "$current\t$date\t$file\t"; print FILE "\n"; } else { print "these dont have to move $file\n"; } } close FILE; #get the PSD folder count chdir( $PSD ) or warn "Cant chanage to $JPG $!"; (@PSD) = glob "*"; my $PSD_count = @PSD; ########################################### chdir( $JPG ) or warn "Cant chdir to $JPG $!"; my(@file_list) = glob "*"; open FILE, "$log" or warn $!; foreach my $file (@file_list){ my $filenameonly; my $style; my $color; my $view; if ($file =~qr/\A([^_]+)_([^_]+)(?:_([^_]+))?\.([^\.]+)\z/ ) { $filenameonly = $1 .'_'. $2; $style = $1; $color = $2; $view = $3; } else { #File did not match... next; } $view = '' if (!defined($view)); print FILE "$current\t$file\t$filenameonly\t$style\t$color\t$view\tWil +sons\n"; } close FILE; #PC my $dir ="/Users/bflieck/Documents/"; #Mac # my $dir ="/Users/flieckb/Documents/"; chdir ($dir); my $filetobecopied = "Wilsons_push.txt"; my $newfile = "//10.55.11.15/photorepos/Reports/Wilsons/Wilsons_push.t +xt"; if (copy($filetobecopied, $newfile) == 0){; print"$date $time log error\n"; } else { print "$date $time log updated\n"; } ########################################## if (@upload_JPG > 0) { $ftp = Net::FTP->new('******', Debug => 1); $ftp->login('*****,'*****'); $ftp-> binary(); $ftp->cwd("GSI Images/"); chdir("GSI Images/"); if (-d "ftpdate/"){ $ftp->cwd("ftpdate/"); chdir("ftpdate/"); } else { $ftp->mkdir($ftpdate, 0777); $ftp->cwd("$ftpdate/"); chdir("$ftpdate/"); } chdir($JPG); foreach my $file (glob('*')) { $ftp->put($file) or warn $ftp->message; sleep(0); } # ################################################################ chdir($repos) or warn "i cant get to repos $!"; if (-d "$reposdate") { chdir("$reposdate") } else { mkdir($date, 0777); chdir ($reposdate); } chdir($reposdate) or warn "i cant get to reposdate $!"; if (-d "$repospsddate") { chdir("$repospsddate") } else { mkdir("PSD", 0777); chdir ($repospsddate); } chdir($reposdate) or warn "i cant get to reposdate $!"; if (-d "$repostiffdate") { chdir("$repostiffdate") } else { mkdir("JPEG", 0777); chdir ($repostiffdate); } foreach $file (@PSD) { my $old = "$PSD$file"; my $new = "$repospsddate"; move($old, $new) or warn print "Copy PSD's Failed: $!";} foreach $file (@upload_JPG) { my $old = "$JPG$file"; my $new = "$repostiffdate"; move($old, $new) or warn print "Copy JPEG's Failed: $!";} ################################################################ ################################################################ my $subject1 = "Industrial Color Studio -- PC Wilsons Image Upload $t +ime"; my $dllist='wilsonsimages@industrialcolor.com'; my $body ="Hello, below is a list of files that uploaded tonight.<br>T +here are $upload_count_JPG files pushing tonight\n\n"; my $spacer ="<br>"; my $bodylist =join "<br>\n", @upload_JPG; my ($mail,$error)=Email::Send::SMTP::Gmail->new( -smtp=>'smtp.gmail.co +m', -login=>'kopautomatio +n1@industrialcolor.com', -pass=>'*****', -port=> '25', -debug=> 1, -timeout=> 1000); $mail->send(-to=>"$dllist", -from=>"$dllist", -subject=>"$subject1", - +body=>"$body $spacer $bodylist", -contenttype=>"text/html"); $mail->bye; $ftp->close(); } else { print "noimages to push tonight"; }
Can't locate object method ""
2 direct replies — Read more / Contribute
by chris212
on Dec 05, 2016 at 11:32

    Does anyone know what may cause this error?

    Can't locate object method "" via package "IO::File" at G:\path\to\mys +cript.pl line 1189
    It happens very intermittently. I have run the script thousands of times in a loop unable to reproduce the problem, but I have seen it twice. This is line 1189:
    my $chunk = $th->join();

    That line is in an "output" thread. It is using a file handle, and will write the data contained in $chunk (2D array reference) to a file using Text::CSV_XS. The thread it is joining is one of many "worker" threads which do not use file handles. The "input" thread which starts the worker threads does use a file handle and reads a different file using Text::CSV_XS. The "input" and "output" threads both require the Text::CSV_XS module (depending on arguments passed to script), so they will both load the module rather than inherit it from the parent thread.

    Using Perl 5.18.2 on Windows. I have not seen it on Linux yet.

Memory usage while tallying instances of lines in a .txt file
4 direct replies — Read more / Contribute
by TJCooper
on Dec 05, 2016 at 11:30

    Given input data in the form of:

    c 8 336158 75 75M 74 c 12 828707 74 74M 73 w 10 528559 74 74M 0 c 15 267766 74 74M 73 c 12 828707 74 74M 73 c 14 491797 74 74M 73

    I am trying to tally the instances of records based on columns 1 (which has the header 'Strand' - this can be variable in position hence the use of List::Util qw(first)) as well as columns 2 and 3. The main chunk of code that accomplishes this is simply:

    my @headers = split("\t",<$IN>); my $index = first{$headers[$_] eq 'Strand'} 0..$#headers; while (<$IN>) { chomp $_; my @F = split("\t", $_); if (exists $hits{$F[$index+1]}{$F[$index+2]}) { } else { $hits{$F[$index+1]}{$F[$index+2]}{'w'} = 0; $hits{$F[$index+1]}{$F[$index+2]}{'c'} = 0; } $hits{$F[$index+1]}{$F[$index+2]}{$F[$index]}++ }
    This is then printed in a simple manner to form files like these:
    1 4 1 0 1 5 1 0 1 31 1 0 1 74 1 0 1 89 1 0 1 116 1 1 1 118 1 0 1 122 1 0 1 126 0 1 1 140 0 1 1 141 0 1 1 148 2 0 1 158 0 1 1 159 1 0

    Column 2 and 3, along with the frequency counts of each for W and C.

    This approach however requires a rather a lot of memory - around 800MB for an input file of ~100Mb.

    Are there any clever tricks or alternative methods that I could use in order to reduce the memory requirements? I note that for any given column 2-column 3 combination, a key and a blank (zeroed) value is stored the first time it is encountered - this is done as the output file is required in the format shown above where '0' is filled in. This may be increasing memory usage further when the zeros could be added afterward (perhaps during printing), but i'm entirely sure or how I would do this.

Testing Wrapped LDAP Classes
1 direct reply — Read more / Contribute
by yulivee07
on Dec 05, 2016 at 10:39
    Hello fellow Perl-Monks,

    I am expanding my knowledge in testing right now. I want to test some functions of mine which interact with an LDAP-Server.

    This might sound like a stupid question, but what is the best way to deal with Wrapper-Classes?

    Context:
    I write a module, which gets some Users from LDAP.
    To communicate with the LDAP, I use a provided module from my workplace which wraps some system-specific parameters in the LDAP-methods (Utils::Ldap::CompanyLdap) and provides some additional methods.
    This module again is a subclass of another LDAP-Wrapper Module (Utils::Ldap::Base) which finally uses Net::LDAP.

    Now, in my program I use the first Ldap-Module e.g.
    package MyAwesomeProgram; use Utils::Ldap::CompanyLdap; sub read_users { # code that reads users from Ldap # searchGetEntries/get_value is provided by Utils::Ldap::CompanyLda +p foreach my $entry ( $ldap->searchGetEntries() ) { my $uid = $entry->get_value( 'uid' ); #... do something more } } 1;
    I want to test the read_users function of my program, which gets its users via Utils::Ldap::CompanyLdap. How do I mock this? As you see, I do not directly interact with a Net::LDAP-Object

    I have already understood that there is Test::Net::LDAP::Mock/Test::Net::LDAP::Utils qw(ldap_mockify) which can mock an Ldap Connection. What I do not understand yet: How can I use this in conjunction with my Wrapper Module? My module uses the code and the functions of our Ldap-Wrappers. Would the correct way be to write mocking code for the wrappers (e.g. Utils::Ldap::CompanyLdap::Mock), or is there a way of overwriting the Net::LDAP Object which is used by the Base-Wrapper Class Utils::Ldap::Base? I am not shure how to best approach this.

    Second Question:
    In case I get this working, is there a way of taking a Net::LDAP object and feeding it into my Mock-Object? I'd like to copy the datastructe of our LDAP to the Mock-Object.

    Kind regards,

    yulivee
Capacity Planning
3 direct replies — Read more / Contribute
by Aatus
on Dec 05, 2016 at 10:25
    I am VERY new to Perl but know its power and really need help to create a script that: a. Uses Perl::SSH b. SSH into appliances using username:password c. OPens a notepad or excel for IP address list d. Pings particular IP e. Writes to each IP the average latency d. Moves to next IP and logs into different appliance and repeats process
Printing to STDOUT buffered when invoking Perl within a bash-script using tee
1 direct reply — Read more / Contribute
by TJCooper
on Dec 05, 2016 at 10:01

    As a solution to recording terminal output into a log file, whilst still viewing output on the terminal (using code within a bash script itself rather than piping to tee on the command-line) I typically use:

    exec > >(tee "$DIR/Logs/System.log")

    Near the top of the bash script.

    This bash script eventually invokes a Perl script. Output printed to the terminal comes from both Bash and Perl, however, the inclusion of the above line causes the buffering of the Perl-specific portion of the output such that it's only displayed on the terminal once the script fully completes. Running the Perl script as a standalone provides the intended real-time updates, as does invoking it via Bash without the above line.

    Could anybody explain why this is happening and also suggest a solution? The ultimate goal here is to provide real-time feedback to the user on the terminal, whilst keeping a hard-copy of this feedback in a log file.
Sorting array
4 direct replies — Read more / Contribute
by negativ_m
on Dec 05, 2016 at 09:52

    Hello All,

    I have an array which looks like this:

    my @ar1 = (text1.txt, text1a.txt, text2.txt, text54.txt,...text1g.txt,...text54f.txt,...);

    I would like to have always the last version of my names inside the array. The result should look like this:

    my @ar2 = (text2.txt,...text1g.txt,...text54f.txt,...);

    I would appreciate some help. Thank you in advance.

[Perl6] Slurpy array of named arguments?
2 direct replies — Read more / Contribute
by ctilmes
on Dec 05, 2016 at 09:16
    I can ask for a slurpy hash of named arguments with '*%args', or a slurpy array of non-named arguments with '*@args', but I want an ordered list of Pairs (specified with 'name => value'). Is there a good way to get that?
    class testing { method newhash(*%args) { for %args.kv -> $k, $v { say "Hash Key $k => Value $v"; } } method newarray(*@args) { for @args -> $k, $v { say "Array Key $k => Value $v"; } } } my $x = testing.newhash(a => 1, b => 2); # Messes with specified ord +er my $y = testing.newarray(c => 3, d => 4); # Looks good, but doesn't w +ork my $z = testing.newarray('e', 5, 'f', 6); # Works, but ugly
    Hash Key b => Value 2 Hash Key a => Value 1 Array Key e => Value 5 Array Key f => Value 6

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 romping around the Monastery: (2)
    As of 2016-12-06 02:28 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      On a regular basis, I'm most likely to spy upon:













      Results (96 votes). Check out past polls.