Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
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
Loading package error : script works in weird way
1 direct reply — Read more / Contribute
by t-rex
on Jun 28, 2016 at 02:44

    I am using 2 packages ( which i have written) initially i was using them as different scripts ( one script calling another and it was working fine ) but now i can't even see the print output.

    here is one main.pl script
    1 #!/usr/bin/perl 2 print "hello"; 3 use strict; 4 use warnings; 5 use YAML_Lib; 6 use YAML::XS; 7 use Run_Lib; 8 9 print "hello 1"; 10 my $input_file; 11 if(scalar(@ARGV) < 1) 12 { 13 print("USAGE:: $0 <Input file>\n"); 14 exit(0); 15 } 16 17 print STDOUT "Welcome to our little program\n"; 18 19 $input_file = $ARGV[0]; 20 print "Input File = $input_file\n"; 21 # parse the yaml file 22 $YAML_Lib::yaml_input = YAML::XS::LoadFile("$input_file"); 23 &YAML_Lib::parse_yaml($YAML_Lib::yaml_input); 24 25 # call client functions + 26 &Run_Lib::socket_check();

    here is the package Run_Lib

    1 #!/usr/bin/perl 2 package Run_Lib; 3 use strict; 4 use warnings; 5 use Exporter 'import'; + 6 use Net::OpenSSH; 7 #use Fcntl; 8 #use Client_Lib; 9 10 #function declarations 11 sub socket_check(); 12 sub open_file($$); 13 sub read_file_str($$); 14 sub write_file_str($$); 15 sub server_setup(); 16 17 #global variable declarations 18 my $client_connect_flag = 0; 19 my $pwd = $ENV{'PWD'}; 20 my $filename = "$pwd/LOG.txt"; 21 22 #check for if the socket is established by calling the client (hos +t) script 23 #socket_check(); 24 25 sub socket_check() 26 { 27 # open the log file ( flush for the first time ) 28 print "helloooooooo!!"; 29 my $log_fh = open_file( $pwd, $filename ); 31 #write the log about calling client script 32 my $string = "INFO :: Calling the Client script \n"; 33 write_file_str( $log_fh, $string ); 34 35 # call the client functions to connect to the socket 36 #my $cmd = "$pwd/utpsm_lts_client.pl"; 37 #my $rc = system($cmd) 38 #or die "cant run client.pl $! \n"; 39 40 # my $socket_client = &Client_Lib::client_socket_create(); 41 # &Client_Lib::client_main($socket_client); 42 43 # check the log file if the client connected or not 44 my $client_str = "FAIL_CLIENT_CONNECT"; 45 read_file_str( $log_fh, $client_str); 46 47 # check if client connected or not 48 if ($client_connect_flag) 49 { 50 # setup the server on target 51 server_setup(); 52 } 53 54 } 55 56 sub open_file ($$) 57 { 58 my ( $pwd, $filename ) = @_; 59 my $FH; 60 open ( $FH ,"+>$filename" ) or 61 die "can't open/create $filename $!"; 62 return $FH; 63 } 64 65 66 sub read_file_str ($$) 67 { 68 my ($log_fh, $find_str) = @_; 69 my @lines = <$log_fh>; 70 #check for the output of log file if the client started or not 71 for (@lines) 72 { 73 if ($_ =~ /$find_str/ ) 74 { 75 $client_connect_flag = 0; 76 } 77 } 78 close $log_fh; 79 } 80 81 sub write_file_str ($$) 82 { 83 my ( $log_fh, $string_to_write ) = @_; 84 print $log_fh "$string_to_write"; 85 close $log_fh; 86 }

    now i am confused as to what is the problem. anyone has some clues to it

