Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling
 
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
CSV file info into xml tags
1 direct reply — Read more / Contribute
by CSharma
on Jul 28, 2015 at 04:03
    Hi Everybody, I've tab delimited data as below:
    Retid State Rate 25 NJ 7.000 26 NJ 7.000 40 IL 9.750 40 IN 7.000 40 MI 6.000 40 WI 5.500 44 CT 6.000 50 NJ 7.000 87 VA 4.500

    I want all unique Retid, comma seperated State & State corresponding to that Retid. Later I would need to add this data into different xml file by comparing Retid (Which is already in other file). I think using hashes would be OK as I don't want to read file everytime (else script will run longer), but not sure how to do this! Could anyone please suggest?

    I've tried something like below:
    open(IN, $taxFile) || die "$taxFile couldn't be opened $@\n"; while(<IN>) { chomp; @line = split("\t"); $sid = $line[0]; $sidHash{$sid}{state} = $line[1]; $sidHash{$sid}{rate} = $line[2]; }
    Output file would be as below, where I'll add these 2 tags i.e. state & rate. Rest tags were read & printed from different file.
    <RetId="40"> <name>xyz</name> <url>http://www.xyz.net</url> <type>CPC</type> <logoUrl/> <ntParentAcct>5403020</ntParentAcct> <feedCount>1</feedCount> <feedNumbers>1</feedNumbers> <state>IN, MI, WI</state> <rate>7.000, 6.000, 5.500</rate> </RetId>
