view release on metacpan or  search on metacpan

script/pbtool  view on Meta::CPAN

#
#	This subroutine processes tokens.
#

sub _parse_tokens {
    my @tokens = @_;
    # Perl::Critic extends Perl Best Practices here. The latter merely
    # forbids single-arg selects for the purpose of setting autoflush.
    if ($opt{binary}) {
	select $binout;	## no critic (ProhibitOneArgSelect)
    } else {
	select STDOUT;	## no critic (ProhibitOneArgSelect)
    }
    my @rslt;
    foreach (@tokens) {
	defined $_
	    or next;
	if (m/^<<(.*)/) {
	    my $eod = $1;
	    my $token = '';
	    local $_;
	    while (defined ($_ = _read_contin ("$eod> "))) {
		chomp;
		$_ eq $eod and last;
		$token .= $_ . "\n";
	    }
	    defined $_
		or die <<eod;
End-of-file without finding end of here document '$eod'
eod
	    push @rslt, $token;
	} elsif (m/^<(.*)/) {
	    my $fn = $1;
	    my $fh = IO::File->new($fn, '<')
		or die "Failed to open $fn: $!\n";
	    local $/ = undef;
	    push @rslt, scalar <$fh>;
	} elsif (m/^(>{1,2})(.*)/) {
	    my ($flg, $fn) = ($1, $2);
	    my $fh = IO::File->new($fn, $flg)
		or die "Failed to open $fn: $!\n";
	    $opt{binary} and binmode ($fh);
	    # Perl::Critic extends Perl Best Practices here. The latter
	    # merely forbids single-arg selects for the purpose of
	    # setting autoflush.
	    select $fh;	## no critic (ProhibitOneArgSelect)
	} else {
	    push @rslt, $_;
	}
    }
    return @rslt;
}

#	@args = _options (@args);
#
#	This subroutine feeds its input to GetOptions. Anything left
#	over is assumed to be the name of a clipboard to make current.
#	An error results in the display of a brief error message.

sub _options {
    local @ARGV = @_;
    GetOptions( \%opt,
	qw{ binary! default_flavor|default-flavor=s echo! id=i },
	noid => sub { $opt{id} = undef },
	help => sub { pod2usage( { -verbose => 2 } ) },
    ) or pod2usage( { -verbose => 0 } );
    $pb and $pb->set(
	encode		=> ! $opt{binary},
	default_flavor	=> $opt{default_flavor},
	id		=> $opt{id},
    );
    return @ARGV;
}

=head1 BUGS

Bugs can be reported to the author by mail, or through
L<https://github.com/trwyant/perl-Mac-Pasteboard/issues/>.

=head1 AUTHOR

Thomas R. Wyant, III (F<wyant at cpan dot org>)

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2008, 2011-2024 by Thomas R. Wyant, III

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl 5.10.0. For more details, see the full text
of the licenses in the directory LICENSES.

This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.

=cut

# ex: set textwidth=72 :