Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight

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
Unable to figure out - undefined value as a HASH reference
1 direct reply — Read more / Contribute
by Audar
on Jul 30, 2015 at 14:52

    Hello Monks,

    I am unable to figure out the issue with my code.
    I am passing an object to a subroutine - '_predecessors_complete' below, however, I get the following error in a certain case, marked below in the code with '--this line --' -

    Can't use an undefined value as a HASH reference at line 264, <OEM2015FLAG> line 1.

    The case occurs when I pass in a 'job' value that doesn't exist in the hash of all jobs. So, I tried checking if the job exists in the hash, using the 'if' exists' code.

    Question is, which value exactly would be undefined for me to get this error message? I am printing $p here, and it is definitely defined.

    OUTPUT -
    p : JOBNAME1

    Can't use an undefined value as a HASH reference at line 264, <OEM2015FLAG> line 1.

    CODE -

    my $rv = $self->_predecessors_complete( $self->predecessors ); ##$self +->predecessors is a reference to a hash sub _predecessors_complete { my ( $self, $predecessors ) = @_; while ( my $p = shift @{ $predecessors } ) { print "\np : $p\n"; --this line -- if ( ! exists $self->steps->{$p} ) { print "\nThe job $p has not been defined in the Scheduler!\n +"; return(100); } else {
Rolling variable
5 direct replies — Read more / Contribute
by artperl
on Jul 30, 2015 at 09:35
    Dear Perl monks, I would like to seek recommendation on what could be a good solution here... I would like to monitor file count in a specific directory & record the count every hour. I would need to keep that counts somewhere for another calculation but I would like to keep only the last 8 counts, meaning throw away the oldest data & just keep the last 8 records. How can I effectively do this in perl? Thanks much!...
Comparing two files and editing it.
2 direct replies — Read more / Contribute
by rormonk
on Jul 30, 2015 at 09:08
    Hi Monks!

    I'm trying to write a script that compares File A and File B line by line. But when comparing it only takes into account the first 3 characters of every line and ignores the others. When the first 3 characters are absent on a file it skips a line to align it with the other file. The line absent on a file is written to another new file.


    File A     File B

    111 abc     111 pqr

    111 def     111 stu

    222 ghi     111 vwx

    223 jkl     222 yza

    345 mno    345 bcd


    Output should be:

    File A     File B

    111 abc     111 pqr

    111 def     111 stu

                      111 vwx

    222 ghi     222 yza

    223 jkl

    345 mno     345 bcd


    File that is created:

    111 vwx

    223 jkl

    I'm having a hard time figuring out how to do this. Please Help!

Optimize bit stream conversion
2 direct replies — Read more / Contribute
by Monk::Thomas
on Jul 30, 2015 at 07:46

    Hello fellow monks

    I have a sequence of bits that I want to convert back into actual values. I found a working algorithm, but there's probably an easier way to achieve what I want.

    Input format: 0 and 1's in big-endian order. The number of bits may or may not equal multiples of 8.

    Output format: Convert all groups of 8 into actual value, remaining bits must be kept. (Converted values can be any ASCII value, UTF-8 is not relevant.)

    Sample script

    #!/usr/bin/perl use strict; use warnings; # store 'A' and 'B' as a bitstream # (bit groups are stored big endian!) my @bits = ( 1, 0, 0, 0, 0, 0, 1, 0, # A / 0x41 / 0b01000001 0, 1, 0, 0, 0, 0, 1, 0, # B / 0x42 / 0b01000010 1, 1, 0, 0, 1, 0, 1 # incomplete byte ); my $data; while (@bits >= 8) { # fetch bit group my @eightbits_be = splice @bits, 0, 8; # convert to little endian my @eightbits_le = reverse @eightbits_be; # generate binary representation my $binary = '0b' . join q{}, @eightbits_le; # convert binary representation into actual value my $value = chr oct $binary; $data .= $value; } printf "data: %s\n", $data; # AB printf "bits: %s\n", join ', ', @bits; # 1, 1, 0, 0, 1, 0, 1
    The generated/exprected output is:
    data: AB
    bits: 1, 1, 0, 0, 1, 0, 1
