Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
PerlMonks  

crusty_collins

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


Posts by crusty_collins
Sorting files by 3 numbers in the name in Seekers of Perl Wisdom
7 direct replies — Read more / Contribute
by crusty_collins
on May 26, 2017 at 09:37
    I have a task that requires me to sort several files by 3 numbers in the file name. What I have so far is a sort by a single number (run).
    Question : How can I sort by 3 numbers
    #!/usr/bin/perl use strict; use warnings; use Data::Dumper; # sort by run then by dist then by copy then by total # run district copy t +otal # | | | | #ASR0004994_8958_ETSTexas_EOC052017P_0517_Candidate_RRD_178901_02_04_S +pr17_Initial_201705040951_41043.zip my @files = qw( ASR0005336_8950_ETSTexas_EOC052017P_0517_Candidate_RRD_178904_01_0 +2_Spr17_Initial_201705040952_41044.zip ASR0004520_8960_ETSTexas_EOC052017P_0517_Candidate_RRD_178901_04_0 +4_Spr17_Initial_201705040952_41045.zip ASR0004994_8958_ETSTexas_EOC052017P_0517_Candidate_RRD_178901_02_0 +4_Spr17_Initial_201705040951_41043.zip ASR0005336_8950_ETSTexas_EOC052017P_0517_Candidate_RRD_178904_02_0 +2_Spr17_Initial_201705040952_41044.zip ASR0005154_8957_ETSTexas_EOC052017P_0517_Candidate_RRD_178901_01_0 +4_Spr17_Initial_201705040951_41042.zip ASR0005336_8959_ETSTexas_EOC052017P_0517_Candidate_RRD_178901_03_0 +4_Spr17_Initial_201705040952_41044.zip ASR0005336_8972_ETSTexas_EOC052017P_0517_Candidate_RRD_178902_01_0 +1_Spr17_Initial_201705040952_41044.zip ); # this sorts by the run number my @returnfiles = sort { ( $a =~ /^[^\d]*\d+_(\d{4})/ )[0] <=> ( $b =~ + /^[^\d]*\d+_(\d{4})/ )[0] } @files ; print Dumper @returnfiles;
    "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)
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;
Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others about the Monastery: (6)
As of 2024-03-19 02:16 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found