Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine

The Monastery Gates

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

Donations gladly accepted

If you're new here please read PerlMonks FAQ
and Create a new user.

New Questions
issue with DBI and MS SQL SERVER
3 direct replies — Read more / Contribute
by DanBev
on Sep 15, 2014 at 10:04

    Hi monks, I've an issue connecting to MS SQL Server with DBI. I've read all tutorials and configurations of TDS but my code still not works...

    Simply I try my $dbh = DBI->connect(DBI:Sybase:server=xx.xx.xx.xx, "USERNAME", "PASSWORD") ;
    and the error is

    DBI connect('server=xx.xx.xx.xx','USERNAME',...) failed: OpenClient me +ssage: LAYER = (0) ORIGIN = (0) SEVERITY = (78) NUMBER = (41) Server xx.xx.xx.xx, database Message String: Unable to connect: Adaptive Server is unavailable or d +oes not exist at line 19 Cant' connect to database: OpenClient message: LAYER = (0) ORIGIN = (0 +) SEVERITY = (78) NUMBER = (41) Server xx.xx.xx.xx, database Message String: Unable to connect: Adaptive Server is unavailable or d +oes not exist

    My TDS configuration is

    [xx.xx.xx.xx] host = xx.xx.xx.xx port = 1433 tds versione = 7.0

    Instead, trying in shell it works

    root@___# /usr/local/freetds/bin/tsql -S -U USER Password: locale is "it_IT.UTF-8" locale charset is "UTF-8" using default charset "UTF-8" 1>

    Please help me to understand... is missing
1 direct reply — Read more / Contribute
by timpoiko
on Sep 15, 2014 at 09:06
    Hello all Monks. I wanted to take GD:SVG in use, so I wrote man GD::SVG and read it. I found a piece of code, so I took it and tried to run.
    #!/usr/bin/perl use strict; use GD::Simple; GD::Simple->class('GD::SVG'); my $img = GD::Simple->new(500,500); $img->bgcolor('white'); $img->fgcolor('blue'); my $g1 = $img->newGroup('circle in square'); $g1->rectangle(100,100,400,400); $g1->moveTo(250,250); my $g2 = $g1->newGroup('circle and boundary'); $g2->fgcolor('black'); $g2->bgcolor('red'); $g2->ellipse(200,200); print $img->svg;
    However, only outcome from this is:
    $ perl Can't locate auto/GD/ in @INC (@INC contains: /etc/perl /us +r/local/lib/x86_64-linux-gnu/perl/5.20.0 /usr/local/share/perl/5.20.0 + /usr/lib/x86_64-linux-gnu/perl5/5.20 /usr/share/perl5 /usr/lib/x86_6 +4-linux-gnu/perl/5.20 /usr/share/perl/5.20 /usr/local/lib/site_perl . +) at /usr/lib/x86_64-linux-gnu/perl5/5.20/GD/ line 1007.
    Googling does not help at all and I can't found this "" from the CPAN nor Debian's package repositories. So what I can to do to get this example code working?
Need regex to filter out unwanted rows
2 direct replies — Read more / Contribute
by ps2931
on Sep 15, 2014 at 07:29
    Hello monks!

    I'm trying to filter out rows from a large text files based on the criteria -

    The allowed charcters are: aA-zA, underscore(_), colon(:), dot(.), forward slash(/), comma(,), hyphen(-) numbers(0-9) and double quotes (" ").

    Any character other than the characters listed above is invalid. I want to print line which failed the criteria. The sample line from test file is something like:

    2749 "CQWERC20F+XZIAQAAAQjLiDI9sNc=", "1","ds_uid","CWER1Y1mHZIAQAA8di +wRHfuwrM=","2012-10-14 18:41:44.429","2012-10-14 18:41:44.572","1975- +10-10 00:00:00.000","7307 mg rd","","naasik","NK","44026","IN","44063 +59999","","","","DEFAULT","","","AABBCCXX","","Qqwwee<feff>","","qqww","0","YOPANEL","","false","en","","","","","","","",""," +","","","","","","","",""

    The above line is invalid since it has '<' symbol. Can anyone help me?