Connection issue to the SQL Server in Azure from perl installed in CentOS
1 direct reply — Read more / Contribute
by m_pant0808
on Jul 30, 2015 at 05:42
    Hi All,

    Want to connect to the SQL Server DB available in the Azure from the perl installed in CentOS 7.

    I wan using The CentOS 7 from Oracle VirtualBox. This VirtualBox I have installed in Windows 8.1.

    When I was trying to connect same from perl installed in the master OS, i.e.: Windows 8.1, it was working fine. But, then why it is failing in when I was trying to connect the same from the Oracle VirtualBox?

    Do, I need to add trusted IP to Azure for Oracle VirtualBox (value of inet)?

    I was receiving the following error:
    DBI connect('Driver={SQL Server Native Client 11.0};Server=tcp:<server>,1433;Database=<database>;Uid=<u_name>@<server>;Pwd=<pswrd>;Encrypt=yes;TrustServerCertificate=no;Connection Timeout=30;','',...) failed: [unixODBC][Microsoft][SQL Server Native Client 11.0]Login timeout expired (SQL-HYT00) [state was HYT00 now 08001]
    [unixODBC][Microsoft][SQL Server Native Client 11.0]TCP Provider: Error code 0x2726 (SQL-08001)
    [unixODBC][Microsoft][SQL Server Native Client 11.0]A network-related or instance-specific error has occurred while establishing a connection to SQL Server. Server is not found or not accessible. Check if instance name is correct and if SQL Server is configured to allow remote connections. For more information see SQL Server Books Online. (SQL-08001) [state was 08001 now 01S00]
    [unixODBC][Microsoft][SQL Server Native Client 11.0]Invalid connection string attribute (SQL-01S00) at line 9.
Perl/Tk, PAR::Packer and Menus
3 direct replies — Read more / Contribute
by dbarstis
on Jul 29, 2015 at 17:14

    Kind monks of the monastery, I have what should be a simple issue to resolve but am having trouble finding a solution. I have a simple script using Tk with a menubar. The script runs fine when invoked with the perl command but the menubar is no where to be seen when an executable is built with pp. This is on a Windows machine with Strawberry Perl 5.14.2 and Tk 804.033 (actually the DWIM install). Any and all wisdom would be greatly appreciated.

    use Tk; my $mw = MainWindow->new; my $menubar = $mw->Menu(); $mw->configure( -menu => $menubar ); my $file = $menubar->cascade( -label => '~File' ); $file->command( -label => '~Quit', -command => sub { exit }, -accelerator => 'Ctrl-Q' ); $mw->bind( '<Control-q>', sub { exit } ); $mw->MainLoop(); exit;
Fork or Thread?
2 direct replies — Read more / Contribute
by beanscake
on Jul 29, 2015 at 16:44

    Hello Monks,

    I have chunks of data that i am going to upload to Database which can take days to finish upload , i think if i can partition the arrays of data to be uploaded into some part while i spawn process to save each allocated @array data, i think it may save me some time please i need help with this Threads or Fork please advice

    use strict; use warnings; my @orig = 1..2500; my $numberofarray = scalar @orig; my $arrs = 100; # Partition #print $arrs; sub Partition_Array_data { my @arrs; push @{$arrs[$_ % $arrs]}, $orig[$_] for 0..$#orig; if (my $pid = fork) { waitpid($pid, 0); } else { if (fork) { exit } else { thread_dbSave(\@arrs); } } } sub thread_dbSave { # this function will handle the saving my @arrayofsplit = @{$_[0]}; print join ' ', @$_, "\n" for @arrayofsplit; } &Partition_Array_data();
how to sum over rows based on column headings in perl
4 direct replies — Read more / Contribute
by angerusso
on Jul 29, 2015 at 16:02

    I have a UPDATED datafile which has only "W" and "Ms" entries. As in the example, I want to count number of A's which have "M" appearing atleast once over unique column names. I want to sum over rows, not columns. As long as "M" appears in column once, I just count that row as 1.

    Gname G1 G1 G1 G1 G2 G2 G3 A W W M W W W M A W W W W W W W A W W W W W W W B W W W W W M M B M W W W W M M C M M M W W W W C M W W M M W W The output should be: Gname G1 G2 G3 A 1 0 1 B 1 2 2 C 2 1 0

    I have written the following code to write the header row but I am very confused how should I start counting over blocks/chunks of data like I want. Can anyone help?

    #!/usr/bin/perl -w if (@ARGV != 1){ print "USAGE: ./ file\n"; exit(-1); } $mutfile = $ARGV[0]; %hash = (); open(INPUTR,"<$mutfile") || die "Can't open \$mutfile for reading. \n" +; while($line=<INPUTR>){ chomp $line; @toks = split(/\t/,$line); if ($toks[0] =~ /^Gname/){ $k = 0; # loop over the header row to get the unique "Gname"s @header = split(/\t/,$line); for $j (1..@toks-2){ $i = $j+1; if ($header[$i] ne $header[$j]){ $k++; $name[$k] = $header[$j]; } } for $i (0..$k){ $hash{$toks[0]}{$name[$k]} = $name[$k]; } } else { $k = 0; for $j (1..@toks-2){ $i = $j+1; if ($header[$i] ne $header[$j]){ $k++; $hash{$toks[0]}{$name[$k]} = 0; if ($toks[$j] =~ /M/){ $hash{$toks[0]}{$name[$k]} = 1; } } } } } close(INPUTR); $outdata = $mutfile; $outdata =~ /(.+).txt/; $outdata = $1."-COUNTS.txt"; open(OUTD,">$outdata"); foreach $idname (sort keys %hash){ if ($idname =~ /^Gname/){ print OUTD $idname; foreach $gid (sort keys %{$hash{$idname}}){ print OUTD "\t".$hash{$idname}{$gid}; } print OUTD "\n"; } } foreach $idname (sort keys %hash){ if ($idname !~ /^Gname/){ print OUTD $idname; foreach $gid (sort keys %{$hash{$idname}}){ print OUTD "\t".$hash{$idname}{$gid}; } print OUTD "\n"; } } close(OUTD); print "Printing $outdata file done.\n";
