Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

Data handling

by Kage (Scribe)
on Dec 08, 2002 at 04:19 UTC ( [id://218329]=perlquestion: print w/replies, xml ) Need Help??

Kage has asked for the wisdom of the Perl Monks concerning the following question:

Ok, I have data exactly like this:

package Stats; sub new { my $pkg = shift; my $obj = { TOTAL_REPLIES => '6373', TOTAL_TOPICS => '574', TOTAL_MEMBERS => '211', LAST_REG_MEMBER_ID => '85-1039338924', LAST_REG_MEMBER_N => 'Unlimited_Destroyer', M_ONLINE_COUNT => '25', M_ONLINE_DATE => '1037453854', }; bless $obj, $pkg; return $obj; } 1; ; } 1;


What I want is to open the file that has this data, take the stuff in between my $obj = { and the }; and remove all excess spaces, except from whatever is in single quotes, then put double-quotes around the array-keys. If anyone knows an efficient way to do this without using up a handful of CPU resources, please lemme know.
“A script is what you give the actors. A program is what you give the audience.” ~ Larry Wall

Replies are listed 'Best First'.
Re: Data handling
by graff (Chancellor) on Dec 08, 2002 at 05:08 UTC
    Oddly, this does not sound like homework (;^). Okay, since the source data is exactly like what you show (though I presume you want to handle lots of cases with different keys and values in the hash, but hewing to the same rigid syntax), this ought to work:
    use strict; $/ = undef; $_ = <DATA>; my ($prefix,$objdef,$suffix) = ( /(.*?\$obj = \{)(.*?)(\}.*)/s ); my @hashdef = ( $objdef =~ /\s*([A-Z_]+)\s*=>\s*(\'.*?\')/g ); print $prefix; for ( my $i=0; $i < scalar @hashdef; $i+=2 ) { print "\n\"$hashdef[$i]\"=>$hashdef[$i+1]"; } print "\n$suffix"; __DATA__ package Stats; sub new { my $pkg = shift; my $obj = { TOTAL_REPLIES => '6373', TOTAL_TOPICS => '574', TOTAL_MEMBERS => '211', LAST_REG_MEMBER_ID => '85-1039338924', LAST_REG_MEMBER_N => 'Unlimited_Destroyer', M_ONLINE_COUNT => '25', M_ONLINE_DATE => '1037453854', }; bless $obj, $pkg; return $obj; } 1; ; } 1;
    I didn't try counting the cpu load on this, but it should be negligeable.

    Your description made it sound like the stuff outside the curlies for the "$obj" assignment should be left unaltered, so the first regex match/assignment splits the whole thing into the initial, middle and final pieces, and the second regex match/assignment locates all the strings to be maintained from within the middle piece (putting these in a plain array to preserve order, in case that matters). Then print the first piece, loop over the sub-parts of the middle piece to print without those annoying spaces, and finish by printing the third piece.

    update:oops, forgot that you wanted double quotes around the hash keys in the print-out. Also, if you don't want to print the "$prefix" and "$suffix" parts, just drop those two print statements, and put the "\n" at the end of the print statement in the for loop.

Re: Data handling
by chromatic (Archbishop) on Dec 08, 2002 at 07:41 UTC

    If it weren't for the superfluous right curly at the end:

    require Stats; my $s = Stats->new(); print map { qq|"$_" => '$s->{ $_ }'\n| } keys %s;
Re: Data handling
by pg (Canon) on Dec 08, 2002 at 04:59 UTC
    The following code only goes over the content one time, each line is processed on fly:
    use strict; my @wanted_lines; open(FILEHANDLE, "<", "your.pl"); my $wanted = 0; my $finished = 0; my $line; do { $line = <FILEHANDLE>; if ($line =~ m/my\s+\$obj\s+=\s+{/) { $wanted = 1; } else { if ($wanted) { if ($line =~ m/^\s*};/) { $wanted = 0; $finished = 1; } else { $line =~ m/\s*(\w+)\s*=>\s*(.*?),/; push @wanted_lines, "\"$1\"$2"; } } } } until ($finished || !defined($line)); close(FILEHANDLE); print join("\n",@wanted_lines);
    (You have to modify it a little bit to meet your exact output format.)
Re: Data handling
by demerphq (Chancellor) on Dec 08, 2002 at 15:29 UTC
    Do you mind telling us why you want to do this? Except for the crud at the bottom this is valid perl. And while it is a CPU hog you should take a look at perltidy on sourceforge.

    --- demerphq
    my friends call me, usually because I'm late....

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://218329]
Approved by graff
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others avoiding work at the Monastery: (4)
As of 2024-03-29 09:27 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found