[31424] in Perl-Users-Digest

home help back first fref pref prev next nref lref last post

Perl-Users Digest, Issue: 2676 Volume: 11

daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sat Nov 14 18:09:45 2009

Date: Sat, 14 Nov 2009 15:09:07 -0800 (PST)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)

Perl-Users Digest           Sat, 14 Nov 2009     Volume: 11 Number: 2676

Today's topics:
    Re: How to get a program output into array <derykus@gmail.com>
    Re: How to identify double bytes language? <hjp-usenet2@hjp.at>
    Re: How to identify double bytes language? <jurgenex@hotmail.com>
    Re: How to identify double bytes language? <rvtol+usenet@xs4all.nl>
    Re: How to identify double bytes language? <ben@morrow.me.uk>
        perl tk call on close <robin1@cnsp.com>
    Re: perl tk call on close (Jens Thoms Toerring)
    Re: perl tk call on close (Jens Thoms Toerring)
    Re: perl tk call on close <robin1@cnsp.com>
    Re: perl tk call on close (Jens Thoms Toerring)
    Re: Please help with processing flat file <nobody@nowhere.com>
    Re: Please help with processing flat file sln@netherlands.com
    Re: Please help with processing flat file <nobody@nowhere.com>
    Re: Please help with processing flat file <jegan473@comcast.net>
    Re: Please help with processing flat file <rkb@i.frys.com>
    Re: Please help with processing flat file (Doug Miller)
        Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)

----------------------------------------------------------------------

Date: Fri, 13 Nov 2009 22:04:23 -0800 (PST)
From: "C.DeRykus" <derykus@gmail.com>
Subject: Re: How to get a program output into array
Message-Id: <69153b24-1874-4385-ac8b-f645ee9080c1@j9g2000prh.googlegroups.com>