What is greedy and lazy Matching in perl
7 direct replies — Read more / Contribute
by shankonit
on Jul 29, 2015 at 13:19

    Please help me to understand these two concepts in regular expression like . and .*.

    Thank u in advance for your time taken to read and answer

INIT {$SIG{__DIE__} and Getopt::Long
5 direct replies — Read more / Contribute
by demichi
on Jul 29, 2015 at 13:16
    Hi all

    I am normally using the following line to capture the die output into a logfile.

     INIT {$SIG{__DIE__}=sub {LOG_MSG("normal",3,"GENERAL","Script died: $_[0]") and close LOG;}}

    Now I am using also Getopt::Long. I don't want to have a logfile generated if somebody is chosing the wrong parameter. Therefore I let the script die with an usage output.

    Unfortunately if somebody choses a wrong getopt parameter now - I get a log error message because of the INIT-"die" setting as the log file is not opened yet.

    G:\development\bin> -x > 4,GENERAL,Script warning: Unknown option: x print() on unopened filehandle LOG at G:\development\bin\ line 45. + ### Version:2.0.0 NAME xxx > 3,GENERAL,Script died: 1 at G:\development\bin\ line 14. ### > 4,GENERAL,Script warning: print() on unopened filehandle LOG at G:\d +evelopment\bin\ line 45. ### print() on unopened filehandle LOG at G:\development\bin\ line 45. + ### 1 at G:\development\bin\ line 14. ### G:\development\bin>

    Every line marked with "###" at the end I do not want to have as output to STDOUT.

    Do you have an ideas how can fix it? Thanks.

    kind regards de Michi

    use strict; use warnings; use Getopt::Long qw(:config no_ignore_case bundling); # Get options / my $VERSION = "2.0.0"; INIT {$SIG{__DIE__}=sub {LOG_MSG("normal",3,"GENERAL","Script died: $_ +[0]") and close LOG;}} INIT {$SIG{__WARN__}=sub {LOG_MSG("normal",4,"GENERAL","Script warning +: $_[0]")}} # Check Flags my $flag_help; my $flag_version; my $flag_config; GetOptions ( 'h|help' => \$flag_help, 'V|VER' => \$flag_version, 'c|config=s' => \$flag_config, ) or die USAGE(); # Check flags and print usage if ($flag_version) { print "Version: $VERSION\n"; exit; } if ($flag_help) { USAGE(); exit; } open(LOG,"> SCRIPTLOG_FILE") or die ("Can't open SCRIPTLOG_FILE: $!\n" +); close LOG; ### subs sub LOG_MSG { my $par_LEVEL = shift (@_); my $par_SEVERITY = shift (@_); my $par_FUNCTION = shift (@_); my @line = @_; print "> $par_SEVERITY,$par_FUNCTION,@line\n"; print LOG "$par_SEVERITY,$par_FUNCTION,@line\n"; } sub USAGE { my ($message)=<<'MESSAGE'; NAME xxx MESSAGE print "Version:${VERSION}\n$message"; }

Add your question
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!
  • 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?

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

    How do I use this? | Other CB clients
    Other Users?
    Others romping around the Monastery: (17)
    As of 2015-07-30 20:24 GMT
    Find Nodes?
      Voting Booth?

      The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...

      Results (273 votes), past polls