Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW

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
Mocked query returns wrong result
2 direct replies — Read more / Contribute
by Anonymous Monk
on Oct 24, 2014 at 10:37

    Hi perl monks

    I'm trying to mock an sql call (for practice purposes) using DBD::Mock and i'm getting a wrong result.


    #!use/local/bin/perl use Test::More qw (no_plan); use Data::Dumper; use DIR::DBTeams; use constant DB => "dbi::Mock:"; use constant DB_USER => "mock"; use constant DB_PWD => "mock"; my $db; my $query; my $columns; my @boundparams; my @results; my $test_teams; $query = q(select decode(substr(te.TEAM_ID,1,2),'MU','Manchester Unite +d', 'RM', 'Real Madrid')) from Teams t inner join TEAMS_EUROPE.TEAM_REF te + on t.TEAM_REF = te.TEAM_REF and t.TEAM_REF=:ref); $boundparams=('123'); #123 is reference for MU $columns=('TEAM_ID'); @results=('Manchester United'); $db = &connectDB(DB,DB_USER,DB_PWD); my $session = DBD::Mock::Session->new('my_sesion' => ( { statement => $query, bound_params = [@boundparams], results => [[$columns],[@results]] } ) ); $db->{mock_session}=$session; $test_teams = new DBTeams($db, $boundparams[0]); is($test_teams, "Manchester United", "Test Teams"); sub connectDB($$$) { my $dbh = DBI->connect($_[0],$_[1],$_[2]); return $dbh; }

    Code : DBTeams

    package DIR::DBTeams; use DBI; sub new { my $class = shift; my $self = {}; my ($dbh,$ref) = @_; $self->{dbh} = $dbh; &getTeam($ref); } sub getTeam { my $me = shift; my $ref = shift; my $ret; my $cur = $me->{dbh}->prepare( q(select decode(substr(te.TEAM_ID,1,2),'MU','Manchester United', 'RM', 'Real Madrid')) from Teams t inner join TEAMS_EUROPE.TEAM_REF te + on t.TEAM_REF = te.TEAM_REF and t.TEAM_REF=:ref)); $cur->bind_param(':ref',$ref); $cur->execute() or croak $cur->errstr; $ret = $cur->fetchrow_array(); $cur->finish; return $ret; }

    The code seems ok, but when it runs, instead of getting 'Manchester United', the method returns 1.

    I tried debugging and several alternatives and none seem to work.

    Finaly i tried changing the original code:

    Code : DBTeams

    ... ($ret) = $cur->fetchrow_array(); ...

    By placing $ret in ( ), the code now returns what i want. However, i want to know if there is an alternative that allows me to get the result i want without changing the original code.

    Can someone help me? Thanks

Windows folder access error
2 direct replies — Read more / Contribute
by ArifS
on Oct 24, 2014 at 10:31
    I am getting the following error when try to execute the following code-
    # c:\Folders\1Folder\1aFolder my $directory = "\\Folders\\1Folder\\1aFolder"; print "Folder: ", $directory, "\n"; opendir (DIR, $directory) or die $!; while (my $fldr = readdir(DIR)) { print "Files & Folders: ", $fldr, "\n"; }
    Folder: \Folders\1Folder\1aFolder Invalid argument at c:\temp\dir1A9A.tmp\ line ...##. Press any key to continue . . .
    Pointing to line - opendir (DIR, $directory) or die $!;

    Please let me know
Net::LDAP, Active Directory, Move accounts across domain in forest?
No replies — Read more | Post response
by TomJ_SC
on Oct 24, 2014 at 10:25

    I am not new to Net::LDAP but I am unsure how to approach this problem.

    I have no issues using moddn to move accounts within a domain. However, I have a need to move users from one domain to another in the same Active Directory Forest (2008R2 functional).

    My initial plan was to delete the account from one domain and then create the account in the new domain. This brings up obvious issues (need to migrate emails, password reset to generated default, etc).

    I see that there is an option to move accounts within the same forest. It also appears that moddn does not support this and I do not see any help from Net::LDAP::Extra::AD (although reset_ADpassword and change_ADpassword are awesome-THANKS!). ,/p>

    Any guidance pointers?

    Thanks for your time and reading this.


