LINUX.ORG.RU
решено Форум — Development  

[perl] упростить код

 


0

2

вопрос к perl-guru. можно ли упростить этот код?

#! /usr/bin/perl -w

use Getopt::Long;

my $format=q(%artist% - %title%);
my $player;

GetOptions('player=s' => \$player, 'format=s' => \$format);

exit(1) if (!defined($player));

my $cmd = qq(dbus-send --print-reply --type=method_call --dest=org.mpris.MediaPlayer2.$player /org/mpris/MediaPlayer2 org.freedesktop.DBus.Properties.Get string:'org.mpris.MediaPlayer2.Player' string:'Metadata' |);
my %tags;

open (DBUS, $cmd) or die "Can't run $cmd: $!\n";
while (<DBUS>) {
    my $tag;
    my $value;

    chomp;
    s/^\s*(.*)\s*$/$1/;

    if (m/dict entry\(/) {
        while (<DBUS>) {
            chomp;
            s/^\s*(.*)\s*$/$1/;

            last if (m/\)$/);
            if (m/^string.*\"mpris:/) {
                last;
            } elsif (m/^string.*\"xesam:(.*)\"$/) {
                $tag = $1;
                next;
            } elsif (m/^variant.*string.*\"(.*)\"$/) {
                $value = $1;
                next;
            } elsif (m/^variant.*array/) {
                while (<DBUS>) {
                    chomp;
                    s/^\s*(.*)\s*$/$1/;

                    last if (m/\]$/);
                    if (m/^string.*\"(.*)\"$/) {
                        $value .= $1 . ", ";
                        next;
                    }
                }
                $value =~ s/\,\s*$//;
            }
        }
        $tags{$tag} = $value if defined($value);
    }
}
close (DBUS);

# print results
if (defined($tags{'artist'})) {
    $format =~ s/\%artist\%/$tags{'artist'}/g;
} else {
    $format =~ s/\%artist\%//g;
}
if (defined($tags{'title'})) {
    $format =~ s/\%title\%/$tags{'title'}/g;
} else {
    $format =~ s/\%title\%//g;
}
if (defined($tags{'album'})) {
    $format =~ s/\%album\%/$tags{'album'}/g;
} else {
    $format =~ s/\%album\%//g;
}
if (defined($tags{'genre'})) {
    $format =~ s/\%genre\%/$tags{'genre'}/g;
} else {
    $format =~ s/\%genre\%//g;
}

print $format, "\n";
★★★★★

Последнее исправление: ananas (всего исправлений: 2)

Ну для начала меняем всю последнюю секцию на: 

my @list = ("artist", "title", "album", "genre");
if (defined($tags{'artist'}))
    $format = { $b =~ s/\%$a\%/$tags{"$a"}/g; } $format @list;
