root/yapcasia2008/misc/party-prioritize.pl

Revision 2703 (checked in by miyagawa, 12 years ago)

who's going to party?

  • Property svn:executable set to *
Line 
1 #!/usr/bin/perl
2 use strict;
3 use warnings;
4 use Encode;
5 use Text::CSV_XS;
6
7 my @payments = read_csv('payments.csv');
8 my @users    = read_csv('export.csv');
9 my @talks    = read_csv('exported_talks.csv');
10
11 my %payments = map { $_->{user_id} => $_ } @payments;
12 my %talks    = map { $_->{user_id} => 1 } grep $_->{accepted}, @talks;
13
14 # schwertzian transform
15 my $i;
16 my @sorted = map {
17     $_->[6]->{party} = ++$i < 300 ? '1' : '0';
18     $_->[6];
19 } sort {
20     $b->[0] cmp $a->[0] || # is staff?
21     $b->[1] cmp $a->[1] || # is speaker?
22     $b->[2] cmp $a->[2] || # has paid?
23     $b->[3] cmp $a->[3] || # from abroad?
24     $b->[4] cmp $a->[4] || # from outside Tokyo?
25     $a->[5] cmp $b->[5]    # paid earlier?
26 } map {
27     $_->{has_accepted_talk} = exists $talks{$_->{user_id}};
28     $_->{paid_date}         = $payments{$_->{user_id}}->{datetime} || "9999-99-99 99:99:99";
29     $_->{not_tokyo}         = $_->{town} && !is_tokyo($_->{town});
30     $_->{payment_means}     = $payments{$_->{user_id}}->{means} || 'UNPAID';
31     $_->{has_really_paid}   = $_->{has_paid} && $_->{payment_means} eq 'ONLINE';
32     [ $_->{is_staff} || $_->{is_orga},
33       $_->{has_accepted_talk},
34       $_->{has_really_paid},
35       $_->{country} ne 'jp',
36       $_->{not_tokyo},
37       $_->{paid_date},
38       $_ ];
39 } @users;
40
41 use YAML;
42 my @cols = qw( user_id first_name last_name email is_staff has_accepted_talk country town not_tokyo payment_means paid_date party );
43
44 print join(",", @cols), "\n";
45 for my $u (@sorted) {
46     print join(",", @$u{@cols}), "\n";
47 }
48
49 sub is_tokyo {
50     my $town = decode_utf8 shift;
51     $town =~ /tokyo|\x{6771}\x{4eac}|Hongo|chiyoda|shibuya|shinagawa/i;
52 }
53
54 sub read_csv {
55     open my $fh, "<", shift or die $!;
56
57     my $csv = Text::CSV_XS->new({ binary => 1 });
58     my $header = $csv->getline($fh);
59     $csv->column_names(@$header);
60
61     my @list;
62     while (!$csv->eof) {
63         my $ref = $csv->getline_hr($fh);
64         next unless $ref->{user_id};
65         push @list, $ref;
66     }
67
68     return @list;
69 }
Note: See TracBrowser for help on using the browser.