refine output of Dumper
4 direct replies — Read more / Contribute
by kaka_2
on Oct 24, 2014 at 06:04
    Hello Monks, i have following code which works well. only problem is output does not looks good.
    use strict; use warnings; use Data::Dumper; $Data::Dumper::Terse=1; my $StatChk="cat /tmp/teststatus.txt | grep -v OK"; my $GoodStat="OK"; my @SChk_Out; open (DChk, "$StatChk |") || die "Failed: $!\n"; @SChk_Out = <DChk>; close (DChk); print "Output of command is =".Dumper(@SChk_Out);
    and Output is:
    [ 'Station 7777: Not good. ', 'Station 7778: Not Good ' ]
    how can i have output just
    Station 7777: Not good. Station 7778: Not good.

    it is important that i use the Dumper. in my actual program i cant just print array. (kind of limitation)

    any help in this regard will be appriciated.
A free Bulletin Board / Discussion Forum for Commercial use
1 direct reply — Read more / Contribute
by perlron
on Oct 24, 2014 at 03:26
    Hi Monks,
    The background is im running out of time to develop a custom solution for a web customer. In the meantime, ive got a hang of CGI::Application while focussing on the rest of the site.

    Id like to know if i can get my hands on "trivial/simple" "customizable" bulletin board or discussion forum software from the perl source repositories.
    Since i have a hang of CGI::Application and a little Dancer , any BB's made using these two gr8 frameworks would be really fast for me to hack into and deploy. I am charging the client for developing a website, so i infer this is a commercial purpose im going to use the BB for.

    I hope this is the right forum to solicit such an opinion. else please redirect.

    Do not wait to strike till the iron is hot! Make it hot by striking - WB Yeats
Output to STDOUT and print last line to console
2 direct replies — Read more / Contribute
by waytoperl
on Oct 24, 2014 at 00:31

    I have a situation to write output to a file and also print on console or CMD. Need feedback on my non-working code. Thanks.

    #!/usr/bin/env perl -w use strict; use warnings; use Fcntl; use Tie::File; #-- saving result to output.txt open STDOUT, ">", "output.txt" or die "$0: open: $!"; #-- write to output.txt and print on console print "##Start of SCRIPT.PL##\n"; my $run = ""; system($run); #-- open the file tie my @rows, 'Tie::File', 'output.txt', autochomp => 0 or die "error: + $!\n"; #-- print last line of output.txt on console print "$rows[-1]";
