Friday, February 19, 2010

E03 First Stab

Well, this one is weird. The original program strikes me as almost non-sensical, and is missing a key subroutine, amortize. It also features a lot of Perl 6 wildly changed since it was written. Still, here's a stab at what I think it is trying to do.

sub load_data($filename, $version = 1, *@dirpath is copy) {
@dirpath = './' unless +@dirpath;
# @dirpath>>.subst(/c/, {$1/});

my %data;
for @dirpath -> $prefix {
my $filepath = $prefix ~ $filename;

if ($filepath ~~ :e and 100 < ($filepath ~~ :s) <= 1e6) {
say "Trying to open $filepath";
my $fh = open($filepath, :r)
or die "Something screwy with $filepath: $!";
my ($name, $vers, $status, $costs) = $fh.lines(4);
next if $vers < $version;
$costs = [split /\s+/, $costs];
%data{$filepath} = {};
%data{$filepath}<name vers stat costs rest> =
($name, $vers, $status, $costs, $fh.slurp);
say "$filepath done";
$fh.close;
}
}
return %data;
}

sub save_data(%data) {
for %data.kv -> $filepath, $data {
say "saving $filepath";
my $fh = open($filepath, :w)
or die "Something screwy with $filepath: $!";
$fh.print: ($data.<name vers stat>, ~($data.<costs>), $data.<rest>).join("\n");
$fh.close;
}
}

# I've no idea what this sub was supposed to do, so let's stick with something really
# simple for the moment.
sub amortize($a) {
$a;
}

my %data = load_data(filename=>'weblog', version=>1);
my $is_active_bit = 0x0080;
for %data.kv -> $file, $data {
say "$file contains data on { $data<name> }";
$data<stat> +^= $is_active_bit;

my @costs := $data<costs>;
my $inflation;
# while my $inflation = prompt('Inflation rate: ')
# print "Inflation rate: " and $inflation = +<>
# until $inflation != NaN;
$inflation = 1.2;

@costs = (@costs >>*>> $inflation).sort({ amortize($_) });

say "Total expenditure: { [+] @costs }";
say "Major expenditure: { [+] @costs.grep({$_ >= 1000}) }";
say "Minor expenditure: { [+] @costs.grep({$_ < 1000}) }";
say "Odd expenditures: { @costs.map(-> $a, $b { $a }) }";
}

# save_data(%data, log => {name=>'metalog', vers=>1, costs=>[], stat=>0});
save_data(%data);


Some random notes:
1) The original code references @last_dirpath and @std_dirpath but nowhere are they defined, nor would they ever get used. I have simply taken them out.

2) The original code used a hyper-smartmatch with a s// substitution. To the best of my knowledge, that's never worked in Rakudo... um, almost said master, but I guess it's called "alpha" now. I tried replacing it with a hyper-.subst, but I couldn't get that to parse, either. I just skipped over this bit.

3) The original tried to create a read/write filehandle, stash it after reading, store it, and re-write the file entirely using seek and truncate. Neither of those functions exist in alpha as far as I can tell, so I just rewrote it to read the entire file when loading, and then open a new file in write mode when saving. This seems more sensible anyway, and has the benefit of working.

4) The original used ofs to set the output field separator. That's deprecated, so I just used a simple join statement to do the same thing.

5) I couldn't figure out how to get the code to get inflation from a user prompt, so I just hard-coded inflation to be... um... 20%. That seems kind of high now that I think about it. (And what is it with these old example programs and reading data from a prompt? That's something I've never wanted to do in more than a decade of Perl 5 programming...)

6) The four-line hyper-times, map, sort, map operation becomes a simple one-liner in modern Perl 6.

7) For some reason, the "Total expenditure" line prints the individual contents of @costs rather than the sum. No clue what's going on there.

8) Simple greps instead of the original's custom filters.

9) Use a simple map to get every other cost, because 1, 3 ... * doesn't work in alpha.

And that's it, I think. It's kind of weird and ugly, but I think it does do what it's supposed to. (I mean, it does do something, and I think that what it does is what the original code intended. But given the oddness of the original, who knows?)

I look forward to seeing what masak does with this one...

No comments:

Post a Comment