Overwriting Hash / Array
1 direct reply — Read more / Contribute
by iRemix94
on Jul 28, 2015 at 03:40

    Hello dear PERL Community!

    I am almost done with my PERL project, but I've got a problem with overwriting a hash / array reference. The problem is the @columns_import array. I put a hash reference into it, but the information is getting overwritten everytime. I always get the same import time. Any tip how to not overwrite the entries?

    Here's the code:

    for my $customer (keys %$bi) { #print "<$customer>\n"; if($tr_bgcolor==1) { $tr_bgcolor=0; } else { $tr_bgcolor=1; } for my $domain (keys %{$bi->{$customer}}) { # print " <$domain>\n"; my %data_structure; my @schedule_rows_loop; my @schedule_columns_loop; my @imp_exp_status_loop; $data_structure{CUSTOMER}=$customer; $data_structure{DOMAIN}=$domain; for my $host (keys %{$bi->{$customer}->{$domain}}) { my $schedule = $bi->{$customer}->{$domain}->{$host}->{BACK +UPCFG}->{EXPORT_SCHEDULE_1}->{VALUE}; if (defined $schedule) { my $import_value=$bi->{$customer}->{$domain}->{$host}- +>{BACKUPCFG}->{IMPORT_ACTIVE_1}->{VALUE}; my $export_value=$bi->{$customer}->{$domain}->{$host}- +>{BACKUPCFG}->{EXPORT_ACTIVE_1}->{VALUE}; my $scheduled_export_days =convert_seconds_days(($bi-> +{$customer}->{$domain}->{$host}->{BACKUPCFG}->{EXPORT_BACKUP_LIFETIME +_SEC_1}->{VALUE})); $data_structure{IMPORT_VALUE}=$import_value; $data_structure{EXPORT_VALUE}=$export_value; my @unsorted_schedule=split(/,/, $schedule); my @schedule= sort {$b <=> $a} @unsorted_schedule; + for my $schedule_hour ( @schedule ) { my @columns_export; my @columns_import; foreach my $i ( 1 .. $scheduled_export_days ) { my %column_data_export; my %column_data_import; $column_data_export{SCHEDULE} = $schedule_hour +; $column_data_export{UNDEF} = 1; for my $act (@{$bi->{$customer}->{$domain}->{$ +host}->{BACKUPDATA}}) { my $imp_exp_type= ($act->{ACTION_TYPE}); my $imp_exp_status= ($act->{STATUS}); my @schedule_time = split(/:/, $schedule_ +hour); my $minutes_range = (@schedule_time[1]+30) + % 60; if($imp_exp_type eq "IMPORT") # +#### -> Here's the relevant part { # print Dumper(\%column_data_import)."\ +n"; my $endtime_sec = ($act->{ENDDATE_SEC} +); my $import_start = $unit->formatDateTi +me ($endtime_sec); my @imp_start = split(/ /,$import_star +t); my @imp_hours_unformated = split(/:/, +@imp_start[1]); my $imp_hour = "@imp_hours_unformated[ +0]"; my $imp_minutes ="@imp_hours_unformate +d[1]"; my $imp_formated_hour ="$imp_hour:$imp +_minutes"; $column_data_import{SCHEDULE} = $imp_f +ormated_hour; $column_data_import{UNDEF} = 1; } if($imp_exp_type eq "EXPORT") { my $startdate_sec = ($act->{STARTDATE_ +SEC}); my $export_start = $unit->formatDateTi +me ($startdate_sec); my @exp_start = split(/ /,$export_star +t); my @exp_hours_unformated = split(/:/, +@exp_start[1]); + my $exp_date = @exp_start[0]; my $exp_hour = "@exp_hours_unformated[ +0]"; my $exp_minutes ="@exp_hours_unformate +d[1]"; if ($exp_date eq @localtime_date[$i-1] + and $exp_hour eq @schedule_time[0] and $exp_minutes <= $minutes_rang +e) + + { + + + + #my $link =$customer."_".$domain." +_".@localtime_date[$i-1]."_".$exp_hour."_".$imp_exp_type.".html"; + my $link =$customer."_".$domain."_ +".@localtime_date[$i-1]."_".$exp_hour."_".$imp_exp_type.".html"; + + + $column_data_export{LINK} =$link; if( $imp_exp_status eq "OK") { $column_data_export{OK} = 1; + $column_data_export{UNDEF} = 0 +; } elsif( $imp_exp_status eq "FAILED" +) { $column_data_export{FAILED} = +1; $column_data_export{UNDEF} = 0 +; } } elsif( @localtime_date[0] eq @localtim +e_date[$i-1] and $hour eq @schedule_time[0] and $min <= $minutes_rang +e and $column_data_export{UNDEF} = 1) { $column_data_export{RUNNING} = 1; $column_data_export{UNDEF} = 0; } } } push (@columns_export, \%column_data_export); + push (@columns_import, \%column_data_import); } if($scheduled_export_days!=7) { my $rest_days = 7-$scheduled_export_days; for ( 1 .. $rest_days) { push (@columns_import, { SCHEDULE => '&nbs +p;', UNDEF => '1'}); push (@columns_export, { SCHEDULE => '&nbs +p;', UNDEF => '1'}); } } push ( @schedule_rows_loop, { SCHEDULE_COLUMNS_EXP +ORT => \@columns_export } ); push ( @schedule_rows_loop, { SCHEDULE_COLUMNS_IMP +ORT => \@columns_import } ); } } } $data_structure{BGCOLOR_CUSTOMER}= $tr_bgcolor; $data_structure{SCHEDULE_ROWS} = \@schedule_rows_loop; push (@data_structure_loop, \%data_structure); my $dumper_file = Dumper(\@data_structure_loop)."\n"; open(my $fh, '>', $log); print $fh "$dumper_file"; close $fh; print Dumper(\@data_structure_loop)."\n"; } } $template->param(DATA_STRUCTURE => \@data_structure_loop); my $overview_output= $template->output; open(my $fh, '>', $overview_location); print $fh "$overview_output"; close $fh;

    That's what the Dumper gives me for a relevant entry:

    { 'IMPORT_VALUE' => '1', 'BGCOLOR_CUSTOMER' => 0, 'SCHEDULE_ROWS' => [ { 'SCHEDULE_COLUMNS_EXPORT' => [ { 'S +CHEDULE' => '20:00', 'U +NDEF' => 1 }, { 'L +INK' => 'CUSTOMERA_DOMAINA_27.07.2015_20_EXPORT.html', 'O +K' => 1, 'S +CHEDULE' => '20:00', 'U +NDEF' => 0 }, { 'L +INK' => 'CUSTOMERA_DOMAINA_26.07.2015_20_EXPORT.html', 'O +K' => 1, 'S +CHEDULE' => '20:00', 'U +NDEF' => 0 }, { 'L +INK' => 'CUSTOMERA_DOMAINA_25.07.2015_20_EXPORT.html', 'O +K' => 1, 'S +CHEDULE' => '20:00', 'U +NDEF' => 0 }, { 'S +CHEDULE' => '20:00', 'U +NDEF' => 1 }, { 'S +CHEDULE' => '20:00', 'U +NDEF' => 1 }, { 'S +CHEDULE' => '20:00', 'U +NDEF' => 1 } ] }, { 'SCHEDULE_COLUMNS_IMPORT' => [ { 'S +CHEDULE' => '23:42', 'U +NDEF' => 1 }, { 'S +CHEDULE' => '23:42', 'U +NDEF' => 1 }, { 'S +CHEDULE' => '23:42', 'U +NDEF' => 1 }, { 'S +CHEDULE' => '23:42', 'U +NDEF' => 1 }, { 'S +CHEDULE' => '23:42', 'U +NDEF' => 1 }, { 'S +CHEDULE' => '23:42', 'U +NDEF' => 1 }, { 'S +CHEDULE' => '23:42', 'U +NDEF' => 1 } ] } ], 'EXPORT_VALUE' => '1', 'DOMAIN' => 'DOMAINA', 'CUSTOMER' => 'CUSTOMERA' },
How to get the color values from eps files
1 direct reply — Read more / Contribute
by ananthakumarj
on Jul 27, 2015 at 23:53

    Hi All,

    I need to get color values (CMYK, RGB, MONO) from "EPS" files, is this possible... If yes is there any module available to achieve this. Please suggest how to do this..

    Regards,

    Kumar J

Moops: meta not available in role
2 direct replies — Read more / Contribute
by Oberon
on Jul 27, 2015 at 21:28

    This doesn't seem to work for me:

    use v5.14.4; use warnings; use autodie qw< :all >; use Moops; role Foo { #use Moose::Role; use Data::Printer; p __PACKAGE__->meta; } 1;

    First of all, should it? If not, why not? Note that if you uncomment the commented line, then it works fine. But that seems redundant to me.

    To clarify, when I say "doesn't work," what I mean is:

    Can't locate object method "meta" via package "Foo" at test.pm line 12 +. BEGIN failed--compilation aborted at test.pm line 13.

    What I really want to do is this:

    role Foo { use Moose::Util; Moose::Util::meta_attribute_alias 'Foo'; }

    but not being able to get the meta means that fails as well:

    Can't call method "isa" on an undefined value at /home/buddy/perl5/perlbrew/perls/perl-5.14.4/lib/site_perl/5.14.4/x86_64-linux/Moose/Util.pm line 335.

    Enlighten me, O fellow monks. What is the magical Moops incantation I'm missing here?

RE: split function not working as expected
3 direct replies — Read more / Contribute
by lonewolf28
on Jul 27, 2015 at 20:48

    Hi Monks, I've been trying out challenges in codeeval and in one of the challenges when i tried to split a string using "|" delimiter the split function wasn't working as it should.

    my $string = 'osSE5Gu0Vi8WRq93UvkYZCjaOKeNJfTyH6tzDQbxFm4M1ndXIPh27wBA + rLclpg| 3 35 27 62 51 27 46 57 26 10 46 63 57 45 15 43 53'; my ( $first, $second ) = split ( "|", $string ); say "first:", $first; say "second:", $second; Output: first:o second:s

    what mistake am i making ? I'd expect the first variable to hold the random characters and second to hold the numbers.

Recognizing numbers
2 direct replies — Read more / Contribute
by htmanning
on Jul 27, 2015 at 19:17
    Can someone tell me the difference between these two snippets? I'm trying to recognize numbers in a variable and return an error if a number is detected. For example, there is no reason to have a number in the "name" field.
    if ($var1 =~ /^[0-9]+$/); if ($var2 =~ /^\S{11,}$/);
GetTimeSysInfoFunc function
2 direct replies — Read more / Contribute
by thanos1983
on Jul 27, 2015 at 18:44

    Hello Monks,

    I just came across with GetTimeSysInfoFunc. This function is written for C++ in WindowsOS.

    Does anybody know any similar module or function for Perl, WindowsOS or LinuxOS?

    I want to retrieve all the interesting information that the function can provide.

    This is a long shot question, but just in case that someone knows something it would be great.

    Thanks in advance for your time and effort reading and replying to my question.

    Seeking for Perl wisdom...on the process of learning...not there...yet!
Capture uncommented keywords
1 direct reply — Read more / Contribute
by ExReg
on Jul 27, 2015 at 16:33
    I am working on a large script to analyze code. I am trying to find key words in code, but not if they are in commented lines. Thus, if I am looking for foo, I want to match
    maybe some stuff foo maybe some more stuff;
    but not
    // maybe some stuff foo maybe some more stuff;
    This looks like an appropriate place to use a negative lookbehind assertion. I have not found the right form yet. Experimenting, I have tried
    $a="abcdefghijklm"; 1 print "match" if ( $a =~ /(?<!cde).*?jkl/ ); # match because a do +es not match cde, then bcdefghi follows, then jkl matches? 2 print "match" if ( $a =~ /(?<=cde).*?jkl/ ); # match because cde +matches then fgh follws, then jkl matches $a="xyzfghijklm"; 1 print "match" if ( $a =~ /(?<!cde).*?jkl/ ); # match because cde +is not before jkl, then jkl matches 2 print "match" if ( $a =~ /(?<=cde).*?jkl/ ); # no match because c +de is not before jkl

    I am looking for a regex that will not match abcdefghijklm because cde precedes jkl, but would match xyzfghijkl. I would have thought that something like the first one above would be what I wanted.

    If I wanted it to not match when jkl must not be preceded by only c, the answer is easy: ^[^c]*jkl. But I have multiple character cde things I must exclude.

    I am guessing that what I am looking for will have a (?<!cde) and then a jkl in it.

    One trick I used several years ago, seems to work here. Since you cannot do variable length lookbehinds, I can reverse the strings and then do variable length lookaheads. i.e.

    $a = "mlkjihgfedcba"; print "match" if ( $a =~ /lkj(?!.*?edc/ ); # no match because edc D +OES follow lkj. This is what is desired. (It does not match in the un +reversed when cde precedes jkl) $a = "mlkjihgfzyx"; print "match" if ( $a =~ /lkj(?!.*?edc/ ); # match because edc does + not follow lkj. Again, this is what I want. ( It does match jkl in t +he unreversed when not preceded by cde)

    Is there another way?

    I am guessing this is one of those areas where regexes come up short. I just learned about (?{ }) and (??{ }), but don't fully understand them yet. Where is a good place to learn advanced regex aside from perlre and Friedl?

    I am limited to perl 5.6, if that makes a difference. I cannot use CPAN or any other libraries.

    If this question seems disjoint, it is because my brain stores in hashes instead of sorted arrays.

How to open an URL with variable in CGI?
3 direct replies — Read more / Contribute
by msomanat
on Jul 27, 2015 at 16:17
    Hi perl monks, I am very new to CGI scripting, and stuck up here. I am using an HTML to POST some data, and analyzing it at CGI script. With the output I get after analysis, I need to open another cgi at a different server. This is what I have tried.
    print $q->start_form( -name => 'main_form2', -method => 'POST', -action => 'http://xxx.com/cgi-bin/perforce?&Submit=describe&changenu +m=$1', -target => '_blank', ); print $q->submit( -name => 'submit_form2', -value => 'See the change', ); print $q->end_form;
    I have two problems here. 1) I cannot pass a variable. $1 won't work 2) If I pass it hardcoded, it would work, but the variables after 'perforce?' are not considered, until I refresh the newly opened page. This is my first CGI script,and need your help badly. Thanking in advance, Manoj
<p> issue with code to save config on brocade swicth</p>
1 direct reply — Read more / Contribute
by janasec
on Jul 27, 2015 at 13:29

    I need help on configuring the brocade switch,I am able to execute simple commands to check the config,but I fail when their is some interactive options,like I have to save the config on the switch by passing yes or y to save it

    the code is here below

    $logger->info("create zone on the switch $ip using zonecreate"); ($out,$err) = $ssh->capture2("zonecreate \"test1\", \"20:00:00:11:0d:3 +4:56:00\""); $ssh->error and die "remote find command failed: $!" . $ssh->error; ($out,$err)=$ssh->capture2("zoneshow"); ($out,$err) = $ssh->capture2("cfgadd \"FC_DVT\", \"test1\""); $ssh->error and die "remote find command failed: $!" . $ssh->error; ($out,$err) = $ssh->capture2("{stdin_data =>yes},cfgsave"); $ssh->error and die "remote find command failed: $!" . $ssh->error;

    switch commands should execute as follows

    DS_6505B:admin> zonecreate "test1","20:00:00:11:0d:34:56:00" DS_6505B:admin> cfgadd "FC_DVT","test1" DS_6505B:admin> cfgsave WARNING!!! The changes you are attempting to save will render the Effective configuration and the Defined configuration inconsistent. The inconsistency will result in different Effective Zoning configurations for switches in the fabric if a zone merge or HA failover happens. To avoid inconsistency it is recommended to commit the configurations using the 'cfgenable' command. Do you want to proceed with saving the Defined zoning configuration only? (yes, y, no, n): [no] y Updating flash ... DS_6505B:admin> cfgenable FC_DVT You are about to enable a new zoning configuration. This action will replace the old zoning configuration with the current configuration selected. If the update includes changes to one or more traffic isolation zones, the update may result in localized disruption to traffic on ports associated with the traffic isolation zone changes Do you want to enable 'FC_DVT' configuration (yes, y, no, n): [no] y zone config "FC_DVT" is in effect Updating flash ...

    Iam having issue in executing the above commands

    the error i get when i run is like this, 2015/07/28 04:10:31 zoneshow successful 2015/07/28 04:10:34 create zone on the switch 10.227.0.216 using zonec +reate remote find command failed: child exited with code 1 at ./switchconfig +.pl line 113, <$fh> line 4.

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!
  • 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 rifling through the Monastery: (12)
    As of 2015-07-28 09:10 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

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









      Results (254 votes), past polls