nmode's Git Repositories - Fey/blob - lib/App/Fey.pm

   1 package App::Fey;
   2
   3 use strict;
   4 use warnings;
   5 use Exporter 'import';
   6
   7 our @EXPORT_OK = qw(fey);
   8 our $version = '0.01';
   9
  10 sub new {
  11     my ($class, $options) = @_;
  12     my $config = do ($ENV{XDG_CONFIG_HOME} // "$ENV{HOME}/.config") . '/fey/config.pl';
  13
  14     my $self = {
  15         mime_query => $options->{mime_query} // $config->{mime_query} // sub {
  16             open my $mime_type, '-|', 'file', '--brief', '--mime-type', $_[0];
  17             <$mime_type>;
  18         },
  19         contexts => $options->{contexts} // $config->{contexts} // { default => sub { 1 } },
  20         targets => $options->{targets} // $config->{targets} // {}
  21     };
  22
  23     bless $self, $class;
  24 }
  25
  26 sub launch {
  27     my $self = shift;
  28     my $options = ref $_[0] ? shift : {};
  29
  30     if (!(-t STDIN)) {
  31         _read_stdin(\@_);
  32     }
  33     if (!@_ || $options->{interactive}) {
  34         open STDIN, '<', '/dev/tty';
  35         _read_stdin(\@_);
  36     }
  37     die "No files or URIs specified.\n" unless @_;
  38
  39     if ($options->{group}) {
  40         $self->_launch_group($options, @_);
  41     } elsif ($options->{single}) {
  42         $self->_launch_single($options, @_);
  43     } else {
  44         $self->_launch($options, @_);
  45     }
  46 }
  47
  48 sub _launch {
  49     my $self = shift;
  50     my $options = shift;
  51
  52     if ($options->{fork}) {
  53         for my $file_or_uri (@_) {
  54             my $pid = fork;
  55             next if $pid;
  56
  57             my $handler = $self->_get_handler($options, $file_or_uri);
  58             $handler->($file_or_uri) if $handler;
  59             return;
  60         }
  61     } else {
  62         for my $file_or_uri (@_) {
  63             my $handler = $self->_get_handler($options, $file_or_uri);
  64             $handler->($file_or_uri) if $handler;
  65         }
  66     }
  67 }
  68
  69 sub _launch_group {
  70     my $self = shift;
  71     my $options = shift;
  72
  73     my ($groups, $handlers) = ({}, {});
  74     for my $file_or_uri (@_) {
  75         my $handler = $self->_get_handler($options, $file_or_uri);
  76         if ($handler) {
  77             $groups->{"$handler"} //= [];
  78             push @{ $groups->{"$handler"} }, $file_or_uri;
  79             $handlers->{"$handler"} = $handler;
  80         }
  81     }
  82
  83     if ($options->{fork}) {
  84         for my $group (keys %{ $groups }) {
  85             if ($options->{fork}) {
  86                 my $pid = fork;
  87                 next if $pid;
  88             }
  89
  90             $handlers->{$group}->(@{ $groups->{$group} });
  91             return;
  92         }
  93     } else {
  94         for my $group (keys %{ $groups }) {
  95             $handlers->{$group}->(@{ $groups->{$group} });
  96         }
  97     }
  98 }
  99
 100 sub _launch_single {
 101     my $self = shift;
 102     my $options = shift;
 103
 104     if ($options->{fork}) {
 105         my $pid = fork;
 106         return if $pid;
 107     }
 108
 109     my $handler = $self->_get_handler($options, $_[0]);
 110     $handler->(@_) if $handler;
 111 }
 112
 113 sub _get_handler {
 114     my $self = shift;
 115     my $options = shift;
 116
 117     my $file_or_uri = $_[0] =~ m|^file://(.+)| ? $1 : $_[0];
 118     my $mime_or_uri = -e $file_or_uri ? $self->{mime_query}->($file_or_uri) : $file_or_uri;
 119
 120     for my $target (@{ $self->{targets} }) {
 121         for my $pattern (@{ $target->{patterns} }) {
 122             if ($mime_or_uri =~ /$pattern/) {
 123                 my $associations = $target->{associations};
 124
 125                 my $context = $options->{context};
 126                 my $handler = $associations->{$context} if $context;
 127                 return $handler if defined $handler;
 128
 129                 for my $context (keys %{ $associations }) {
 130                     if ($self->{contexts}->{$context}->()) {
 131                         return $associations->{$context};
 132                     }
 133                 }
 134             }
 135         }
 136     }
 137 }
 138
 139 sub _read_stdin {
 140     for my $file_or_uri (<STDIN>) {
 141         chomp $file_or_uri;
 142         push @{ $_[0] }, $file_or_uri;
 143     }
 144 }
 145
 146 sub fey {
 147     App::Fey->new(ref $_[0] ? $_[0] : {})->launch(@_);
 148 }