Beefy Boxes and Bandwidth Generously Provided by pair Networks
We don't bite newbies here... much
 
PerlMonks  

crusty_collins

by crusty_collins (Pilgrim)
on May 18, 2005 at 16:37 UTC ( #458284=user: print w/replies, xml ) Need Help??


Posts by crusty_collins
Do a named regex group in 5.8? in Seekers of Perl Wisdom
3 direct replies — Read more / Contribute
by crusty_collins
on Feb 08, 2016 at 15:57
    I was wondering if I can do a named group regex with some kind of trickery like is available in 5.10?
    any ideas?


    snippet from http://www.regular-expressions.info/refext.html
    (?<x>abc){3} matches abcabcabc. The group x matches abc.

    "We can't all be happy, we can't all be rich, we can't all be lucky and it would be so much less fun if we were. There must be the dark background to show up the bright colours." Jean Rhys (1890-1979)
Negative Lookbehind question in Seekers of Perl Wisdom
3 direct replies — Read more / Contribute
by crusty_collins
on Nov 11, 2015 at 12:40
    I am trying to get my mind around negative look behinds. This is something that I am working on but did not write.

    I think that it looks for the number of spaces to remove the right txt. If I use the script as written it does NOT grab the STATE ZIPCODE section.

    If I change

    $addr =~ s/(?<![|\s])\s{25,}[^|]+//g; # extra right-text
    to
    $addr =~ s/(?<![|\s])\s{27,}[^|]+//g; # extra right-text
    then i get the STATE and ZIPCODE

    this is the example script

    use strict; use warnings; my $addr = '| + Note 00 +001| FIRST LAST NAME| ADDRESS 1 + Interest Rate + 5.450000| CITY STATE ZIPCODE| + YTD Interest $4,442.64| Total Payment Amount + $886.00| + Escrow Portion $ +344.49|'; print "address to parse : \n $addr \n"; $addr =~ s/\|\s{25,}[^|]+//g; # rm spaces left $addr =~ s/(?<![|\s])\s{27,}[^|]+//g; # extra right-text $addr =~ s/\s*\|\s*/|/g; $addr =~ s/\|{2,}/|/g; $addr =~ s/\s+\|$//; $addr =~ s/\s+/ /g; # use up to 6 of last lines for addr $addr = join('|', (split('\|', "||||||$addr"))[-6..-1]); $addr =~ s/^\|+//; print "Result addr : \n $addr \n";
    Output
    c:\Users\collinsc\dev>perl lookBehind.pl Address to parse : | + Note 00001| +FIRST LAST NAME| ADDRESS 1 Interest Rat +e 5.450000| CITY + STATE ZIPCODE| + YTD Interest $4,442.64| Total Payment Amount + $886.00| + Escrow Portion $ +344.49| Result addr : FIRST LAST NAME|ADDRESS 1|CITY STATE ZIPCODE
    Question If the spaces are outside of the negative look behind section how is this working?
Regex to ignore comment in Seekers of Perl Wisdom
4 direct replies — Read more / Contribute
by crusty_collins
on Oct 20, 2015 at 12:51
    I have a regex that ignores the comment in a string.

    $line =~ /pattern\s*=*\s*([\w\d\s\\\/\.\-\@\!\$\%\^\&\*\:\;\,\<\>]+)/

    I know that this is NOT the way to go about it. I have tried to get everything but after the comment like this.

    $line =~ /pattern\s*=*\s*(.+?)\s+[^#]/
    but it is not working.

    QUESTION. What is the proper regex to do this?

    use strict; use warnings; my $count; my $env = []; foreach my $line ( <DATA> ) { chomp($line); next if $line =~ /^\s*\#/; next if $line =~ /^$/; # file is in the format of # [zipcode] # regex (?<Zip>\d{5})-(?<Sub>\d{4}) # pattern 95076-1234 # pattern 90210-6473 # [IP] # regex = (?<First>2[0-4]\d|25[0-5]|[01]?\d\d?)\.(?<Second>2[0 +-4]\d|25[0-5]|[01]?\d\d?)\.(?<Third>2[0-4]\d|25[0-5]|[01]?\d\d?)\.(?< +Fourth>2[0-4]\d|25[0-5]|[01]?\d\d?) # pattern = 255.257.0.0 # invalid # # if ($line =~ /^\[([\w\s\\]+)\]/ ) { my $tag = $1; $count = scalar @{$env}; $env->[$count]->{tag} = $tag; } elsif ( $line =~ /regex\s*=*\s*(.+)|regex\s*=*\s*/ ) { my $regex = $1; if ( $env->[$count]->{'regex'} ) { $env->[$count]->{'regex'} .= $regex; }else{ $env->[$count]->{'regex'} = $regex; } } # comments are ignored elsif ( $line =~ /pattern\s*=*\s*([\w\d\s\\\/\.\-\@\!\$\%\^\&\ +*\:\;\,\<\>]+)|pattern\s*=*\s*/ ){ my $pattern = $1; push( @{$env->[$count]->{pattern}} , $pattern); } } __DATA__ [IP] regex = (?<First>2[0-4]\d|25[0-5]|[01]?\d\d?)\.(?<Second>2[0-4]\d|25[0 +-5]|[01]?\d\d?)\.(?<Third>2[0-4]\d|25[0-5]|[01]?\d\d?)\.(?<Fourth>2[0 +-4]\d|25[0-5]|[01]?\d\d?) pattern = 255.257.0.0 # invalid pattern = 192.168.1.1
regex : get a paragraph, not just line in Seekers of Perl Wisdom
6 direct replies — Read more / Contribute
by crusty_collins
on Mar 18, 2015 at 13:52
    All knowing monks.

    I have a regex problem that i cant figure out.

    I need to get the following paragraph out of a file.

    First i get that account number then i get the paragraph.

    Question : How do i get the full paragraph skipping the cr and lf (\r\n)? Code

    use strict; use warnings; use Data::Dumper; my $self = {}; while (my $line = <DATA>) { if( $line =~ /ACCOUNT\s+NUMBER\s+(\d+)/ ){ $self->{ACCOUNTNUMBER} = $1; print "$1 \n"; }elsif ($line =~ /^(YOUR[\s\w]+)(\d+\.\d+)(.*)/sm ){ print "$1 $2 $3 \n"; } } __DATA__ ACCOUNT NUMBER 000111111111 YOUR LOAN PAYMENT FOR THE YEAR WILL BE 00.00 OF WHICH 00.00 WILL BE FOR PRINCIPAL AND INTEREST, 00.00 WILL GO ESCROW ACCOUNT, AND .00 WILL BE FOR DISCRETIONARY ITEMS THAT YOU CHOSE TO BE INCLUDED WITH YOUR LOAN PAYMENT. THE EFFECTIVE DATE OF YOUR NEW SCHEDULED PAYMENT IS 00/00/00.
    Output
    000111111111 YOUR LOAN PAYMENT FOR THE COMING YEAR WILL BE 0 0.00
split problem in Seekers of Perl Wisdom
2 direct replies — Read more / Contribute
by crusty_collins
on Oct 02, 2014 at 14:01
    I must be brain dead today because i cant figure this out. I want to split the __DATA__ into an array wiht the | (pipe) character but it just splits it by each character. Code
    #!/usr/bin/perl use strict; use warnings; while (<DATA>){ chomp; next if (/Order/); print (" string $_ \n"); $_ =~ s/\"//g; my @array = split /|/ ; print(" order $array[0] \n"); } __DATA__ "129822"|"Custom Currency"|"Living the Dream"|"400" "129823"|"Custom Currency"|"Living the Dream"|"500" "129824"|"Custom Currency"|"Living the Dream"|"600" "129825"|"Custom Currency"|"Living the Dream"|"700" "129826"|"Custom Currency"|"Living the Dream"|"800"
    Output
    string "129822"|"Custom Currency"|"Living the Dream"|"400" order 1 string "129823"|"Custom Currency"|"Living the Dream"|"500" order 1 string "129824"|"Custom Currency"|"Living the Dream"|"600" order 1 string "129825"|"Custom Currency"|"Living the Dream"|"700" order 1 string "129826"|"Custom Currency"|"Living the Dream"|"800" order 1 string
SQL in files or File::Slurp? in Seekers of Perl Wisdom
3 direct replies — Read more / Contribute
by crusty_collins
on Aug 04, 2014 at 13:38
    I have various Perl programs that access a database. My question is do I use File::Slurp to read the SQL into the program or do I just put the SQL into the Perl program?

    I think it makes the program cleaner but I am worried about someone deleting the SQL files

    File Slurp

    $sql = read_file("$ref->{config}->{SQLDIR}/USPS.sql"); &getOrders($ref,$sql);

    File in program

How to debug .lib files? in Seekers of Perl Wisdom
1 direct reply — Read more / Contribute
by crusty_collins
on Jul 09, 2014 at 11:25
    Most venerable monks i have a question for you.

    I am working on legacy code and they used lib files to house all of their functions. The coder uses require to load the function. What is the best way to debug these? Here is snippet of their code The run.pl sets up the environment and then the Currency.pl runs. -- /jet/prod/run.pl /jet/prod/Currency.pl

    relavant piece of /jet/prod/Currency.pl
    require "$mainProcDir/lib/getCurrencyOrderFiles.lib"; # MAIN PROCESSING SUBROUTINE %mainVars; $mainVars = \%mainVars; main($msgLVL);
    the main function of lib/getCurrencyOrderFiles.lib
    sub main { my ($msgLVL) = @_; my $sub = 'main'; print "-- Beginning [$sub]\n" if $msgLVL > 1; getInitParms($msgLVL); my @files = getFiles($msgLVL); # # my @files = ("chi_Currency_20130828*.txt"); for my $file (@files) { print "\t FILE -> $file\n" if $msgLVL > 1; moveFile($msgLVL,$file); stageExtTblFiles($msgLVL,$file); my $batch_id = loadOrders($msgLVL); archiveFiles($msgLVL, $batch_id); } print "-- Leaving [$sub]\n" if $msgLVL > 1; }
Net::Ftp question in Seekers of Perl Wisdom
1 direct reply — Read more / Contribute
by crusty_collins
on May 01, 2014 at 13:20
    How to i get a value in the \*Symbol::GEN1

    I would like to get this variable 'net_cmd_resp' => '"/test" directory created.' ,

    use strict; use warnings; use Data::Dumper; use Net::FTP; $Data::Dumper::Terse = 0; $Data::Dumper::Sortkeys = 1; $Data::Dumper::Purity = 1; foreach (<DATA>){ chomp; my ($user, $passwd) = split(/,/,$_); next if (length $user <= 0); print $user . " " . $passwd . "\n"; chomp $user; chomp $passwd; my $ftp = Net::FTP->new('xxxxxxx', Debug => 0, Passive => 1); my $r = $ftp->login($user,$passwd); print Dumper $ftp; if ( $r ne 1){ print "Could not login\n\n"; sleep(5); }else{ my $r = $ftp->mkdir('test'); print Dumper $ftp; if ( $r ne 1){ print "Could not make dir\n"; }else{ $ftp->rmdir('test'); } } } __DATA__ a,1fpcq b,sVzqD c,KN6Vi d,AcT_2
    Gives this output of
    a 1fpcq $VAR1 = bless( \*Symbol::GEN1, 'Net::FTP' ); *Symbol::GEN1 = { 'io_sock_nonblocking' => 0, 'io_socket_domain' => 2, 'io_socket_proto' => 6, 'io_socket_timeout' => 120, 'io_socket_type' => 1, 'net_cmd_code' => '550', 'net_cmd_debug' => 0, 'net_cmd_lines' => [], 'net_cmd_partial' => '', 'net_cmd_resp' => [ '"/test" directory created.' + ], 'net_ftp_blksize' => 10240, 'net_ftp_host' => 'xxxxxxxxxx', 'net_ftp_localaddr' => undef, 'net_ftp_passive' => 1, 'net_ftp_type' => 'A' }; ETC....
How do i register a new Subroutine in Wx? in Seekers of Perl Wisdom
1 direct reply — Read more / Contribute
by crusty_collins
on Mar 12, 2014 at 10:48

    Maybe I am using the wrong Module for the job? I have a task to get a scanned file and save it to two locations. Then email it to a group.

    I have added the Email subroutine to working code and I get this error.

    Undefined subroutine &MyFrame::Email called at C:/xxxxx.
    here is my program
    #!C:\perl64\bin\perl.exe -w use strict; use Wx; use Mail::Outlook; package MyFrame; use Wx qw (wxVERTICAL wxTOP wxGROW wxHORIZONTAL wxTE_MULTILINE wxFIXED +_MINSIZE wxLEFT ); use base 'Wx::Frame'; # import the event registration function use Wx::Event qw(EVT_BUTTON); sub new { my $ref = shift; my $self = $ref->SUPER::new( undef, # parent window -1, # ID -1 means any 'Scan Cards', # title [-1, -1], # default position [430, 140], # size ); my $panel = Wx::Panel->new( $self, # parent window -1, # ID ); my $button = Wx::Button->new( $panel, # parent window -1, # ID 'Save File', # label [40, 40], # position [-1, -1], # default size ); my $sendemail = Wx::Button->new( $panel, # parent window -1, # ID 'Send Email', # label [130, 40], # position [-1, -1], # default size ); $self->{txt} = Wx::TextCtrl->new( $panel, # parent window -1, # control identifier "", # default text value [40, 10], # text control position [x, y] [200, 20], # text control size [width, height] # style: wxTE_MULTILINE=The text control allo +ws multiple lines ); # register the OnClick method as an handler for the # 'button clicked' event. The first argument is a Wx::EvtHandler # that receives the event EVT_BUTTON( $self, $button, \&OnClick ); EVT_BUTTON( $self, $sendemail, \&Email ); return $self; } # this method receives as its first parameter the first argument # passed to the EVT_BUTTON function. The second parameter # always is a Wx::Event subclass sub OnClick { my( $self, $event ) = @_; if (my $rr = $self->{txt}->GetValue()) { print $rr."\n"; my $local = 'C:\Users\christopherc\Documents\Projects\remakes' +; my $remote = '\\\\jservdc01\\Fulfill\\Gavehren\\remakes'; my $localFile = $local . "\\" . $rr . "\.txt"; my $remoteFile = $remote . "\\" . $rr . "\.txt"; # save to a dir and put it local and remote open (FH, "> $localFile"); print FH "$rr \n"; close FH; open (REMOTE, "> $remoteFile"); print REMOTE "$rr \n"; close REMOTE; # $self->{txt2}->AppendText($rr."\n"); } $self->SetTitle( 'Clicked' ); } package MyApp; use base 'Wx::App'; sub OnInit { my $frame = MyFrame->new; $frame->Show( 1 ); } sub Email() { my( $self, $event ) = @_; my $msg = "\n"; my $emailSUBJ = "Card number "; my @emailRECIPIENTS; @emailRECIPIENTS = qw(xxx@xxx.com); if (my $rr = $self->{txt}->GetValue()) { $msg .= " $rr\n"; $msg .= " \\\\jservdc01\\Fulfill\\Gavehren\\remakes\n"; } my $outlook = new Mail::Outlook(); my $message = $outlook->create(); $message->To('you@example.com'); $message->Cc('Them <them@example.com>'); $message->Bcc('Us <us@example.com>; anybody@example.com'); $message->Subject('Blah Blah Blah'); $message->Body('Yadda Yadda Yadda'); # $message->Attach(@lots_of_files); # $message->Attach(@more_files); # attachments are appended # $message->Attach($one_file); # so multiple calls are allowed $message->send; return; } package main; my $app = MyApp->new; $app->MainLoop;
Can you tell what $$$\@ means? in Seekers of Perl Wisdom
2 direct replies — Read more / Contribute
by crusty_collins
on Apr 26, 2008 at 23:42
    Just curious, but what does this mean? I was browsing some code from sourceforge and came across a function that starts like this
    sub extract_seed_page($$$\@){ my ($filepath, $keyword, $percent, $phrase_list_ref) = @_;
Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
NodeReaper edits tomorrow's obituaries

How do I use this? | Other CB clients
Other Users?
Others contemplating the Monastery: (8)
As of 2016-12-06 14:22 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    On a regular basis, I'm most likely to spy upon:













    Results (105 votes). Check out past polls.