else
    $format = { $b =~ s/\%$a\%//g; } $format @list;

KblCb ★★★★★
()

скрипт парсит примерно такой выхлоп

method return sender=:1.9 -> dest=:1.63 reply_serial=2
   variant       array [
         dict entry(
            string "xesam:genre"
            variant                array [
                  string "Pop"
               ]
         )
         dict entry(
            string "xesam:artist"
            variant                array [
                  string "Afric Simone"
               ]
         )
         dict entry(
            string "xesam:album"
            variant                string "Romantic collection / Disco"
         )
         dict entry(
            string "mpris:trackid"
            variant                string "1"
         )
         dict entry(
            string "xesam:title"
            variant                string "Hafanana"
         )
         dict entry(
            string "mpris:length"
            variant                int64 172826122
         )
      ]
ananas ★★★★★
() автор топика
Ответ на: комментарий от KblCb

вообще-то, как это избавит меня от неопределенных остальных ключей в хэше - непонятно

ananas ★★★★★
() автор топика

Я не перл-гуру, скорее наоборот, но как-то не верится, что для перла нет dbus и нужно вызывать внешний dbus-send, а потом парсить его выхлоп.

vga ★★
()
Ответ на: комментарий от Viglim

из Makefile.pl
[code]
    'PREREQ_PM' => {
       'Test::More' => 0,
       'Time::HiRes' => 0,
       'XML::Twig' => 0,
       },
[/code]

в стандартную дистрибуцию включен только Test::More. тащить три лишних модуля ради тривиальщины - увольте

ananas ★★★★★
() автор топика
Ответ на: комментарий от KblCb

if (defined($tags{'artist'}))

а если у меня он defined, однако нет title - будет? или же если artist не определен, но есть другие теги?

ananas ★★★★★
() автор топика
Ответ на: комментарий от Viglim

> Это как-то совсем не unix-way.

а вот с этого момента - подробнее

ananas ★★★★★
() автор топика
Ответ на: комментарий от ananas

Твой код делает то же самое. Ты просил упростить, а не исправить. Так вот, если title в хэше не определён, то он вернёт пустую строку и удалит это поле также как в случае если $tags{'artist'} не определён.

KblCb ★★★★★
()
Ответ на: комментарий от KblCb

> От каких неопределённых ключей?

да, то я холоднул, неподправленный код запостил

ananas ★★★★★
() автор топика
Ответ на: комментарий от KblCb

Кстати, никто до сих пор не обратил внимание, что я везде забыл написать reduсe.

KblCb ★★★★★
() 
$value = reduce { last if ($a =~ m/\]$\s*/); $b .= $1 . ", " if ($a =~ m/^\s*string.*\"(.*)\"\s*$/); } $value <DBUS>;
KblCb ★★★★★
()

Все; 

chomp;
s/^\s*(.*)\s*$/$1/;
меняем на: 
s/^\s*(.*)\s*$/$1/;

KblCb ★★★★★
()

как только лисопедисты не извращаются и каких только причин не находят, лишь бы не юзать готовые решения…

#!/usr/bin/perl

use strict;
use warnings 'all';
use Getopt::Long;

my $format = '%artist% - %title%';
my $player;

GetOptions('player=s' => \$player, 'format=s' => \$format);

die "--player=... ???\n" unless defined $player;
$_ = `dbus-send --print-reply --type=method_call --dest=org.mpris.MediaPlayer2.$player /org/mpris/MediaPlayer2 org.freedesktop.DBus.Properties.Get string:'org.mpris.MediaPlayer2.Player' string:'Metadata'`;
die "Can't run dbus-send: $!\n" if $?;

sub parse_key { $_[0] =~ /:(.+)$/ ? $1 : $_[0] }
sub parse_val { $_[0] =~ /array\s*\[\s*((?:[^\]\"]+|\"[^\"]*\")+)\]/s ? parse_val($1) : join ', ', grep {defined && length} $_[0] =~ /string\s+\"([^\"]*)\"|int\d*\s+([+-]?\d+)/sg }
my %tag = map { /string\s+\"([^\"]+)\"\s+variant\s+(.+)$/s ? (parse_key($1), parse_val($2)) : () } /dict entry\(((?:[^\")]+|\"[^\"]*\")+)\)/sg;

$format =~ s/%(\w+)%/exists$tag{$1}?$tag{$1}:''/ge;

print $format, "\n";

известные баги: не понимает эскейпов в строках и вложенных массивов.

arsi ★★★★★
()
Ответ на: комментарий от ananas

> не нашел готовых решений

Net::DBus. вся рутина поместится в ≈5 строк кода… понятных строк, а не как у меня, где исходник выглядит как уже скомпиленный код.

arsi ★★★★★
()
Ответ на: комментарий от ananas

Наверное потому что я забыл как выглядит Perl уже. Поменяй везде $a и $b местами.

KblCb ★★★★★
()
Ответ на: комментарий от arsi

Вот это здорово. Вот это настоящее ФП головного мозга. Снимаю шляпу.

KblCb ★★★★★
()
Ответ на: комментарий от ananas

> хоть один Net::DBus в коде arsi найдешь? 

#!/usr/bin/perl
use strict;
use warnings 'all';
use utf8;
use encoding 'utf8';
use Getopt::Long;
use Net::DBus;

my ($player, $format) = (amarok => '%artist% - %title%');
GetOptions('player=s' => \$player, 'format=s' => \$format);

my $tag = Net::DBus->session->get_service("org.mpris.$player")->get_object("/Player")->GetMetadata() || {};

$format =~ s/%(\w+)%/exists $tag->{$1} ? ('ARRAY' eq ref $tag->{$1} ? join(', ', @{$tag->{$1}}) : $tag->{$1}) : ''/ge;

print $format, "\n";

feel the difference, так сказать ;)

arsi ★★★★★
()
Ответ на: комментарий от arsi

проfeelил. первый вариант значительно предпочтительней

ananas ★★★★★
() автор топика
Ответ на: комментарий от ananas

> mpris 2

у меня нет плеера, поддерживающего v2 (в наличии только амарок2 и аудасиоус2).

зы: для v2 было бы одной строчкой больше ;)

ззы: с Net::DBus не будет проблем как минимум с эскейпами в строках. да и вообще он проведёт более адекватный парсинг ответа.

arsi ★★★★★
()
Вы не можете добавлять комментарии в эту тему. Тема перемещена в архив.
Development