Debugging Bioperl warnings for Genebank files that are missing info
1 direct reply — Read more / Contribute
by Sosi
on Oct 23, 2014 at 18:33

    Oh thy masters of Perl wisdom, please enlighten me. I am struggling with some problems reading Genebank files (.gbff) through Bioperl.

    I am trying to extract CDS and translation sequences using $feat->spliced_seq->seq and $feat->get_tag_values("translation")). My problem is that many of the genebank files are incomplete or are not matching the "correct" (example) format:

    LOCUS SCU49845 5028 bp DNA PLN 21-JUN-1 +999 DEFINITION Saccharomyces cerevisiae TCP1-beta gene, partial cds, and +Axl2p (AXL2) and Rev7p (REV7) genes, complete cds. ... JOURNAL Submitted (22-FEB-1996) Terry Roemer, Biology, Yale Univer +sity, New Haven, CT, USA FEATURES Location/Qualifiers source 1..5028 /organism="Saccharomyces cerevisiae" /db_xref="taxon:4932" /chromosome="IX" /map="9" CDS <1..206 /codon_start=3 /product="TCP1-beta" /protein_id="AAA98665.1" /db_xref="GI:1293614" /translation="SSIYN...RTANRQHM" gene 687..3158 /gene="AXL2" CDS 687..3158 /gene="AXL2" /note="plasma membrane glycoprotein" /codon_start=1 /function="required for axial budding pattern of +S. cerevisiae" /product="Axl2p" /protein_id="AAA98666.1" /db_xref="GI:1293615" /translation="MTQL...GRIPEML" gene complement(3300..4037) /gene="REV7" CDS complement(3300..4037) /gene="REV7" /codon_start=1 /product="Rev7p" /protein_id="AAA98667.1" /db_xref="GI:1293616" /translation="MNRWVEK...IFGSLF" ORIGIN 1 gatcctccat ata...tgatc //

    Many of the files that I have either do not have the "Origin" field at the bottom (example), or have multiple "Origin" fields (example), each just after a "CDS" field, resulting in warnings and die errors that prevent me from doing what I need to do. Most of the warnings indicate that Bioperl hasn't been able to infer the

    So my questions are the following:

    1. Could you give me any tips on how I can find which of the files have this incorrect file format? I am figuring that a if($feat->spliced_seq->seq) fails, push those filenames to a list and manually download them again :( But I haven't been able to test this correctly yet, and maybe there is something already in Bioperl for these cases?

    2. How can I prevent the automatic die everytime a warning comes out, so that I can find the whole list of files that is not designed as it should? Curiously, through the ~1000 files that I am running, the script runs for a few hundreds, outputing those errors but quits at some point. I must say that I have use autodie; in the preamble, but I think the die command is being given by Bioperl.

In-Place Editing Problem
2 direct replies — Read more / Contribute
by wlh4
on Oct 23, 2014 at 17:54
    I'm looking for help on where to start looking for the solution to a problem. I have a large amount of code, but I created a little subroutine to receive a file name (full path) and a substitution. The object is to open the file using the $^I variable for in-place editing, substitute some code for the passed in code, and then exit the subroutine. Very, very simple. I place the file name into @ARGV by simple assignment statement and then do a while ( <> ) { s/../../; print } loop. Very, very simple. The problem is that when it is run, Perl first asks for input from STDIN; when I hit Ctrl-D, it then opens the file and makes the substitution. I have made sure that the only thing in @ARGV is the file I want to change. I tried an experiment by copying the subroutine code verbatim and placing it into a separate file, made it executable, and then called it from within the subroutine, and it works without asking for input from STDIN. What could possibly be making my subroutine ask for STDIN if the code is run from within my program, but not when it is run from a separate process? Thanks for any help. wlh
adding arrays to an array
1 direct reply — Read more / Contribute
by coolda
on Oct 23, 2014 at 17:43

    Hello, I'm having a problem trying to add arrays to an array. My purpose is to see if each files have the same first columns, and output a file that doesn't have the same columns. All the files follow the same table format(tab delimited). So from each file, i took out the first column and stored it to an array(@row1). And i stored those arrays of first column in to another array @row. However, when i run it, @row doesn't contain array but number of columns. when i print $row [0] , $row[ 2) or etc, it will print numbers not the array of columns i intended to store. can someone tell me how i can fix this problem?

    #!/usr/bin/perl -w use strict; use warnings; use File::Basename; die "Usage: perl [directory where files are located] \n +" unless ($#ARGV ==0); my ($folderin) = @ARGV ; #$dirname = "/data/lgsg/yuho/ProjectSuccess.extracting2columns/sort/ge +neReadCount" opendir(DIR, "$folderin") || die "cannot openfolder"; my @list = readdir (DIR); closedir(DIR); for(1..2){shift @list;} my ($filecount, $rowcount) = 0 ; my (@filename, @row); foreach my $fileone (@list) { $filename[$filecount] = $fileone; open(RES,"$folderin/$fileone") || die "could nottt open $fileone\n +"; <RES>; <RES>; my $count = 0; my $row1; my @genes; while(<RES>){ $row1[$count] =(split /\t/)[0]; $count++; } $row[$filecount] = @row1; $filecount++; } my $unmatched = 0 ; my @names; my $filecount1 =$filecount-1; for (my$chr =1; $chr <= $filecount1; $chr++){ if ($row[0] ne $row[$chr]) { $names[$unmatched] =$filename[$chr]; $unmatched++; } } print "Total # of files compared: $filecount \n"; print "Total # of files unmatched: $unmatched\n"; print "name of the files unmatched : @names \n " ;
cell background color in EXCEL::WRITER::XLSX
2 direct replies — Read more / Contribute
by fionbarr
on Oct 23, 2014 at 16:21
    I am having good success with this module but I cannot find the documention on setting a cell background color. Ideas please.

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
  • Outside of code tags, you may need to use entities for some characters:
            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 cooling their heels in the Monastery: (16)
    As of 2014-10-24 16:19 GMT
    Find Nodes?
      Voting Booth?

      For retirement, I am banking on:

      Results (132 votes), past polls