view release on metacpan or  search on metacpan

lib/App/DrivePlayer/GUI.pm  view on Meta::CPAN

    my $response = $dlg->run();

    if ($response eq 'ok') {
        my $auth = $self->config->auth_config();
        for my $key (keys %entries) {
            $auth->{$key} = $entries{$key}->get_text();
        }
        $self->config->_data->{acoustid_key} = $aid_entry->get_text();
        $self->config->_data->{sheet_id}     = $sid_entry->get_text();
        $self->config->save();
        $self->_set_status('Settings saved. Restart to apply API credential changes.');
    }
    $dlg->destroy();
}

sub _tracklist_context_menu {
    my ($self, $event) = @_;

    my ($path) = $self->track_view->get_path_at_pos($event->x, $event->y);
    return unless $path;
    $self->track_view->get_selection()->select_path($path);
    my $track = $self->_track_at_path($path);

    my $menu = Gtk3::Menu->new();

    my $play_item = Gtk3::MenuItem->new_with_label('Play');
    $play_item->signal_connect(activate => sub { $self->_play_at_path($path) });
    $menu->append($play_item);

    my $edit_item = Gtk3::MenuItem->new_with_label('Edit…');
    $edit_item->signal_connect(activate => sub {
        $self->_edit_metadata_dialog($track) if $track;
    });
    $menu->append($edit_item);

    $menu->show_all();
    $menu->popup_at_pointer($event);
}

sub _edit_metadata_dialog {
    my ($self, $track) = @_;

    my $dlg = Gtk3::Dialog->new_with_buttons(
        'Edit Metadata', $self->win,
        [qw/ modal destroy-with-parent /],
        'Save',   'ok',
        'Cancel', 'cancel',
    );
    $dlg->set_default_size(460, 280);

    my $grid = Gtk3::Grid->new();
    $grid->set_row_spacing(6);
    $grid->set_column_spacing(8);
    $grid->set_border_width(12);
    $dlg->get_content_area()->add($grid);

    # LRM (U+200E) is an invisible left-to-right marker. Prepending it to
    # an Entry's text forces the internal PangoLayout's base direction to
    # LTR, which keeps short RTL content (Arabic, Hebrew, …) flush with the
    # left edge instead of the right. The glyphs within still render in
    # their natural direction, so "راغب علامة" still looks correct.
    # We strip the marker on read so it never reaches the DB or a query.
    my $LRM = "\x{200E}";
    my $put = sub {
        my ($entry, $val) = @_;
        $val //= '';
        $entry->set_text(length $val ? $LRM . $val : '');
    };
    my $get = sub {
        my ($entry) = @_;
        my $v = $entry->get_text();
        $v =~ s/[\x{200E}\x{200F}]//g;   # LRM + RLM
        return $v;
    };

    my %entries;
    my $row = 0;
    for my $field (
        [ title        => 'Title:'        ],
        [ artist       => 'Artist:'       ],
        [ album        => 'Album:'        ],
        [ genre        => 'Genre:'        ],
        [ track_number => 'Track Number:' ],
        [ year         => 'Year:'         ],
        [ comment      => 'Comment:'      ],
    ) {
        my ($key, $lbl) = @$field;
        my $label = Gtk3::Label->new($lbl);
        $label->set_xalign(1.0);
        $grid->attach($label, 0, $row, 1, 1);
        my $entry = Gtk3::Entry->new();
        $entry->set_hexpand(TRUE);
        $entry->set_direction('ltr');
        $entry->set_alignment(0.0);
        $put->($entry, $track->{$key});
        $grid->attach($entry, 1, $row, 1, 1);
        $entries{$key} = $entry;
        $row++;
    }

    my $fetch_btn = Gtk3::Button->new_with_label('Fetch');
    $fetch_btn->set_halign('end');
    $fetch_btn->set_tooltip_text(
        'Look up missing fields online (text search, then AcoustID '
        . 'fingerprint).  Only blank fields are filled — to refresh a '
        . 'populated field, clear it first.'
    );
    # Treat whitespace-only fields as blank for both the query we build and
    # the emptiness test below — a stray space is almost never what the user
    # meant and it would otherwise block the fetch from filling the field.
    my $trimmed = sub {
        my $s = shift // '';
        $s =~ s/\A\s+//;
        $s =~ s/\s+\z//;
        return $s;
    };

    $fetch_btn->signal_connect(clicked => sub {
        # Build a track-like hashref from current dialog contents so the
        # lookup uses whatever the user has typed so far.
        my %current = (drive_id => $track->{drive_id});