Multiline Regex replacement in Multiline file
2 direct replies — Read more / Contribute
by akamboj84
on Sep 15, 2014 at 02:28

    Hello Experts, I am kind of stuck in code. I am trying to do multi regex replacement in multiline file. However my scripts is unable to do replacement, I am not able to figure out why? Can someone help me please

    ->>Script Code

    my $def="hashpatterns.txt"; my %dic=(); open(D, $def) || die "can't open definition file:$def\n"; while (<D>) { my ($oldp, $newp) = split /#/; $dic{$oldp}=$newp; } close(D); my $file="input.txt"; open(F, $file) || die "can't open definition file:$file\n"; open(W, '>out.txt') or die "can't write to file:$!\n"; my $line=join "", <F>; my $matchkey=join "|", keys %dic; $matchkey=qr /$matchkey/; $line =~ s%$matchkey%$dic{$matchkey}%g; print W $line; close(F);

    --> hashpatterns.txt

    \s+user\s"[^"]+"\s+password\s"[^"]+"\s+hash2\s+access(\s+console){2}(\ +s+new-password-at-login)?(\s+member\s"(default|engineer|networktest)" +){2}(\s+exit){0,2}#REPLACE1

    \s+user\s[^"]+"\s+password\s[^"]+"\s+hash2\s+access(\s+console){2}(\s+ +new-password-at-login)?(\s+member\s"(default|READ-ONLY)"){2}(\s+exit) +{0,2}#REPLACE2

    \s+user\s"[^"]+"\s+password\s"[^"]+"\s+hash2\s+access(\s+(console|snmp +|li)){3}\s+console(\s+new-password-at-login)?(\s+member\s"(default|LI +|li-prof1)"){2}(\s+exit){0,2}#REPLACE3


    user "testuser1" password "08Cl3V.leJKU/GskqArA0Yp4MFo" hash2 access console console new-password-at-login member "default" member "engineer"

    user "v-test" password "VCp0GjSBK/KiWW.PgkQp7swXVMZ" hash2 access console console new-password-at-login member "default" member "READ-ONLY"

How to campare two variable consist line and print difference
3 direct replies — Read more / Contribute
by Mjpaddy
on Sep 15, 2014 at 02:00
    Hi monks

    How to compare two variables which has values a line and print the specific unmatched word by its position and line number

    for example

    $str1 = "But I think the device doesn't allow writes or something and +that's causing this issue."; $str2 = "But I think the device allow writes or something and that's c +ausing this issue.";
    open (FHH, ">error.txt")|| die $!; $str1 = "But I think the device doesn't allow writes or something and +that's causing this issue."; $str2 = "But I think the device allow writes or something and that's c +ausing this issue."; my $line = 0; my $pat = qr/$str2/; while($str1){ $line++; if($str1 =~m/($pat)/igs){ my $pre = $`; } else{ print FHH "Line $line:$pre \'$pat\' is missing from $str2." } }

    In the $str2 dont have "doesn't" as compare to $str1

    So the output will be in other file called error.txt in this format: Line 1:cols 24 'doesn't' is missing from $str2

    I have tried some modules in perl like: File::Compare, Text::Compare, List::Compare but they are not giving the proper answer.

    Which strategy should I choose to get multiple lines store in two variables like a two whole file is store in two different variable and compare 2nd file on 1st and print position of mismatch in other file.

    Please Help!

    Thanks in advance
Removing text between HTML tags
4 direct replies — Read more / Contribute
by perll
on Sep 14, 2014 at 10:14
    Hi, I am trying to parse HTML data using regex, below is the HTML code
    <td class="body3" valign="top"><p style="margin-top:1ex; margin-botto +m:1ex;">The purpose of this study is to compare two types of care - s +tandard <span class="hit_org">oncology</span> care and standard <span + class="hit_org">oncology</span> care with early palliative care (sta +rted soon after diagnosis) to see which is better for improving the e +xperience of patients and families with advanced lung and non-colorec +tal GI cancer. The study will use questionnaires to measure patients +' and caregivers' quality of life, mood, coping and understanding of +their illness.</p></td>
    I tried to extract the text using below code. ($bs) = $pre_bs =~ m/\>(.*)\</; Information of only 1st tag will be removed, not all. So I tried with this as well,  $bt =~ s/<.*>//gi; but its not working, everything is removed in this case. I want to remove all tags in a line no matter how many are they, tried multiple combinations but nothing is working. Thanks
Porting Commands to Windows
4 direct replies — Read more / Contribute
by Elegant
on Sep 14, 2014 at 04:02
    Hi, I'm trying to port a few things to Windows and I'm fairly certain that how I'm translating them is incorrect despite not receiving any errors.
    $self->sys('/bin/mkdir', '-p', "$self->{tmp}/attach"); $self->sys('cmd /C mkdir', '-p', "$self->{tmp}/attach");

    The first line is the original (works under linux) and the second line is what I thought was correct under Windows. However, I've never see the results of any of my commands. Is my syntax correct? I have many other cases that involve ln, rm, rm -rf, mv, which are all used in the same manner.

    In case you have questions about what sys() is, it's more or less system().

Fill an array in a module ?
3 direct replies — Read more / Contribute
by DarrenSol
on Sep 13, 2014 at 13:37

    I've run across an obstacle in Perl that I didn't expect. Reading through the module tutorial, it appears that this obstacle is intended. Seems odd to me, since the Perl motto is TMTOWTDI.

    The way I'd like to do it seems to me the most logical, but Perl, apparently, says I can't do it this way :( Mayhap my gray-matter processing unit is defective...

    This is the problem : I have a set directory tree I'm working with, and a number scripts that process the files.

    Seems to me the most straight-forward way to handle this would be to load the directory structure, or specific branches of it, into arrays.

    I'd like to make these arrays, and their contents, available to a script by coding them in a module, as I've done with hard-coded variables. Is this something that Perl doesn't want me to do ?

    I've considered either script to traverse the directory tree, or callable sub-routines, but these seem like overkill for a set directory tree. Either one seem to me to be "making an easy thing hard" :P

    An example, with a subset of the directory tree:

    The initial files are downloaded to the DownLoad folder. These are update files for data sets I've already started.

    The files in the DownLoad folder are moved to the appropriate "raw" folder, retained as an archive.

    The "raw" folder files, which are updates, are appended to the existing data from the files in the "processed" folders. The merged data overwrites the files in the "processed" folders.

    The "processed" files are analyzed, with summary reports placed in the "analysis" folders.

    Sample tree structure:

    \DownLoad (top folder, initial downloaded files)

    \DownLoad\Weekly\raw (downloaded Weekly files moved here)
    \DownLoad\Weekly\processed (merged files)
    \DownLoad\Weekly\analysis (file summary reports)

    \DownLoad\Daily\raw (downloaded Daily files moved here)
    \DownLoad\Daily\processed (merged files)
    \DownLoad\Daily\analysis (file summary reports)

    I'm writing scripts to process files in those directories. Then, for example:

    foreach $RawFileName ( $DownLoadFolder )
    { distribution script, files moved to "raw" folders }

    foreach $AppendFileName ( @WeeklyDirTreeArray ) { (script) }
    foreach $AnalyzeFileName ( @DailyDirTreeArray ) { (script) }

    This works, but I'm only able to do this by pasting the array declaration and initialization code in each script. Seems cumbersome and kludgy. If I change or add to the tree in the future, I'll have to propagate the changes manually to each script - more kludgy copy-and-paste.

    Unlike hard-coded variables which most or all of the scripts use, I can't declare the arrays in a module and fill them - which seems to me the logical way to handle hard-coded arrays.

    Writing script to traverse the directory tree would work, but seems like unnecessary overhead for set-in-place traversing routines. And the traversing code would be copied-and-pasted into each script, which still seems kludgy. Likewise if I change or add to the directory - manual editing of the traverse code in each script.

    Creating a callable sub-routine in a module, which would declare and initialize the arrays, would work, but seems to be unnecessarily complicated overhead for a basic programming problem. Again, "making an easy thing hard", which just don't seem very Perl-like :)

Redirect to an XLSX spreadsheet
3 direct replies — Read more / Contribute
by rbholder
on Sep 13, 2014 at 11:48

    Long time listener, first time caller

    I am migrating all my Perl CGI web apps from a Rackspace server to an internal corporate server that is running Centos 6. I use Excel::Writer::XLSX to create a spreadsheet in a folder like /var/www/cgi-bin/app/temp/fName.xlsx and then use a statment like


    The intention is to automatically download the xlsx file like it does on the Rackspace server. The file is being created but I get an HTTP 500 error. I have all the AddTypes and AddHandlers on the internal server as I did on the Rackspace server. I am running Perl 5.20 and Apache 2.2. What gives?

Tk Osx X11 XQuartz
3 direct replies — Read more / Contribute
by Anonymous Monk
on Sep 13, 2014 at 05:35

    Dear Monks

    I developed a Tk software for Windows I deploy as EXE (ActiveState, PerlApp)

    I want now create a OSX Version of the software. I read a lot about the subject. It seems Tk (unfortunately I do not want to rewrite the enitre code, so I have to stik to Tk) needs X11 instaled on the user machine to work. Ok, I could ask user to install X11. But I've read that X11 is no more available, the only option beeing now XQuartz.

    My question is, anyone have experience in creating Perl Tk GUI software and deploying them on users' computer? Any issue with XQuartz? Before I start setting up my environment (I'd need to by a Mac too), I'd like to know if this is something which can be really done.

How to get non-redundant DNA sequences from a FASTA file?
3 direct replies — Read more / Contribute
by supriyoch_2008
on Sep 13, 2014 at 00:43

    Hi Perlmonks

    I am interested in getting the non-redundant DNA sequences from a FASTA file. Two sequences may have different headers but have the same DNA sequence. I want any one of these two sequences with its header in the output, not both. I have written a script ( but it does not give the results I want. I seek help from perl monks to fix this problem.

    Here goes the script

    #!/usr/bin/perl use warnings; $a=">gi1 cds ATG fun >gi2 cds ATG fun >gi3 cds GGG fun"; while ($a=~ m/(>.*?fun)/gs) { $b1=$&; $b2=$&; while ($b1=~ />.*?cds/gs) { $h=$&; $b2=~ s/$h//g; $b2=~ s/fun//g; $seq=$b2; $seq=~ s/\n//; $hdr_seq="$h\n"."$seq\n"; push @hdr_seq1,$hdr_seq; push @only_seq1,$seq; } } # To remove multiple copies (if any): my %seen; # declare a hash my @only_seq=(); my @hdr_seq=(); @only_seq=grep{!$seen{$_}++}@only_seq1; @hdr_seq=grep{!$seen{$_}++}@hdr_seq1; print "\n\n A. Header & sequences are:\n\n"; print join ("\n", @hdr_seq); print "\n"; print "\n B. Only sequences are:\n\n"; print join ("\n", @only_seq); print "\n\n"; $num=0; foreach my $item1 (@only_seq) {$num++; # No.1 curly $seq1=$item1; foreach my $item2 (@hdr_seq) { # No.2 curly if (defined $item2) { $item2=$item2; $item3=$item2;} while ($item2=~ m/>.*cds/gs) { $hdr2=$&; $item3=~ s/$hdr2//; $item3=~ s/\s//; $seq2=$item3; $ele2="$hdr2\n"."$seq2\n"; if ($seq1 eq $seq2) {push @result1,$ele2;} else {push @result1,$ele2;} } } # No.2 curly } # No.1 curly ###################################### my @result=(); @result=grep{!$seen{$_}++}@result1; print "\n C. Non-redundant sequences are:\n\n"; print join ("",@result); print "\n"; exit;

    The results of the script go like:

    Microsoft Windows [Version 6.1.7600] Copyright (c) 2009 Microsoft Corporation. All rights reserved. C:\Users\x\Desktop> A. Header & sequences are: >gi1 cds ATG >gi2 cds ATG >gi3 cds GGG B. Only sequences are: ATG GGG C. Non-redundant sequences are: (This is wrong) >gi1 cds ATG >gi2 cds ATG >gi3 cds GGG

    Correct results for Non-redundant sequences should be like:

    >gi1 cds ATG >gi3 cds GGG
dumping lexical filehandles (updated)
2 direct replies — Read more / Contribute
by LanX
on Sep 12, 2014 at 11:11

    I'm trying to understand how lexical filehandles are dumped:

    > perl use Data::Dumper qw/Dumper/; use Data::Dump; open my $fh,"<",'/tmp/tst'; dd $fh; dd $::{'$fh'}; print Dumper $fh; __END__ \*main::$fh undef $VAR1 = \*{'::$fh'};

    apparently $fh holds the ref to a glob named "\$fh" , i.e. with sigle as part of the name!

    But inspecting the STASH doesn't show this entry...

    I know that the common way to copy a bare filehandle to a scalar is my $fh=\*FH but this is confusing me.

    Is this an implementation workaround or what am I missing?


    Just after posting I'm realizing that I may be inspecting the wrong ($ = scalar) slot of the $fh glob. I'll update further tests.


    OK inspecting only the glob reveals it's existence in the stash:

    dd *{'::$fh'}; # => *main::$fh

    but I'm still a bit confused ...

    So lexical file handles are implemented as hidden global stash entries, which are destroyed when the lexical var falls out of scope ?

    Cheers Rolf

    (addicted to the Perl Programming Language and ☆☆☆☆ :)

New Meditations
The Case for Macros in Perl
5 direct replies — Read more / Contribute
by einhverfr
on Sep 12, 2014 at 23:07

    In some of my work I have started doing a lot more with higher order and functional Perl programming. A good example is PGObject::Util::DBMethod which provides a way to declaratively map stored procedures in Postgres to object methods. I have linked to the source code on github above because it is a good example of where macros would be very helpful.

    Now I will be the first to admit that in these cases, macros are not 100% necessary. The module above can accomplish what it needs to do without them. However the alternative, which means effectively creating a highly generalized anonymous coderef, setting up a custom execution environment for that coderef, and then installing the generalized coderef with the specific execution environment as a method has some significant drawbacks.

    Here's the particular section that does the main work:
    sub dbmethod { my $name = shift; my %defaultargs = @_; my ($target) = caller; my $coderef = sub { my $self = shift @_; my %args; if ($defaultargs{arg_list}){ %args = ( args => _process_args($defaultargs{arg_list}, @_) + ); } else { %args = @_; } for my $key (keys %{$defaultargs{args}}){ $args{args}->{$key} = $defaultargs{args}->{$key} unless $args{args}->{$key} or $defaultargs{strict_ar +gs}; $args{args}->{$key} = $defaultargs{args}->{$key} if $defaultargs{strict_args}; } for my $key(keys %defaultargs){ next if grep(/^$key$/, qw(strict_args args returns_objects) +); $args{$key} = $defaultargs{$key} if $defaultargs{$key}; } my @results = $self->call_dbmethod(%args); if ($defaultargs{returns_objects}){ for my $ref(@results){ $ref = "$target"->new(%$ref); } } if ($defaultargs{merge_back}){ _merge($self, shift @results); return $self; } return shift @results unless wantarray; return @results; }; no strict 'refs'; *{"${target}::${name}"} = $coderef; }

    Now that is 40 lines of code and 30 lines of it go into the coderef which is executed when the method is actually run. This doesn't seem too much but it does the work of 5-10 lines of code in an imperative style. In other words, it is 5-6 times as long and intensive as it needs to be.

    With macros, it would be quite possible to generate only the code needed for the specific function rather than creating a generalized case which has to handle many non-applicable inputs, and then create a context where it only gets what it needs.

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 musing on the Monastery: (6)
As of 2014-09-16 04:07 GMT
Find Nodes?
    Voting Booth?

    My favorite cookbook is:

    Results (155 votes), past polls