Re^2: Pointers needed to tweak a sort

[Lady_Aleena]

ambrus, I hope I'm using this as you intended. I separated out the subroutines into a module, and use them where ever I need them. I use hashes of hashes instead of arrays of hashes, but I did not have to rewrite your code to make it work, though I renamed the subroutines and moved @networks and $network_string inside the list_sortflags subroutine.

package Twitter::ListSort;
use strict;
use warnings FATAL => qw( all );
use base 'Exporter';
our @EXPORT_OK = qw(list_sortflags list_compare);
# Written by ambrus on PerlMonks.

use Base::Nifty qw(my_sort);

# Write a function to precompute all those boolean keys you want to
# sort by.  This should be an improvement because now the code has
# each condition only once, not twice, so we reduced code duplication.
# The key is just a string of "0" and "1" characters.  For simplicity,
# we store the key right into the record.
sub list_sortflags {
  my($s) = @_;

  my @networks = qw(ABC CBS FOX NBC SyFy TNT USA);
  my $network_string = join('|',@networks);

  my @k;
  push @k, (
    !($s->{user} =~ /LadyAleena_($network_string|TV)/ && $s->{name} !~
+ /TV/),
    !($s->{user} =~ /LadyAleena_($network_string)/ && $s->{name} =~ /T
+V shows$/),
    !($s->{user} eq 'LadyAleena_TV' && $s->{name} eq 'Premium TV shows
+'),
    !($s->{user} eq 'LadyAleena_TV' && $s->{name} eq 'TV shows'),
    !($s->{user} eq 'LadyAleena_TV' && $s->{name} eq 'TV networks'),
    !($s->{user} eq 'LadyAleena_TV' && $s->{name} eq 'TV authors'),
    !($s->{user} eq 'Lady_Aleena' && $s->{name} =~ /(Comedians|Musicia
+ns)/),
    !($s->{user} eq 'Lady_Aleena' && $s->{name} =~ /(Horror|Science fi
+ction)/),
    !($s->{user} eq 'Lady_Aleena' && $s->{name} eq 'Ripley\'s & Guinne
+ss'),
    !($s->{user} eq 'LadyAleena_home'),
    !($s->{user} eq 'Lady_Aleena' && $s->{name} =~ /(Followers' busine
+sses|List subscribers)/),
  );
  my $k = join "", map { $_ ? "1" : "0" } @k;
  $$s{sortflag} = $k;
}

# Now do the sort relying on the key we computed.  Note that as
# the compare function is still non-trivial, I don't write its
# body in the same line as the sort, because that's ugly. 
sub list_compare {
  my($a, $b) = @_;
  return $$a{sortflag} cmp $$b{sortflag} || 
    my_sort($$a{name}, $$b{name}, "article");
}

1;

This is how it is used in a script.

#!/usr/bin/perl
use strict;
use warnings FATAL => qw( all );

use lib '../files/perl/lib';
use Base::Data qw(data_file get_hash);
use Twitter qw(twitter_accounts);
use Twitter::ListSort qw(list_sortflags list_compare);

my %lists;
for my $account (twitter_accounts) {
  my $account_list_file = data_file("Twitter/users/$account","lists.tx
+t");
  if (-s $account_list_file) {
    my %sublists = get_hash(
      file => $account_list_file,
      headings => [qw(id slug name user members mem_change subscribers
+ sub_change status)],
    );
    for (keys %sublists) {
      next if $sublists{$_}{status} ne 'owner';
      $lists{$_} = $sublists{$_};
    }
  }
}

for my $list (values %lists) {
    list_sortflags($list);
}

for my $list (sort { list_compare($a,$b) } values %lists) {
  local $\ = "\n";
  my $name = $list->{name};
  my $user = $list->{user};
  print "$name ($user)";
}

[ambrus]

By the way, if you wanted only up to one of those conditions to match, then you don't need all this complication with a string of zeros and ones. Just have the key be a single number you just compare with spaceship. Something like this, untested:

...
sub list_sortflags {
  my($s) = @_;

  my @networks = ...;
  my $network_string = ...;

  my $k;
  if ($s->{user} =~ /LadyAleena_($network_string|TV)/ && $s->{name} !~
+ /TV/)
    { $k = 1; }
  elsif ($s->{user} =~ /LadyAleena_($network_string)/ && $s->{name} =~
+ /TV shows$/)
    { $k = 2; }
  elsif ($s->{user} eq 'LadyAleena_TV' && $s->{name} eq 'Premium TV sh
+ows')
    { $k = 3; }
  elsif ($s->{user} eq 'LadyAleena_TV' && $s->{name} eq 'TV shows')
    { $k = 4; }
  ...
  elsif ($s->{user} eq 'Lady_Aleena' && $s->{name} =~ /(Followers' bus
+inesses|List subscribers)/)
    { $k = 11; }
  else
    { $k = 12; }
  $$s{sortflag} = $k;
}
...
sub list_compare {
  my($a, $b) = @_;
  return $$a{sortflag} <=> $$b{sortflag} ||
    my_sort($$a{name}, $$b{name}, "article");
}
...