On Nov 13, 6:00=A0am, Thomas Barth <txba...@web.de> wrote:
> Hi,
> any Idea how to get the output of this command into an array? The output
> is still printed to the screen. The array @soxin keeps empty.
>
> =A0 =A0 =A0open(SOXIN, "sox $path -r 8000 -c 1 $src_dir/$basename.vox sta=
t |");
> =A0 =A0 =A0my @soxin =3D <SOXIN>;
> =A0 =A0 =A0close(SOXIN);
>

IPC::Run is another possibility:



use IPC::Run qw( run );
use strict ;
use warnings;

# ***** untested *****

run ["sox $path -r 8000 -c 1 $src_dir/$basename.vox stat"],
     '<', \my @soxin, \my $err
  or die "Markdown.pl failed: $?";

--
Charles DeRykus



------------------------------

Date: Sat, 14 Nov 2009 11:03:44 +0100
From: "Peter J. Holzer" <hjp-usenet2@hjp.at>
Subject: Re: How to identify double bytes language?
Message-Id: <slrnhft041.rtk.hjp-usenet2@hrunkner.hjp.at>

On 2009-11-14 03:31, sqlcamel <sqlcamel@yahoo.com.hk> wrote:
> Thanks for all the suggestions.

Please don't top-post. Quote the relevant parts of the posting you are
replying to and write your answers below each part.

> What I wanted is, for example, given the text piece below:
>
> There is a 中国人 in the park.
>
> So how to scratch the gb2312 word of 中国人 from the text?

There isn't a "gb2312 word" in the text. The whole text is gb2312. 

You want to distinguish the Chinese characters from the Latin
characters. 

I think in GB2312 this is easy: Just search for pairs of bytes with the
high bit set. 

But in general I would convert the whole text to Unicode and check the
character properties. This works for *all* encodings, no matter how
complicated they are:

#!/usr/bin/perl
use warnings;
use strict;

binmode STDIN, ":encoding(GB2312)"; # input is GB2312
binmode STDOUT, ":encoding(UTF-8)"; # my terminal is UTF-8

while (read(STDIN, my $char, 1)) {
    my $classes = "";
    for my $class (qw(Han Latin)) {
	if ($char =~ /\p{$class}/) {
	    $classes .= " $class";
	}
    }
    print "$char - $classes\n";
}
__END__

Prints for a file containing "There is a 中国人 in the park." in GB2312:


T -  Latin
h -  Latin
e -  Latin
r -  Latin
e -  Latin
  - 
i -  Latin
s -  Latin
  - 
a -  Latin
  - 
中 -  Han
国 -  Han
人 -  Han
  - 
i -  Latin
n -  Latin
  - 
t -  Latin
h -  Latin
e -  Latin
  - 
p -  Latin
a -  Latin
r -  Latin
k -  Latin
 . - 

 - 


	hp


------------------------------

Date: Sat, 14 Nov 2009 10:25:15 -0800
From: Jürgen Exner <jurgenex@hotmail.com>
Subject: Re: How to identify double bytes language?
Message-Id: <p3ttf552c41rj1d9mde0pibkehrvm5biaj@4ax.com>

[Please no TOFU, trying to repair]
sqlcamel <sqlcamel@yahoo.com.hk> wrote:
>> On 2009-11-13, sqlcamel <sqlca...@yahoo.com.hk> wrote:
>> > I have a text file, there are some double-bytes words in it, like
>> > Chinese, Japanese.
>> > Is there a way to identify them separately with Perl? Thanks.
>
>What I wanted is, for example, given the text piece below:
>
>There is a ?????? in the park.
>
>So how to scratch the gb2312 word of ?????? from the text?

gb2312 is a character set, it includes at least Chinese as well as Latin
characters. Therefore all of your text is gb2313, not just that word.

Now, having said that your real task seems to be to distinguish between
Latin/ASCII/.... and non-Latin/ASCII/... characters.
There are several POSIX classes in the regular expressions that will
help you with that, please check 'perldoc perlre' for what is most
suitable for you.

jue 


------------------------------

Date: Sat, 14 Nov 2009 22:19:07 +0100
From: "Dr.Ruud" <rvtol+usenet@xs4all.nl>
Subject: Re: How to identify double bytes language?
Message-Id: <4aff1ecb$0$22940$e4fe514c@news.xs4all.nl>

Ben Morrow wrote:
> Dr.Ruud:

>> The data in the "double-byte" encoded files (probably Shift-JIS, GB2312 
>> or Big5) will just become normal Perl strings if the right IO-layer is used.
> 
> No, they will become SvUTF8 strings, which (shouldn't, but do) behave
> differently from byte strings under some circumstances.

Please Ben, stop messing things up. I said Perl strings, not byte 
strings. The unit of Perl strings is characters, not bytes.

-- 
Ruud


------------------------------

Date: Sat, 14 Nov 2009 22:02:33 +0000
From: Ben Morrow <ben@morrow.me.uk>
Subject: Re: How to identify double bytes language?
Message-Id: <p0m3t6-vah.ln1@osiris.mauzo.dyndns.org>


Quoth "Dr.Ruud" <rvtol+usenet@xs4all.nl>:
> Ben Morrow wrote:
> > Dr.Ruud:
> 
> >> The data in the "double-byte" encoded files (probably Shift-JIS, GB2312 
> >> or Big5) will just become normal Perl strings if the right IO-layer is used.
> > 
> > No, they will become SvUTF8 strings, which (shouldn't, but do) behave
> > differently from byte strings under some circumstances.
> 
> Please Ben, stop messing things up. I said Perl strings, not byte 
> strings. The unit of Perl strings is characters, not bytes.

That's beside the point. The point is that if a program that formerly
only dealt with byte strings is changed so that SvUTF8 strings are
involved, some important assumptions will be broken. For example, /\w/
will now (sometimes) match more than /[A-Za-z0-9_]/, which is more
likely to be unintended and unwanted than the reverse. For this reason,
if the OP is about to arrange to have his input data converted to SvUTF8
strings, he should read perlunicode so he has some idea of the potential
problems to expect.

Ben



------------------------------

Date: Sat, 14 Nov 2009 00:03:57 -0800 (PST)
From: Robin <robin1@cnsp.com>
Subject: perl tk call on close
Message-Id: <da2f2d02-f863-4f77-916e-8b125054907e@d10g2000yqh.googlegroups.com>

anyone know how you can make a tk perl program call a subrountine when
you close the MainWindow? I looked all over the web and perldocs but
couldn't find how....
Thanks,
-Robin


------------------------------

Date: 14 Nov 2009 09:30:48 GMT
From: jt@toerring.de (Jens Thoms Toerring)
Subject: Re: perl tk call on close
Message-Id: <7m7bm8F3fnpb2U1@mid.uni-berlin.de>

Robin <robin1@cnsp.com> wrote:
> anyone know how you can make a tk perl program call a subrountine when
> you close the MainWindow? I looked all over the web and perldocs but
> couldn't find how....

If you have

use Tk;
my $main = MainWindow->new( );
$main->protocol( 'WM_DELETE_WINDOW' => sub { print "XXX\n" } );
MainLoop;

then trying to close the window should result in "XXX" getting
printed out instead of closing the window (you would need to
add "$main->destroy" to the subroutine to be executed in order
to get the window also closed). But note that this only works
when the window gets closed in a "gentle" way, i.e. by the win-
dow manager sending it a message asking it to destroy itself
(but I guess that's what most "close buttons" do).

                           Regards, Jens
-- 
  \   Jens Thoms Toerring  ___      jt@toerring.de
   \__________________________      http://toerring.de


------------------------------

Date: 14 Nov 2009 10:22:43 GMT
From: jt@toerring.de (Jens Thoms Toerring)
Subject: Re: perl tk call on close
Message-Id: <7m7enjF3g35fnU1@mid.uni-berlin.de>

Jens Thoms Toerring <jt@toerring.de> wrote:
> Robin <robin1@cnsp.com> wrote:
> > anyone know how you can make a tk perl program call a subrountine when
> > you close the MainWindow? I looked all over the web and perldocs but
> > couldn't find how....

Some more: with

> use Tk;
> my $main = MainWindow->new( );
> $main->protocol( 'WM_DELETE_WINDOW' => sub { print "XXX\n" } );
> MainLoop;

the sub will only execute when the close button (or something
similar) of the window manager is used to close the window but
not when you you call "$main->destroy".

If you want to get a sub invoked whenever the window is closed
whatever way you instead should bind the <Destroy> event like
this:

$main->bind( '<Destroy>' => sub { print "YYY\n" if $_[0] == $main } );

Note the check for the first argument the function gets passed:
the sub gets called for each subwidget in the window as it is
destroyed and the first argument is the object getting destroyed.
Thus if you want things to get run once instead for each sub-
widget then you have to return from the sub immediately unless
the argument is the main window.

BTW, there's also the comp.lang.perl.tk newsgroup which might
be an even better place to go to when you have questions about
Perl Tk.
                            Regards, Jens
-- 
  \   Jens Thoms Toerring  ___      jt@toerring.de
   \__________________________      http://toerring.de


------------------------------

Date: Sat, 14 Nov 2009 13:00:03 -0800 (PST)
From: Robin <robin1@cnsp.com>
Subject: Re: perl tk call on close
Message-Id: <0e94c5c4-3cba-4879-93a0-95afb0083e21@a31g2000yqn.googlegroups.com>

On Nov 14, 2:30=A0am, j...@toerring.de (Jens Thoms Toerring) wrote:
> Robin <rob...@cnsp.com> wrote:
> > anyone know how you can make a tk perl program call a subrountine when
> > you close the MainWindow? I looked all over the web and perldocs but
> > couldn't find how....
>
> If you have
>
> use Tk;
> my $main =3D MainWindow->new( );
> $main->protocol( 'WM_DELETE_WINDOW' =3D> sub { print "XXX\n" } );
> MainLoop;
>
> then trying to close the window should result in "XXX" getting
> printed out instead of closing the window (you would need to
> add "$main->destroy" to the subroutine to be executed in order
> to get the window also closed). But note that this only works
> when the window gets closed in a "gentle" way, i.e. by the win-
> dow manager sending it a message asking it to destroy itself
> (but I guess that's what most "close buttons" do).
>
> =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0 =A0Regards, Jens
> --
> =A0 \ =A0 Jens Thoms Toerring =A0___ =A0 =A0 =A0j...@toerring.de
> =A0 =A0\__________________________ =A0 =A0 =A0http://toerring.de



Thanks for your reply.
It probably will help alot.

I will look up the docs for the protocol sub. I am trying to design a
html editor. Do you want me to mail you the source code when I get it
finished?



-Robin


------------------------------

Date: 14 Nov 2009 22:06:12 GMT
From: jt@toerring.de (Jens Thoms Toerring)
Subject: Re: perl tk call on close
Message-Id: <7m8nukF3dkkkpU1@mid.uni-berlin.de>

Robin <robin1@cnsp.com> wrote:
> I will look up the docs for the protocol sub.

There's not too much I found, all I did see is from

perldoc Tk::Wm

As far as I understand it the window manager sends a message of
type WM_DELETE_WINDOW to the application (notifying it via an
event of type ClientMessage) when the "close button" is clicked
on (or something similar tells the window manager that the user
wants the window removed) and the application can react to this
message. Most applications just react by to closing the window
(and exiting if this was their only window) but they can do
whatever they want and using

$toplevel->protocol( 'WM_DELETE_WINDOW => sub{ } );

installs a handler for this message to be used instead of the
default.
                              Regards, Jens
-- 
  \   Jens Thoms Toerring  ___      jt@toerring.de
   \__________________________      http://toerring.de


------------------------------

Date: Sat, 14 Nov 2009 15:01:02 GMT
From: nobody <nobody@nowhere.com>
Subject: Re: Please help with processing flat file
Message-Id: <OCzLm.201238$Gs.53645@en-nntp-01.dc1.easynews.com>

On Fri, 13 Nov 2009 20:37:20 -0600, Tad McClellan wrote:

Thanks for your answer, it does exactly as I asked.  However, the data 
files I'm dealing with are more complicated.  In the __DATA__ below, as 
part of the 06020004293 records, Fred has two daughters, both of which 
comprise a 'B' record.  Fred's 06020004293 data outputs Sue Flintstone
twice like:

Name: Fred Flintstone  
Daughter: Sue Flintstone   
Daughter2: Sue Flintstone   
Company: Gravel Pit
OldCompany: Loney Toons       
Street: 123 Bedrock Road

The first should be Jane Flintstone, so I'm trying to do something in the 
code below where it says "NEED Daughter2".  Any help would be greatly 
appreciated again!



#!/usr/bin/perl
use warnings;
use strict;

my $flag = 0;

my %buffer;
while ( <DATA> ) {
    chomp;
    my $code = substr $_, 12, 1;

    if ( $code eq 'A' ) {
        if ( keys %buffer) {
            output(%buffer);
            %buffer = ();
        }
        $buffer{Name} = substr $_, 14, 17;
        $buffer{Street} = substr $_, 32, 17;
    }
    elsif ( $code eq 'B' ) {
        $buffer{Daughter} = substr $_, 14, 17;
        $flag = 1;


####### NEED Daughter2

        if ($buffer{Daughter}) {
          $buffer{Daughter2} = substr $_, 14, 17;
        }


    }
    elsif ( $code eq 'C' ) {
        $buffer{Company} = substr $_, 32, 18;
    }
    elsif ( $code eq 'D' ) {
        $buffer{OldCompany} = substr $_, 14, 18;
    }
    else {
        warn "code '$code' is invalid\n";
    }
}

output(%buffer);


sub output {
    my %h = @_;
    foreach my $key qw/Name Daughter Daughter2 Company OldCompany Street/ 
{
        print "$key: ";
        print $h{$key} if defined $h{$key};
        print "\n";
    }
    print "\n";
}


__DATA__
06020004293 A Fred Flintstone   123 Bedrock Road
06020004293 B Jane Flintstone   123 Bedrock Road
06020004293 B Sue Flintstone    123 Bedrock Road
06020004293 C Bedrock           Gravel Pit
06020004293 D Loney Toons       123 Bedrock Road
07020000279 A George Washington 234 Washington Ave.
07020000279 C Washington D.C.   234 Washington Ave.
09020000251 A Joe Smith         54 Abbey Road
09020000251 C Smallville        54 Abbey Road



------------------------------

Date: Sat, 14 Nov 2009 08:37:33 -0800
From: sln@netherlands.com
Subject: Re: Please help with processing flat file
Message-Id: <aqltf5544ndkil6247pnkfd8k5b9d4dhm8@4ax.com>

On Sat, 14 Nov 2009 00:12:20 GMT, nobody <nobody@nowhere.com> wrote:

>I'm trying to process flat files with many thousands of records.  In 
>these files several rows comprise the information for a single customer.  
>In the example __DATA__ below, I'm trying to fill the variables with the 
>customer information while the customer number is 06020004293, then for 
>customer number 07020000279, and finally customer number 09020000251.  I 
>believe my problem is looping while the customer number remains the same, 
>then move on to the next customer numbers.  I've been pulling my hair out 
>with nested while and do loops.  I've included the desired output below.  
>Here's what I'm working with so far:
>

Hey dude, I see your on your 5th or 7th incarnation of this so called
problem. Several threads later this flat file is in a fixed width form,
but at least its in the same flintstone janra. You should work for WB's
or try upgrading your cable subscription to something other than toon tv.

 "I've been pulling my hair out with nested while and do loops...
  Here's what I'm working with so far:"

Oh yeah, where is that code you've been laboring and pulling your hair out
on? Below? Don't make me laugh, below is crap junk a 2 year old could scribble.
And this is your output, from your code:

    Name: Joe Smith
    City: Smallville
    Street: 23 Bedrock Road

This is the best line so far in this thread:

  "I've included the desired output below."

The only thing you have done is abuse the patrons here and insulted
thier intelligence. Every thread you start on this flat Flinstone file,
with its multiple formats, you have included your desired output.

Unfortunately, your desired output changes as frequently as the
flat file format, as if your trying to write the flintstone format from
pre-determined crap code.

Be honest, you really DON'T have "flat files with many thousands of records",
do you?


>
>#!/usr/bin/perl
>
>use strict;
>use warnings;
>
 [snip]
>while (<DATA>) {
 ^^^^^^^^
"I've been pulling my hair out with nested while and do loops"

This must be the nested while and do loops ...

-sln


------------------------------

Date: Sat, 14 Nov 2009 18:10:29 GMT
From: nobody <nobody@nowhere.com>
Subject: Re: Please help with processing flat file
Message-Id: <poCLm.191369$Ca6.97784@en-nntp-03.dc1.easynews.com>

On Sat, 14 Nov 2009 08:37:33 -0800, sln wrote:

> On Sat, 14 Nov 2009 00:12:20 GMT, nobody <nobody@nowhere.com> wrote:
> 
>>I'm trying to process flat files with many thousands of records.  In
>>these files several rows comprise the information for a single customer.
>>In the example __DATA__ below, I'm trying to fill the variables with the
>>customer information while the customer number is 06020004293, then for
>>customer number 07020000279, and finally customer number 09020000251.  I
>>believe my problem is looping while the customer number remains the
>>same, then move on to the next customer numbers.  I've been pulling my
>>hair out with nested while and do loops.  I've included the desired
>>output below. Here's what I'm working with so far:
>>
>>
> Hey dude, I see your on your 5th or 7th incarnation of this so called
> problem. Several threads later this flat file is in a fixed width form,
> but at least its in the same flintstone janra. You should work for WB's
> or try upgrading your cable subscription to something other than toon
> tv.
> 


Hey dude, you're confused.  I'm working with various data files in 
various formats.  Some are flat files, some are delimited.  You should 
learn some manners, give up your lame attempts at humor,  And learn how 
to spell genera.



------------------------------

Date: Sat, 14 Nov 2009 19:06:18 GMT
From: James Egan <jegan473@comcast.net>
Subject: Re: Please help with processing flat file
Message-Id: <KcDLm.201487$Gs.177939@en-nntp-01.dc1.easynews.com>

On Fri, 13 Nov 2009 20:37:20 -0600, Tad McClellan wrote:

> nobody <nobody@nowhere.com> wrote:
>> I'm trying to process flat files with many thousands of records.  In
>> these files several rows comprise the information for a single
>> customer. In the example __DATA__ below, I'm trying to fill the
>> variables with the customer information while the customer number is
>> 06020004293, then for customer number 07020000279, and finally customer
>> number 09020000251.


I answered my own question.  See the block below:

    elsif ( $code eq 'B' ) {
        $buffer{Daughter2} = substr $_, 14, 17;

        if (!defined $buffer{Daughter}) {
          $buffer{Daughter} = substr $_, 14, 17;
        }


#!/usr/bin/perl
use warnings;
use strict;

my $flag = 0;

my %buffer;
while ( <DATA> ) {
    chomp;
    my $code = substr $_, 12, 1;

    if ( $code eq 'A' ) {
        if ( keys %buffer) {
            output(%buffer);
            %buffer = ();
        }
        $buffer{Name} = substr $_, 14, 17;
        $buffer{Street} = substr $_, 32, 17;
    }
    elsif ( $code eq 'B' ) {
        $buffer{Daughter2} = substr $_, 14, 17;

        if (!defined $buffer{Daughter}) {
          $buffer{Daughter} = substr $_, 14, 17;
        }


    }
    elsif ( $code eq 'C' ) {
        $buffer{Company} = substr $_, 32, 18;
    }
    elsif ( $code eq 'D' ) {
        $buffer{OldCompany} = substr $_, 14, 18;
    }
    else {
        warn "code '$code' is invalid\n";
    }
}

output(%buffer);


sub output {
    my %h = @_;
    foreach my $key qw/Name Daughter Daughter2 Company OldCompany Street/ 
{
        print "$key: ";
        print $h{$key} if defined $h{$key};
        print "\n";
    }
    print "\n";
}


__DATA__
06020004293 A Fred Flintstone   123 Bedrock Road
06020004293 B Jane Flintstone   123 Bedrock Road
06020004293 B Sue Flintstone    123 Bedrock Road
06020004293 C Bedrock           Gravel Pit
06020004293 D Loney Toons       123 Bedrock Road
07020000279 A George Washington 234 Washington Ave.
07020000279 C Washington D.C.   234 Washington Ave.
07020000279 B Linda Washington  234 Washington Ave.
07020000279 B Sue Washington    234 Washington Ave.
09020000251 A Joe Smith         54 Abbey Road
09020000251 C Smallville        54 Abbey Road


------------------------------

Date: Sat, 14 Nov 2009 12:56:44 -0800 (PST)
From: Ron Bergin <rkb@i.frys.com>
Subject: Re: Please help with processing flat file
Message-Id: <6164f600-64b8-4a17-8dbf-483213eb1c4c@y28g2000prd.googlegroups.com>

On Nov 14, 11:06=A0am, James Egan <jegan...@comcast.net> wrote:
> On Fri, 13 Nov 2009 20:37:20 -0600, Tad McClellan wrote:
> > nobody <nob...@nowhere.com> wrote:
> >> I'm trying to process flat files with many thousands of records. =A0In
> >> these files several rows comprise the information for a single
> >> customer. In the example __DATA__ below, I'm trying to fill the
> >> variables with the customer information while the customer number is
> >> 06020004293, then for customer number 07020000279, and finally custome=
r
> >> number 09020000251.
>
> I answered my own question. =A0See the block below:
>
> =A0 =A0 elsif ( $code eq 'B' ) {
> =A0 =A0 =A0 =A0 $buffer{Daughter2} =3D substr $_, 14, 17;
>
> =A0 =A0 =A0 =A0 if (!defined $buffer{Daughter}) {
> =A0 =A0 =A0 =A0 =A0 $buffer{Daughter} =3D substr $_, 14, 17;
> =A0 =A0 =A0 =A0 }
>
> #!/usr/bin/perl
> use warnings;
> use strict;
>
> my $flag =3D 0;
>
> my %buffer;
> while ( <DATA> ) {
> =A0 =A0 chomp;
> =A0 =A0 my $code =3D substr $_, 12, 1;
>
> =A0 =A0 if ( $code eq 'A' ) {
> =A0 =A0 =A0 =A0 if ( keys %buffer) {
> =A0 =A0 =A0 =A0 =A0 =A0 output(%buffer);
> =A0 =A0 =A0 =A0 =A0 =A0 %buffer =3D ();
> =A0 =A0 =A0 =A0 }
> =A0 =A0 =A0 =A0 $buffer{Name} =3D substr $_, 14, 17;
> =A0 =A0 =A0 =A0 $buffer{Street} =3D substr $_, 32, 17;
> =A0 =A0 }
> =A0 =A0 elsif ( $code eq 'B' ) {
> =A0 =A0 =A0 =A0 $buffer{Daughter2} =3D substr $_, 14, 17;
>
> =A0 =A0 =A0 =A0 if (!defined $buffer{Daughter}) {
> =A0 =A0 =A0 =A0 =A0 $buffer{Daughter} =3D substr $_, 14, 17;
> =A0 =A0 =A0 =A0 }
>
> =A0 =A0 }
> =A0 =A0 elsif ( $code eq 'C' ) {
> =A0 =A0 =A0 =A0 $buffer{Company} =3D substr $_, 32, 18;
> =A0 =A0 }
> =A0 =A0 elsif ( $code eq 'D' ) {
> =A0 =A0 =A0 =A0 $buffer{OldCompany} =3D substr $_, 14, 18;
> =A0 =A0 }
> =A0 =A0 else {
> =A0 =A0 =A0 =A0 warn "code '$code' is invalid\n";
> =A0 =A0 }
>
> }
>
> output(%buffer);
>
> sub output {
> =A0 =A0 my %h =3D @_;
> =A0 =A0 foreach my $key qw/Name Daughter Daughter2 Company OldCompany Str=
eet/
> {
> =A0 =A0 =A0 =A0 print "$key: ";
> =A0 =A0 =A0 =A0 print $h{$key} if defined $h{$key};
> =A0 =A0 =A0 =A0 print "\n";
> =A0 =A0 }
> =A0 =A0 print "\n";
>
> }
>
> __DATA__
> 06020004293 A Fred Flintstone =A0 123 Bedrock Road
> 06020004293 B Jane Flintstone =A0 123 Bedrock Road
> 06020004293 B Sue Flintstone =A0 =A0123 Bedrock Road
> 06020004293 C Bedrock =A0 =A0 =A0 =A0 =A0 Gravel Pit
> 06020004293 D Loney Toons =A0 =A0 =A0 123 Bedrock Road
> 07020000279 A George Washington 234 Washington Ave.
> 07020000279 C Washington D.C. =A0 234 Washington Ave.
> 07020000279 B Linda Washington =A0234 Washington Ave.
> 07020000279 B Sue Washington =A0 =A0234 Washington Ave.
> 09020000251 A Joe Smith =A0 =A0 =A0 =A0 54 Abbey Road
> 09020000251 C Smallville =A0 =A0 =A0 =A054 Abbey Road

Personally, I don't like using a series of if/elsif blocks when
testing the same var over and over again.

I prefer to use a dispatch table.

This version puts the whole file into the hash, but it's very easy to
add the few extra lines to only store 1 record at a time like Tad
showed.

#!/usr/bin/perl

use strict;
use warnings;
use Data::Dumper;

my %accounts;
my %account =3D (
            A =3D> \&Name,
            B =3D> \&Children,
            C =3D> \&Company,
            D =3D> \&OldCompany,
);


while ( <DATA> ) {
    chomp;
    my $id   =3D substr $_, 0, 11;
    my $code =3D substr $_, 12, 1;

    if ( exists $account{$code} ) {
        $account{$code}->($id);
    }
    else {
        warn "code '$code' is invalid\n";
    }
}

print Dumper \%accounts;


sub Name {
    $accounts{$_[0]}{Name} =3D substr $_, 14, 17;
    $accounts{$_[0]}{Street} =3D substr $_, 32, 17;
}

sub Children {
    push @{$accounts{$_[0]}{Children}}, substr $_, 14, 17;
}

sub Company {
    $accounts{$_[0]}{Company} =3D substr $_, 32, 18;
}

sub OldCompany {
    $accounts{$_[0]}{OldCompany} =3D substr $_, 14, 18;
}


__DATA__
06020004293 A Fred Flintstone   123 Bedrock Road
06020004293 B Jane Flintstone   123 Bedrock Road
06020004293 B Sue Flintstone    123 Bedrock Road
06020004293 C Bedrock           Gravel Pit
06020004293 D Loney Toons       123 Bedrock Road
07020000279 A George Washington 234 Washington Ave.
07020000279 C Washington D.C.   234 Washington Ave.
07020000279 B Linda Washington  234 Washington Ave.
07020000279 B Sue Washington    234 Washington Ave.
09020000251 A Joe Smith         54 Abbey Road
09020000251 C Smallville        54 Abbey Road


------------------------------

Date: Sat, 14 Nov 2009 23:04:44 GMT
From: spambait@milmac.com (Doug Miller)
Subject: Re: Please help with processing flat file
Message-Id: <hdnd2r$5to$1@news.eternal-september.org>

In article <poCLm.191369$Ca6.97784@en-nntp-03.dc1.easynews.com>, nobody <nobody@nowhere.com> wrote:

>Hey dude, you're confused.  I'm working with various data files in 
>various formats.  Some are flat files, some are delimited.  You should 
>learn some manners, give up your lame attempts at humor,  And learn how 
>to spell genera.

You, too. It's "genre". "Genera" is something different.


------------------------------

Date: 6 Apr 2001 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin) 
Subject: Digest Administrivia (Last modified: 6 Apr 01)
Message-Id: <null>


Administrivia:

To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.

Back issues are available via anonymous ftp from
ftp://cil-www.oce.orst.edu/pub/perl/old-digests. 

#For other requests pertaining to the digest, send mail to
#perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
#sending perl questions to the -request address, I don't have time to
#answer them even if I did know the answer.


------------------------------
End of Perl-Users Digest V11 Issue 2676
***************************************


home help back first fref pref prev next nref lref last post