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<harryfmudd at comcast dot net>)

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2008, 2011-2026 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 files F<LICENSE-Artistic> and F<LICENSE-GPL>.

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 :