Keeping deflated data in memory
3 direct replies — Read more / Contribute
by murrayn
on Jun 28, 2016 at 00:44

    I need to "deflate" a data buffer and then embed that into another data stream before writing it out (I'm trying to write a bitmap into a new PNG file).

    IO::Compress::Deflate appears to do the job and its doc says it "allows writing compressed data to files or buffer". All the methods and examples appear to write files. Am I wrong to interpret "buffer" as meaning an area of my program's working storage ($buffer)? Have I missed reading some crucial piece of documentation which should have been blindingly obvious? Am I using the wrong module altogether?

Compare 2 arrays
3 direct replies — Read more / Contribute
by niceguy
on Jun 27, 2016 at 19:18

    Dear PerlMonks,

    I am relatively new with Perl. I am trying to delete some old files from a directory based on, if it is not listed in the file and this file has a SDF file extension.

    I have an array (@file) that contains a list of all the file name in the directory. And another array (@name) contains a list of all the lines from the SDF file.

    What I like to do is to compare the two arrays and find the file name that is not listed in the SDF file.

    The SDF file contains lines like:

    • fullpath="C:\directory\filename1.nfo"
    • id="1a"
    • fullpath="C:\directory\filename2.nfo"

    I've been searching the web and found some good examples but not exactly on what I am trying to do. I have tried using "!($name =~ $filename)", it just delete all the files in the directory. I think there is something wrong with the logic in the loop but not sure where. Below, is my code that are able to find the matching files. I am wondering if you can help.

    Thank you in advance for your help.

    #!\perl\bin\perl use strict; use warnings; my $files = "C:\\Directory"; my $list = "C:\\Test.sdf"; my @name; open(my $name, "< $list") or die "Failed to open file: $!\n"; while(<$name>) { chomp; push @name, $_; } close $name; my @file = $files; opendir(OUTPUT, $files); @file = readdir(OUTPUT); closedir(OUTPUT); foreach my $filename (@file) { foreach $name (@name) { if ($name =~ $filename) { last; }else { unlink ($files . "\\" . $filename) or warn qq{cannot delete $fil +ename: $!+}; last; } } }
UnMesh or UnZip List
1 direct reply — Read more / Contribute
by awohld
on Jun 27, 2016 at 18:44
    I have this list that is basically what a List::MoreUtils mesh or zip output of a list would look like.

    Looking all over there doesn't seem to be an unmesh or unzip function out there and my attempts look ugly. I know how many list were zipped into the input, so
    my @test1 = qw( 1 1 2 2 3 3 4 4 5 5 6 6 7 7 ); my @test2 = qw( 1 1 1 2 2 2 3 3 3 4 4 4 5 5 5 6 6 6 7 7 7 ); # unzip @test1, we know to make it two lists my $unzipped = unzip( 2, @test1 ); $unzipped = [ [ 1, 2, 3, 4, 5, 6, 7 ], [ 1, 2, 3, 4, 5, 6, 7 ], ] # unzip @test2, we know to make it three lists my $unzipped = unzip( 3, @test2 ); $unzipped = [ [ 1, 2, 3, 4, 5, 6, 7 ], [ 1, 2, 3, 4, 5, 6, 7 ], [ 1, 2, 3, 4, 5, 6, 7 ], ]
    Any ideas if "unzip" or "unmesh" exists or an elegant way to implement unzip?


Strings overwrite themselves in print command
5 direct replies — Read more / Contribute
by tdsny71
on Jun 27, 2016 at 17:55

    I am trying to make a CSV file out of an LDAP output that comes from an external process.

    Here is the structure of the output file:

    cn: applegroup
    member: CN=mem001,OU=Users,DC=myorg,DC=com
    member: CN=mem002,OU=Users,DC=myorg,DC=com
    member: CN=mem003,OU=Users,DC=myorg,DC=com
    member: CN=mem004,OU=Users,DC=myorg,DC=com

    cn: orangegroup
    member: CN=mem301,OU=Users,DC=myorg,DC=com
    member: CN=mem302,OU=Users,DC=myorg,DC=com
    member: CN=mem303,OU=Users,DC=myorg,DC=com

    And here is the code I have to read it:
    #!/usr/bin/perl use strict; use warnings; # 0a) Initialize variables my $grpNm = ""; my $memID = ""; my @groupInfo = ("", ""); my @memberInfo = ("", ""); my @ldapMemInfo = ("", ""); my @idInfo = ("", ""); my @csvContent = ("", ""); my $allGroupResult = "allTmp.txt"; my $allGroupDataFinal = "allData.csv"; open my $fhGroupFile, '<', "$allGroupResult" or die "Could not create +or open $allGroupResult"; open my $fhCSVOutput, '>', "$allGroupDataFinal" or die "Could not crea +te or open $allGroupDataFinal"; sub lTrim { my $s=shift; $s =~ s/^\s+//; return $s; } sub rTrim { my $s=shift; $s =~ s/\s+$//; return $s; } sub trimAll { my $s=shift; $s =~ s/^\s+|\s+$//g; return $s; } # ------------ Main Program -------------------- while (<$fhGroupFile>) { my $line = $_; chomp $line; # Check if line begins with "cn" or "member" if ($line =~ m/^cn/) # found group name { @groupInfo = split /:/, $line; $grpNm = $groupInfo[1]; # second entry is group name $grpNm = lTrim($grpNm); #trim leading spaces from group name # print "array indice $groupInfo[1]\n"; print "scalar grpNm:$grpNm\n"; $csvContent[0] = $grpNm; } elsif ($line =~ m/^member/) # found member name { @memberInfo = split /:/, $line; @ldapMemInfo = split /,/, $memberInfo[1]; # second entry is full + string for ldap content @idInfo = split /=/, $ldapMemInfo[0]; # second entry is ldap con +tent #print "array idInfo /= @idInfo\n\n"; $memID = $idInfo[1]; # second entry is the specific ID #print "scalar memID = $memID\n"; $csvContent[1] = $memID; print $fhCSVOutput "$csvContent[0]"; print $fhCSVOutput ","; #print $fhCSVOutput "$csvContent[1]"; print $fhCSVOutput "\n"; } else { } } # while <$fhGroupFile> close($fhGroupFile); close($fhCSVOutput);

    When I run it I get:
    ,pplegroup
    ,pplegroup
    ,pplegroup
    ,pplegroup
    ,rangegroup
    ,rangegroup

    Before you ask, I get the same result if I use the scalar variables without the array @csvContent so,

    print $fhCSVOutput "$csvContent[0]"; print $fhCSVOutput ","; #print $fhCSVOutput "$csvContent[1]"; print $fhCSVOutput "\n";

    AND

    print $fhCSVOutput "$grpNm"; print $fhCSVOutput ","; #print $fhCSVOutput "$memID"; print $fhCSVOutput "\n";

    yield the same erroneous data.
printing the first column when both columns 2 and 3 are the same
3 direct replies — Read more / Contribute
by novice2015
on Jun 27, 2016 at 11:41
    I have a script to eliminate duplicates. here is the file that it reads from:
    161248,/vol/filelist,CABINET 161200,/vol/filelist,INVENTORY 161400,/vol/filelist,INVENTORY
    I'd like it to identify the duplicated line (/vol/filelist,INVENTORY) and print out this last line (which would correspond to the #161400 in the first column. This is what I have so far:
    open my $FH2, '<', '/tmp/fileread' or die "unable to open file 'file' +for reading : $!"; open my $FH6, '>', '/tmp/tst.txt' or die "unable to open file 'file' f +or reading : $!"; my %duplicates; while (<$FH2>) { chomp; my ($column_1, $column_2, $column_3) = split /,/; print {$FH6} "$column_1\n" if defined $duplicates{$column_2} && + $duplicates{$column_3}; $duplicates{$column_2}++; } close $FH6; close $FH2; open my $fh, '<', '/tmp/tst.txt' or die "unable to open file 'file' fo +r reading : $!"; while (my $line = <$fh>) { print $line; } close $fh;
    This doesn't work. I can get it to work somewhat if I leave:
    my ($column_1, $column_2) = split /,/; print {$FH6} "$column_1\n" if defined duplicates{$column_2}; $duplicates{$column_2}++; But this only causes the last 2 lines of the file to be deleted, and I + want the last line deleted because on the last line both columns 2 a +nd 3 are the same. So what I am really looking for is to print the # in the first column +which corresponds to both column 2 and 3 being the same. 161248,/vol/filelist,CABINET 161200,/vol/filelist,INVENTORY 161400,/vol/filelist,INVENTORY In the last line, column 2 (/vol/filelis) and column3 (INVENTORY) are +the same. Does anyone have a suggestion?
Perl Net::SFTP::Foreign password authentication . No key exchange setup can be done
1 direct reply — Read more / Contribute
by Yedu
on Jun 27, 2016 at 10:45
    Hi All,

    I got the Net::SFTP::Foreign module installed and it is being worked fine for the key-exchange sftp set-up. But I need to set it up to have password based authentication where it should take the password that I passed to login.

    I have gone through multiple threads on this topic and found that it is somehow possible using IO:Pty module of perl . Below is the command that I found to use.

    my $sftp = Net::SFTP::Foreign->new($host, user => $user, password => $ +password,more => [-o => 'PreferredAuthentications=password,keyboard-i +nteractive,***publickey***']);

    But here, in the Preferred authentications, the public key is also being passed.

    Can anyone please help me on this? what is the public key that is being referred here?

    Also, installing IO::Pty along with Net::SFTP::Foreign modules can server my requirement?

    Please help.

    Thanks and Regards,

    Edu

Addional "year" matching functionality in word matching script
2 direct replies — Read more / Contribute
by bms9nmh
on Jun 27, 2016 at 07:03
    Hello, I have the following perl script which compares words in the 2nd field of two csv files, and if 5 or more words match then it prints both line together as a positive match.
    #!/bin/perl + + my @csv2 = (); + open CSV2, "<csv2" or die; + @csv2=<CSV2>; + close CSV2; + + my %csv2hash = (); + for (@csv2) { + chomp; + my ($title) = $_ =~ /^.+?,\s*([^,]+?),/; #/ match the title + $csv2hash{$_} = $title; + } + + open CSV1, "<csv1" or die; + while (<CSV1>) { + chomp; + my ($title) = $_ =~ /^.+?,\s*([^,]+?),/; #/ match the title + my %words; + $words{$_}++ for split /\s+/, $title; #/ get words + ## Collect unique words + my @titlewords = keys(%words); + my @new; #add exception words which shouldn +'t be matched foreach my $t (@titlewords){ + push(@new, $t) if $t !~ /^(rare|vol|volume|issue|double|magazi +ne|mag)$/i; } + @titlewords = @new; + my $desired = 5; + my $matched = 0; + foreach my $csv2 (keys %csv2hash) { + my $count = 0; + my $value = $csv2hash{$csv2}; + foreach my $word (@titlewords) { + my @matches = ( $value=~/\b$word\b/ig ); + my $numIncsv2 = scalar(@matches); + @matches = ( $title=~/\b$word\b/ig ); + my $numIncsv1 = scalar(@matches); + ++$count if $value =~ /\b$word\b/i; + if ($count >= $desired || ($numIncsv1 >= $desired && $numI +ncsv2 >= $desired)) { $count = $desired+1; + last; + } + } + if ($count >= $desired) { + print "$csv2\n"; + ++$matched; + } + } + print "$_\n\n" if $matched; + } + close CSV1;
    I would now like to add extra functionality so that- if both the lines contain a year, in the format 1989, then the years in each csv have to match for it to be considered a positive match. However, if only one of the lines contains a year, then I would like the usual 5 matching words rule to apply and the year becomes irrelevant. Examples just to clarify. In this example field 2 contains 5 matching words but the two years (1973 + 2013) are different so this would be discounted as a match:
    2523021356, RARE TV RADIO TIMES MAGAZINE DOCTOR WHO 1973 THE THREE 3 +DOCTORS DR JON PERTWEE, http://www.example.co.uk, 12 12278788, TV & SATELLITE WEEK 11 MAY 2013 GILLIAN ANDERSON DOCTOR WHO +NOT RADIO TIMES , http://www.example.co.uk, 12
    In this example the years are the same AND there are 5 or more matching words so this would be a positive match:
    2523021356, RARE TV RADIO TIMES MAGAZINE DOCTOR WHO 1973 THE THREE 3 +DOCTORS DR JON PERTWEE, http://www.example.co.uk, 12 12278788, TV & SATELLITE WEEK 11 MAY 1973 GILLIAN ANDERSON DOCTOR WHO +NOT RADIO TIMES , http://www.example.co.uk, 12
    In this example, only one of the titles contain a year (1973), but there are also 5 or more matching words, I would like this to be considered a positive match:
    2523021356, RARE TV RADIO TIMES MAGAZINE DOCTOR WHO 1973 THE THREE 3 +DOCTORS DR JON PERTWEE, http://www.example.co.uk, 12 12278788, TV & SATELLITE WEEK 11 MAY GILLIAN ANDERSON DOCTOR WHO NOT R +ADIO TIMES , http://www.example.co.uk, 12
    In this example, none of the titles contains a year, but 5 or more words match so this would be a positive match:
    2523021356, RARE TV RADIO TIMES MAGAZINE DOCTOR WHO THE THREE 3 DOCTO +RS DR JON PERTWEE, http://www.example.co.uk, 12 12278788, TV & SATELLITE WEEK 11 MAY GILLIAN ANDERSON DOCTOR WHO NOT R +ADIO TIMES , http://www.example.co.uk, 12
    How can I add this functionality to the script without making wholesale changes?
randfunc in Config
4 direct replies — Read more / Contribute
by choroba
on Jun 27, 2016 at 05:19
    Dear Monks,

    I got a strange tester failure report for Syntax::Construct. It seems there's a machine with Perl 5.20.2 whose $Config{randfunc} returns drand48 , but my test expects Perl_drand48 . See the relevant perl5200delta:

    > Perl now uses its own internal drand48() implementation on all platforms.

    Corion pointed me to a search for randfunc where the only possibly relevant line is the one from uconfig64.sh:

    776:randfunc='drand48'

    I don't understand what the file is used for, so this might be totally unrelated.

    So, my questions are:

    1. Is it OK to have Perl 5.20+ with $Config{randfunc} returning drand48 without the Perl_ prefix? If so, I can check just /drand48/ or use index in the test.
    2. Is there some other method besides using %Config to check that Perl uses its own drand48 function?

    ($q=q:Sq=~/;[c](.)(.)/;chr(-||-|5+lengthSq)`"S|oS2"`map{chr |+ord }map{substrSq`S_+|`|}3E|-|`7**2-3:)=~y+S|`+$1,++print+eval$q,q,a,
Assign a hash to an array
5 direct replies — Read more / Contribute
by ravi45722
on Jun 27, 2016 at 05:05

    Here I am assigning(push) a hash to an array of hashes. But when I print hash Its perfect. But when I push that into an array its changing. Here is my code. I also tried with escape('\') character.

    $string = "column08=Submit & column10=Delivered & column09=Something" my @matches = grep defined, split / ([|&]) /, $string; $i = 1; foreach my $one (@matches) { if (($one =~ tr/=//) == 1) { my ($key,$value)=(split /=/,$one); %hash = (); $hash{'term'}{$key} = $value; push (@return_array,%hash); } else { push (@symbol_array,$one); } } print Dumper \%hash; print Dumper \@return_array;

    Expected Output:

    $VAR1 = [ 'term'=> { 'column08' => 'Submit' }, 'term'=> { 'column10' => 'Delivered' }, 'term'=> { 'column09' => 'Something' } ];
    Thanks in Advance

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 the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others about the Monastery: (7)
    As of 2016-06-29 05:50 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?
      My preferred method of making French fries (chips) is in a ...











      Results (368 votes). Check out past polls.