view release on metacpan or search on metacpan
$rv;
}
sub usage
{
my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
my %M = ( 'I' => '*' );
$usage =~ s/^\s*perl\s+\S+/$^X $0/;
$usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
print <<ENDUSAGE;
exit 2;
}
sub strip
{
my $self = do { local(@ARGV,$/)=($0); <> };
my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
$copy =~ s/^(?=\S+)/ /gms;
$self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
$self =~ s/^SKIP.*(?=^__DATA__)/SKIP
if (\@ARGV && \$ARGV[0] eq '--unstrip') {
view all matches for this distribution
view release on metacpan or search on metacpan
$rv;
}
sub usage
{
my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
my %M = ( 'I' => '*' );
$usage =~ s/^\s*perl\s+\S+/$^X $0/;
$usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
print <<ENDUSAGE;
exit 2;
}
sub strip
{
my $self = do { local(@ARGV,$/)=($0); <> };
my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
$copy =~ s/^(?=\S+)/ /gms;
$self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
$self =~ s/^SKIP.*(?=^__DATA__)/SKIP
if (\@ARGV && \$ARGV[0] eq '--unstrip') {
view all matches for this distribution
view release on metacpan or search on metacpan
Call/ppport.h view on Meta::CPAN
$rv;
}
sub usage
{
my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
my %M = ( 'I' => '*' );
$usage =~ s/^\s*perl\s+\S+/$^X $0/;
$usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
print <<ENDUSAGE;
Call/ppport.h view on Meta::CPAN
exit 2;
}
sub strip
{
my $self = do { local(@ARGV,$/)=($0); <> };
my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
$copy =~ s/^(?=\S+)/ /gms;
$self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
$self =~ s/^SKIP.*(?=^__DATA__)/SKIP
if (\@ARGV && \$ARGV[0] eq '--unstrip') {
view all matches for this distribution
view release on metacpan or search on metacpan
$rv;
}
sub usage
{
my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
my %M = ( 'I' => '*' );
$usage =~ s/^\s*perl\s+\S+/$^X $0/;
$usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
print <<ENDUSAGE;
exit 2;
}
sub strip
{
my $self = do { local(@ARGV,$/)=($0); <> };
my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
$copy =~ s/^(?=\S+)/ /gms;
$self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
$self =~ s/^SKIP.*(?=^__DATA__)/SKIP
if (\@ARGV && \$ARGV[0] eq '--unstrip') {
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Finance/OFX/Parse.pm view on Meta::CPAN
sub parse_file
{
my $file = shift;
return undef unless $file;
# my $text = do { local(@ARGV, $/) = $file; <> };
my $text = read_file($file);
return undef unless $text;
return parse($text);
}
view all matches for this distribution
view release on metacpan or search on metacpan
t/tiller2qif.t view on Meta::CPAN
}, '_run() lives' );
like( path($qiffile)->slurp_utf8, qr/LIncome:Salary/, '_run() QIF has mapped category' );
};
# ---------------------------------------------------------------------------
# run_cli dispatch â local @ARGV overrides argument list for each call
# ---------------------------------------------------------------------------
subtest cli_unknown_command => sub {
local @ARGV = ('notacommand');
ok( dies { Finance::Tiller2QIF::run_cli() }, 'Unknown command dies' );
};
subtest cli_missing_command => sub {
local @ARGV = ();
like(
dies { Finance::Tiller2QIF::run_cli() },
qr/Command Missing!/,
'Missing command shows clear error message'
);
};
subtest cli_missing_db => sub {
local @ARGV = ( 'ingest', '--input', 'x.csv' );
ok( dies { Finance::Tiller2QIF::run_cli() }, 'Missing --db dies' );
};
subtest cli_missing_input => sub {
local @ARGV = ( 'ingest', '--db', 'x.sqlite3' );
ok( dies { Finance::Tiller2QIF::run_cli() }, 'Missing --input for ingest dies' );
};
subtest cli_missing_output => sub {
local @ARGV = ( 'emit', '--db', 'x.sqlite3' );
ok( dies { Finance::Tiller2QIF::run_cli() }, 'Missing --output for emit dies' );
};
subtest cli_newdb_missing_db => sub {
local @ARGV = ('newdb');
ok( dies { Finance::Tiller2QIF::run_cli() }, 'newdb without --db dies' );
};
subtest cli_newconfig_missing_config => sub {
local @ARGV = ('newconfig');
ok( dies { Finance::Tiller2QIF::run_cli() }, 'newconfig without --config dies' );
};
subtest cli_newdb => sub {
my $db_path = uniqfile( 'cli_newdb', 'sqlite3' );
local @ARGV = ( 'newdb', '--db', $db_path );
ok( lives { Finance::Tiller2QIF::run_cli() }, 'newdb with --db returns normally' );
ok( -s $db_path, 'newdb created the database file' );
};
subtest cli_run => sub {
my $db_path = uniqfile( 'cli_run', 'sqlite3' );
my $csvfile = uniqfile( 'cli_run', 'csv' );
my $qiffile = uniqfile( 'cli_run', 'qif' );
freshdb($db_path)->disconnect;
freshcsv( $csvfile, '04/25/2026,1,Checking,75.00,Deposit,Salary,Income' );
local @ARGV = ( 'run', '--input', $csvfile, '--db', $db_path, '--output', $qiffile );
ok( lives { Finance::Tiller2QIF::run_cli() }, 'cli run returns normally' );
ok( -e $qiffile, 'cli run produced QIF file' );
};
subtest cli_command_after_options => sub {
my $db_path = uniqfile( 'cli_cmdafter', 'sqlite3' );
my $csvfile = uniqfile( 'cli_cmdafter', 'csv' );
my $qiffile = uniqfile( 'cli_cmdafter', 'qif' );
freshdb($db_path)->disconnect;
freshcsv( $csvfile, '04/25/2026,1,Checking,75.00,Deposit,Salary,Income' );
local @ARGV = ( '--input', $csvfile, '--db', $db_path, '--output', $qiffile, 'run' );
ok( lives { Finance::Tiller2QIF::run_cli() }, 'cli run with command after options returns normally' );
ok( -e $qiffile, 'cli run with command after options produced QIF file' );
};
subtest cli_command_last_newdb => sub {
my $db_path = uniqfile( 'cli_newdbafter', 'sqlite3' );
local @ARGV = ( '--db', $db_path, 'newdb' );
ok( lives { Finance::Tiller2QIF::run_cli() }, 'newdb with command after --db returns normally' );
ok( -s $db_path, 'newdb with command last created the database file' );
};
subtest cli_unknown_command_after_options => sub {
local @ARGV = ( '--db', 'x.sqlite3', 'notacommand' );
like(
dies { Finance::Tiller2QIF::run_cli() },
qr/Unknown command/,
'unknown command after options dies'
);
};
subtest cli_extra_stray_argument => sub {
local @ARGV = ( 'run', 'stray', '--db', 'x.sqlite3' );
like(
dies { Finance::Tiller2QIF::run_cli() },
qr/unexpected argument/,
'stray argument after command and options dies'
);
};
subtest cli_options_only_missing_command => sub {
local @ARGV = ( '--db', 'x.sqlite3' );
like(
dies { Finance::Tiller2QIF::run_cli() },
qr/Command Missing!/,
'options with no command still dies with Command Missing!'
);
};
subtest cli_help_extra => sub {
local @ARGV = ( '--help', 'extra' );
my $out = '';
ok( lives { open( local *STDOUT, '>', \$out ); Finance::Tiller2QIF::run_cli() },
'--help with trailing extra argument still returns normally' );
like( $out, qr/tiller2qif/, '--help with trailing extra argument prints usage' );
};
t/tiller2qif.t view on Meta::CPAN
freshcsv( $csvfile, '04/25/2026,1,Checking,10.00,Coffee,Cafe,Food' );
freshmap( $mapfile,
'[Checking-VIP] category | Food | Expenses:Dining',
'default | source',
);
local @ARGV = (
'run',
'--input', $csvfile,
'--db', $db_path,
'--output', $qiffile,
'--mapfile', $mapfile,
t/tiller2qif.t view on Meta::CPAN
my $csvfile = uniqfile( 'cli_ie', 'csv' );
my $qiffile = uniqfile( 'cli_ie', 'qif' );
freshdb($db_path)->disconnect;
freshcsv( $csvfile, '04/25/2026,1,Checking,30.00,Coffee,Cafe,Food' );
{ local @ARGV = ( 'ingest', '--input', $csvfile, '--db', $db_path );
ok( lives { Finance::Tiller2QIF::run_cli() }, 'cli ingest returns normally' ); }
{ local @ARGV = ( 'emit', '--db', $db_path, '--output', $qiffile );
ok( lives { Finance::Tiller2QIF::run_cli() }, 'cli emit returns normally' ); }
like( path($qiffile)->slurp_utf8, qr/PCoffee/, 'two-phase cli produced QIF' );
};
subtest cli_run_verbose => sub {
my $db_path = uniqfile( 'cli_runv', 'sqlite3' );
my $qiffile = uniqfile( 'cli_runv', 'qif' );
freshdb($db_path)->disconnect;
local @ARGV = (
'run',
'--input', 't/testcase/mapping1.csv',
'--db', $db_path,
'--output', $qiffile,
'--mapfile', 't/testcase/mapping1.map',
t/tiller2qif.t view on Meta::CPAN
like( $out, qr/Writing QIF/, 'verbose output mentions writing' );
};
subtest cli_newdb_verbose => sub {
my $db_path = uniqfile( 'cli_newdbv', 'sqlite3' );
local @ARGV = ( 'newdb', '--db', $db_path, '--verbose' );
my $out = '';
ok( lives { open( local *STDOUT, '>', \$out ); Finance::Tiller2QIF::run_cli() },
'newdb --verbose returns normally' );
like( $out, qr/Creating database/, 'verbose newdb output mentions creating' );
};
subtest cli_newconfig_verbose => sub {
my $cfgfile = uniqfile( 'cli_newcfgv', 'json' );
local @ARGV = ( 'newconfig', '--config', $cfgfile, '--verbose' );
my $out = '';
ok( lives { open( local *STDOUT, '>', \$out ); Finance::Tiller2QIF::run_cli() },
'newconfig --verbose returns normally' );
like( $out, qr/Creating config/, 'verbose newconfig output mentions creating' );
};
t/tiller2qif.t view on Meta::CPAN
my $qiffile = uniqfile( 'cli_chkcfg', 'qif' );
freshdb($db_path)->disconnect;
freshcsv( $csvfile, '04/25/2026,1,Checking,10.00,Test,Test,Food' );
# checkconfig command reaches line 162 via $cmd =~ /^checkconfig/
local @ARGV = (
'checkconfig',
'--db', $db_path,
'--input', $csvfile,
'--output', $qiffile,
);
t/tiller2qif.t view on Meta::CPAN
freshdb($db_path)->disconnect;
freshcsv( $csvfile, '04/25/2026,1,Checking,20.00,Test,Test,Food' );
Finance::Tiller2QIF::_ingest( input => $csvfile, db_path => $db_path );
# --verbose on emit reaches line 162 via $opt->verbose (non-run command)
local @ARGV = ( 'emit', '--db', $db_path, '--output', $qiffile, '--verbose' );
my $out = '';
ok( lives { open( local *STDOUT, '>', \$out ); Finance::Tiller2QIF::run_cli() },
'emit --verbose returns normally' );
like( $out, qr/db_path\s*:/, 'emit --verbose output lists db_path option via CheckConfig' );
};
t/tiller2qif.t view on Meta::CPAN
my $db_path = uniqfile( 'cli_ckpt_run', 'sqlite3' );
my $csvfile = uniqfile( 'cli_ckpt_run', 'csv' );
my $qiffile = uniqfile( 'cli_ckpt_run', 'qif' );
freshdb($db_path)->disconnect;
freshcsv( $csvfile, '04/25/2026,1,Checking,10.00,Test,Test,Food' );
local @ARGV = ( 'run', '--input', $csvfile, '--db', $db_path, '--output', $qiffile );
ok( lives { Finance::Tiller2QIF::run_cli() }, 'run returns normally' );
my @copies = glob( $db_path . '*' );
ok( @copies > 1, 'run created a checkpoint copy of the database' );
};
subtest cli_checkpoint_flag => sub {
my $db_path = uniqfile( 'cli_ckpt_flag', 'sqlite3' );
my $csvfile = uniqfile( 'cli_ckpt_flag', 'csv' );
freshdb($db_path)->disconnect;
freshcsv( $csvfile, '04/25/2026,1,Checking,10.00,Test,Test,Food' );
local @ARGV = ( 'ingest', '--input', $csvfile, '--db', $db_path, '--checkpoint' );
ok( lives { Finance::Tiller2QIF::run_cli() }, 'ingest --checkpoint returns normally' );
my @copies = glob( $db_path . '*' );
ok( @copies > 1, '--checkpoint created a checkpoint copy of the database' );
};
subtest cli_clean_missing_db => sub {
local @ARGV = ('clean');
ok( dies { Finance::Tiller2QIF::run_cli() }, 'clean without --db dies' );
};
subtest cli_clean => sub {
my $db_path = uniqfile( 'cli_clean', 'sqlite3' );
t/tiller2qif.t view on Meta::CPAN
Finance::Tiller2QIF::_checkpoint( $db_path );
my @before = grep { /\.\d{4}-\d{2}-\d{2}_\d{2}_\d{2}_\d{2}$/ } glob( $db_path . '.*' );
ok( @before == 2, 'two checkpoint copies exist before clean' );
local @ARGV = ( 'clean', '--db', $db_path );
ok( lives { Finance::Tiller2QIF::run_cli() }, 'clean returns normally' );
my @after = grep { /\.\d{4}-\d{2}-\d{2}_\d{2}_\d{2}_\d{2}$/ } glob( $db_path . '.*' );
ok( @after == 0, 'clean removed all checkpoint copies' );
ok( -e $db_path, 'clean left the original database intact' );
};
subtest cli_version => sub {
local @ARGV = ('version');
my $out = '';
ok( lives { open( local *STDOUT, '>', \$out ); Finance::Tiller2QIF::run_cli() },
'version command returns normally' );
like( $out, qr/VERSION/, 'version command prints VERSION' );
};
subtest cli_version_option => sub {
local @ARGV = ('--version');
my $out = '';
ok( lives { open( local *STDOUT, '>', \$out ); Finance::Tiller2QIF::run_cli() },
'--version returns normally' );
like( $out, qr/Tiller2QIF VERSION:/, '--version prints the installed version' );
};
subtest cli_help => sub {
local @ARGV = ('--help');
my $out = '';
ok( lives { open( local *STDOUT, '>', \$out ); Finance::Tiller2QIF::run_cli() },
'--help returns normally' );
like( $out, qr/tiller2qif/, '--help prints usage' );
};
t/tiller2qif.t view on Meta::CPAN
my $cfgfile = uniqfile( 'cli_cfg', 'json' );
freshdb($db_path)->disconnect;
freshcsv( $csvfile, '04/25/2026,1,Checking,10.00,Test,Test,Food' );
Finance::Tiller2QIF::run_cli() if 0; # load module
path($cfgfile)->spew_utf8( qq|{ "db": "$db_path", "input": "$csvfile", "output": "$qiffile" }| );
local @ARGV = ( 'ingest', '--config', $cfgfile );
ok( lives { Finance::Tiller2QIF::run_cli() }, '--config loads options from file' );
my $db = dbi_connect($db_path);
is( $db->select('transactions', ['id'])->arrays->@*, 1, '--config ingest loaded a row' );
$db->disconnect;
};
t/tiller2qif.t view on Meta::CPAN
my $db_path = uniqfile( 'cli_preview', 'sqlite3' );
my $csvfile = uniqfile( 'cli_preview', 'csv' );
freshdb($db_path)->disconnect;
freshcsv( $csvfile, '04/25/2026,1,Checking,10.00,Test,Test,Food' );
Finance::Tiller2QIF::_ingest( input => $csvfile, db_path => $db_path );
local @ARGV = ( 'preview', '--db', $db_path );
my $out = '';
ok( lives { open( local *STDOUT, '>', \$out ); Finance::Tiller2QIF::run_cli() },
'preview command returns normally' );
like( $out, qr/pending export/, 'preview output mentions pending export' );
};
t/tiller2qif.t view on Meta::CPAN
open my \$in, '<:encoding(UTF-8)', \$ARGV[0] or die "stub viewer: \$!";
open my \$out, '>:encoding(UTF-8)', '$marker' or die "stub viewer: \$!";
print {\$out} "\$ARGV[0]\\n", <\$in>;
STUB
local @ARGV = ( 'preview', '--db', $db_path, '--viewer', "$^X $script" );
my $out = '';
ok( lives { open( local *STDOUT, '>', \$out ); Finance::Tiller2QIF::run_cli() },
'--viewer returns normally' );
like( $out, qr/Preview written to \S+\.t2qpv/, 'reports the preview file path' );
like( $out, qr/pending export/, 'still reports the pending count' );
t/tiller2qif.t view on Meta::CPAN
freshcsv( $csvfile, '04/25/2026,1,Checking,10.00,Test,Test,Food' );
Finance::Tiller2QIF::_ingest( input => $csvfile, db_path => $db_path );
my $out = '';
{
local @ARGV = ( 'preview', '--db', $db_path, '--viewer', 'nosuchprog-xyz' );
like(
dies { open( local *STDOUT, '>', \$out ); Finance::Tiller2QIF::run_cli() },
qr/'nosuchprog-xyz' failed/,
'unknown --viewer is fatal' );
unlink $1 if $out =~ /Preview written to (\S+)/;
}
{
local @ARGV = ( 'preview', '--db', $db_path, '--viewer', '' );
like(
dies { open( local *STDOUT, '>', \$out ); Finance::Tiller2QIF::run_cli() },
qr/must name a program or 'console'/,
'empty --viewer is fatal' );
}
my $cfgfile = uniqfile( 'cli_pvbad', 'json' );
path($cfgfile)->spew_utf8(
qq|{ "db": "$db_path", "viewer": "" }| );
{
local @ARGV = ( 'preview', '--config', $cfgfile );
like(
dies { open( local *STDOUT, '>', \$out ); Finance::Tiller2QIF::run_cli() },
qr/must name a program or 'console'/,
'empty viewer in a config file is fatal' );
}
t/tiller2qif.t view on Meta::CPAN
print {\$out} join( "\\n", \@ARGV ), "\\n";
STUB
my $out = '';
{
local @ARGV = ( 'preview', '--db', $db_path, '--mapfile', $mapfile,
'--viewer', "$^X $script", '--multipreview' );
ok( lives { open( local *STDOUT, '>', \$out ); Finance::Tiller2QIF::run_cli() },
'--multipreview returns normally' );
}
like( $out, qr/\QAlso opening: $mapfile\E/, 'reports the mapping file it opened' );
t/tiller2qif.t view on Meta::CPAN
like( $opened[0], qr/\.t2qpv$/, 'preview file first' );
is( $opened[1], $mapfile, 'mapping file second' );
unlink $opened[0];
{
local @ARGV = ( 'preview', '--db', $db_path, '--mapfile', $mapfile, '--multipreview' );
like(
dies { open( local *STDOUT, '>', \$out ); Finance::Tiller2QIF::run_cli() },
qr/--multipreview requires --viewer/,
'--multipreview without a viewer is fatal' );
}
{
local @ARGV = ( 'preview', '--db', $db_path,
'--viewer', "$^X $script", '--multipreview' );
like(
dies { open( local *STDOUT, '>', \$out ); Finance::Tiller2QIF::run_cli() },
qr/--multipreview requires --mapfile/,
'--multipreview without a mapfile is fatal' );
}
{
local @ARGV = ( 'preview', '--db', $db_path, '--mapfile', 'no/such.map',
'--viewer', "$^X $script", '--multipreview' );
like(
dies { open( local *STDOUT, '>', \$out ); Finance::Tiller2QIF::run_cli() },
qr/preview cannot open 'no\/such\.map'/,
'--multipreview with an unreadable mapfile is fatal' );
t/tiller2qif.t view on Meta::CPAN
path($cfgfile)->spew_utf8(
qq|{ "db": "$db_path", "viewer": "$^X $script" }| );
my $out = '';
{
local @ARGV = ( 'preview', '--config', $cfgfile );
ok( lives { open( local *STDOUT, '>', \$out ); Finance::Tiller2QIF::run_cli() },
'viewer from config file runs' );
}
like( $out, qr/Preview written to /, 'config file viewer was used' );
ok( -e $marker, 'config file viewer was launched' );
unlink $1 if $out =~ /Preview written to (\S+)/;
# command line beats the config file
$out = '';
{
local @ARGV = ( 'preview', '--config', $cfgfile, '--viewer', 'console' );
ok( lives { open( local *STDOUT, '>', \$out ); Finance::Tiller2QIF::run_cli() },
'--viewer console overrides the config file' );
}
unlike( $out, qr/Preview written to /, 'console on the command line wins' );
like( $out, qr/Checking/, 'preview printed to STDOUT' );
t/tiller2qif.t view on Meta::CPAN
my $qiffile = uniqfile( 'cli_confirm_y', 'qif' );
freshdb($db_path)->disconnect;
freshcsv( $csvfile, '04/25/2026,1,Checking,10.00,Test,Test,Food' );
Finance::Tiller2QIF::_ingest( input => $csvfile, db_path => $db_path );
local @ARGV = ( 'emit', '--db', $db_path, '--output', $qiffile, '--confirm' );
my $stdin = "y\n";
open( my $fh, '<', \$stdin ) or die $!;
local *STDIN = $fh;
my $out = '';
ok( lives { open( local *STDOUT, '>', \$out ); Finance::Tiller2QIF::run_cli() },
t/tiller2qif.t view on Meta::CPAN
my $qiffile = uniqfile( 'cli_confirm_n', 'qif' );
freshdb($db_path)->disconnect;
freshcsv( $csvfile, '04/25/2026,1,Checking,10.00,Test,Test,Food' );
Finance::Tiller2QIF::_ingest( input => $csvfile, db_path => $db_path );
local @ARGV = ( 'emit', '--db', $db_path, '--output', $qiffile, '--confirm' );
my $stdin = "n\n";
open( my $fh, '<', \$stdin ) or die $!;
local *STDIN = $fh;
my $out = '';
ok( lives { open( local *STDOUT, '>', \$out ); Finance::Tiller2QIF::run_cli() },
t/tiller2qif.t view on Meta::CPAN
# Add another transaction after checkpoint
freshcsv( $csvfile, '04/25/2026,1,Checking,10.00,Test,Test,Food' );
Finance::Tiller2QIF::_ingest( input => $csvfile, db_path => $db_path );
local @ARGV = ( 'emit', '--db', $db_path, '--output', $qiffile, '--confirm', '--checkpoint' );
my $stdin = "r\n";
open( my $fh, '<', \$stdin ) or die $!;
local *STDIN = $fh;
my $out = '';
ok( lives { open( local *STDOUT, '>', \$out ); Finance::Tiller2QIF::run_cli() },
view all matches for this distribution
view release on metacpan or search on metacpan
xs/include/ppport.h view on Meta::CPAN
$rv;
}
sub usage
{
my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
my %M = ( 'I' => '*' );
$usage =~ s/^\s*perl\s+\S+/$^X $0/;
$usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
print <<ENDUSAGE;
xs/include/ppport.h view on Meta::CPAN
exit 2;
}
sub strip
{
my $self = do { local(@ARGV,$/)=($0); <> };
my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
$copy =~ s/^(?=\S+)/ /gms;
$self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
$self =~ s/^SKIP.*(?=^__DATA__)/SKIP
if (\@ARGV && \$ARGV[0] eq '--unstrip') {
view all matches for this distribution
view release on metacpan or search on metacpan
scripts/typetuner view on Meta::CPAN
#the $opt_? vars are declared above as globals
#initialize them here on each call
#the list of $opt_? vars here MUST match the list above!!!
foreach ($opt_h, $opt_d, $opt_f, $opt_t, $opt_m, $opt_n, $opt_o, $opt_v, $opt_x)
{$_ = undef;}
local (@ARGV) = @_; #use 'local' instead of 'my' so &getopts works right
getopts($opt_str); #sets $opt_?'s and removes the switches from @ARGV
if (scalar @ARGV == 0 || $opt_h)
{Usage_print;}
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Footprintless/Util.pm view on Meta::CPAN
sub slurp {
my ($file) = @_;
# http://www.perl.com/pub/2003/11/21/slurp.html
return $file
? do { local ( @ARGV, $/ ) = $file; <> }
: do { local $/; <STDIN> };
}
sub spurt {
my ( $content, $file, %options ) = @_;
view all matches for this distribution
view release on metacpan or search on metacpan
examples/forked_harness.pl view on Meta::CPAN
my $userathost = $ENV{USER} . '@' . $ENV{HOSTNAME};
my $ssh = Forks::Super::Config::CONFIG_external_program("ssh");
if ($ssh && $userathost =~ /.@./) {
my @cmds = ("true", "echo", "dir");
foreach my $cmd (@cmds) {
local $SIG{ALRM} = sub { die "ssh timeout $$ $0 @ARGV\n"; };
alarm 15;
if (eval {my $c1=system($ssh, $userathost, $cmd);$c1==0}) {
$ENV{TEST_SSH_TARGET} = "ssh://$userathost";
print STDERR
"... publickey on current user,host works!\n";
view all matches for this distribution
view release on metacpan or search on metacpan
include/ppport.h view on Meta::CPAN
$rv;
}
sub usage
{
my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
my %M = ( 'I' => '*' );
$usage =~ s/^\s*perl\s+\S+/$^X $0/;
$usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
print <<ENDUSAGE;
include/ppport.h view on Meta::CPAN
exit 2;
}
sub strip
{
my $self = do { local(@ARGV,$/)=($0); <> };
my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
$copy =~ s/^(?=\S+)/ /gms;
$self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
$self =~ s/^SKIP.*(?=^__DATA__)/SKIP
if (\@ARGV && \$ARGV[0] eq '--unstrip') {
view all matches for this distribution
view release on metacpan or search on metacpan
print " --- hint for $func ---\n", $hint;
}
sub usage
{
my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
my %M = ( 'I' => '*' );
$usage =~ s/^\s*perl\s+\S+/$^X $0/;
$usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
print <<ENDUSAGE;
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Future/Batch/ppport.h view on Meta::CPAN
$rv || 0;
}
sub usage
{
my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
my %M = ( 'I' => '*' );
$usage =~ s/^\s*perl\s+\S+/$^X $0/;
$usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
print <<ENDUSAGE;
lib/Future/Batch/ppport.h view on Meta::CPAN
exit 2;
}
sub strip
{
my $self = do { local(@ARGV,$/)=($0); <> };
my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
$copy =~ s/^(?=\S+)/ /gms;
$self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
$self =~ s/^SKIP.*(?=^__DATA__)/SKIP
if (\@ARGV && \$ARGV[0] eq '--unstrip') {
view all matches for this distribution
view release on metacpan or search on metacpan
lib/FvwmPiazza/Layouts/Columns.pm view on Meta::CPAN
# Don't apply the passed-in ratios if we have fewer columns
# than the layout requires
my @ratios = ();
if ($num_cols == $args{max_win} and defined $options[0])
{
local @ARGV = @options;
my $ratio_arg;
my $parser = new Getopt::Long::Parser();
if ($ARGV[0] =~ /^\d[\d:]*$/)
{
$ratio_arg = $options[0];
view all matches for this distribution
view release on metacpan or search on metacpan
copy => 0,
account => 0,
);
$options{log} = $action =~ /REJECT|DENY/ ? 1 : 0;
{
local @ARGV = @opts;
local $SIG{__WARN__} = 'IGNORE';
GetOptions( \%options, @STANDARD_OPTIONS,
$self->service($service)->valid_options )
or do {
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Legacy/Graphics/Browser/Util.pm view on Meta::CPAN
return $self->do_load_gff($file_or_directory) if ref($file_or_directory)
&& tied *$file_or_directory;
my $tied_stdin = tied(*STDIN);
open SAVEIN,"<&STDIN" unless $tied_stdin;
local @ARGV = $self->setup_argv($file_or_directory,'gff','gff3') or return; # to play tricks with reader
my $result = $self->do_load_gff('ARGV');
open STDIN,"<&SAVEIN" unless $tied_stdin; # restore STDIN
return $result;
}
sub Bio::DB::GFF::_load_gff_line {
view all matches for this distribution
view release on metacpan or search on metacpan
$rv;
}
sub usage
{
my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
my %M = ( 'I' => '*' );
$usage =~ s/^\s*perl\s+\S+/$^X $0/;
$usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
print <<ENDUSAGE;
exit 2;
}
sub strip
{
my $self = do { local(@ARGV,$/)=($0); <> };
my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
$copy =~ s/^(?=\S+)/ /gms;
$self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
$self =~ s/^SKIP.*(?=^__DATA__)/SKIP
if (\@ARGV && \$ARGV[0] eq '--unstrip') {
view all matches for this distribution
view release on metacpan or search on metacpan
t/20-script-suppress.t view on Meta::CPAN
use warnings;
use Test::More tests => 2;
use IO::Scalar;
{
local @ARGV = (q[s=1,2,3,4], q[suppress=1]);
my $str = q[];
my $io = IO::Scalar->new(\$str);
select $io;
eval q[require "bin/sparkline"];
view all matches for this distribution
view release on metacpan or search on metacpan
bin/iabtcfv2 view on Meta::CPAN
require Getopt::Long;
my $parser = Getopt::Long::Parser->new(config => [qw(no_pass_through require_order bundling)]);
my $getopt_ok;
{
local @ARGV = @args;
$getopt_ok = $parser->getoptions(
'pretty|p' => \$opts{pretty},
'compact|c' => \$opts{compact},
'ignore-errors|i' => \$opts{'ignore-errors'},
'fail-fast|f' => \$opts{'fail-fast'},
bin/iabtcfv2 view on Meta::CPAN
require Getopt::Long;
my $parser = Getopt::Long::Parser->new(config => [qw(no_pass_through require_order bundling)]);
my $getopt_ok;
{
local @ARGV = @args;
$getopt_ok = $parser->getoptions(
'pretty|p' => \$opts{pretty},
'ignore-errors|i' => \$opts{'ignore-errors'},
'fail-fast|f' => \$opts{'fail-fast'},
'errors-to-stderr|e' => \$opts{'errors-to-stderr'},
view all matches for this distribution
view release on metacpan or search on metacpan
$rv;
}
sub usage
{
my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
my %M = ( 'I' => '*' );
$usage =~ s/^\s*perl\s+\S+/$^X $0/;
$usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
print <<ENDUSAGE;
exit 2;
}
sub strip
{
my $self = do { local(@ARGV,$/)=($0); <> };
my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
$copy =~ s/^(?=\S+)/ /gms;
$self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
$self =~ s/^SKIP.*(?=^__DATA__)/SKIP
if (\@ARGV && \$ARGV[0] eq '--unstrip') {
view all matches for this distribution
view release on metacpan or search on metacpan
$rv;
}
sub usage
{
my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
my %M = ( 'I' => '*' );
$usage =~ s/^\s*perl\s+\S+/$^X $0/;
$usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
print <<ENDUSAGE;
exit 2;
}
sub strip
{
my $self = do { local(@ARGV,$/)=($0); <> };
my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
$copy =~ s/^(?=\S+)/ /gms;
$self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
$self =~ s/^SKIP.*(?=^__DATA__)/SKIP
if (\@ARGV && \$ARGV[0] eq '--unstrip') {
view all matches for this distribution
view release on metacpan or search on metacpan
$rv;
}
sub usage
{
my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
my %M = ( 'I' => '*' );
$usage =~ s/^\s*perl\s+\S+/$^X $0/;
$usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
print <<ENDUSAGE;
exit 2;
}
sub strip
{
my $self = do { local(@ARGV,$/)=($0); <> };
my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
$copy =~ s/^(?=\S+)/ /gms;
$self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
$self =~ s/^SKIP.*(?=^__DATA__)/SKIP
if (\@ARGV && \$ARGV[0] eq '--unstrip') {
view all matches for this distribution
view release on metacpan or search on metacpan
script/game-life-faster view on Meta::CPAN
_state_opt( living => @_ );
return;
}
sub cmd_load {
local @ARGV = @_;
my %o = %opt;
GetOptions( \%o,
qw{ living=s },
) or return;
my ( $file, $x, $y ) = @ARGV;
view all matches for this distribution
view release on metacpan or search on metacpan
$rv;
}
sub usage
{
my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
my %M = ( 'I' => '*' );
$usage =~ s/^\s*perl\s+\S+/$^X $0/;
$usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
print <<ENDUSAGE;
exit 2;
}
sub strip
{
my $self = do { local(@ARGV,$/)=($0); <> };
my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
$copy =~ s/^(?=\S+)/ /gms;
$self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
$self =~ s/^SKIP.*(?=^__DATA__)/SKIP
if (\@ARGV && \$ARGV[0] eq '--unstrip') {
view all matches for this distribution
view release on metacpan or search on metacpan
t/33-synopsis.t view on Meta::CPAN
}
subtest 'Game::Senet::Terminal' => sub {
my $code = synopsis_of('Game::Senet::Terminal');
ok(defined $code && $code =~ /->run\(\@ARGV\)/, 'it has a synopsis, and it runs the program');
local @ARGV = ('--version');
$exited = undef;
my ($ok, $error, $said) = run_capturing($code);
is($error, "exit was called\n", 'the first line runs and leaves through exit, as a program does');
is($exited, 0, ' with 0');
like($said, qr/\Asenet \d+\.\d+\n\z/, ' having done what --version asks');
view all matches for this distribution
view release on metacpan or search on metacpan
$rv || 0;
}
sub usage
{
my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
my %M = ( 'I' => '*' );
$usage =~ s/^\s*perl\s+\S+/$^X $0/;
$usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
print <<ENDUSAGE;
exit 2;
}
sub strip
{
my $self = do { local(@ARGV,$/)=($0); <> };
my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
$copy =~ s/^(?=\S+)/ /gms;
$self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
$self =~ s/^SKIP.*(?=^__DATA__)/SKIP
if (\@ARGV && \$ARGV[0] eq '--unstrip') {
view all matches for this distribution
view release on metacpan or search on metacpan
$rv;
}
sub usage
{
my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
my %M = ( 'I' => '*' );
$usage =~ s/^\s*perl\s+\S+/$^X $0/;
$usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
print <<ENDUSAGE;
exit 2;
}
sub strip
{
my $self = do { local(@ARGV,$/)=($0); <> };
my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
$copy =~ s/^(?=\S+)/ /gms;
$self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
$self =~ s/^SKIP.*(?=^__DATA__)/SKIP
if (\@ARGV && \$ARGV[0] eq '--unstrip') {
view all matches for this distribution
view release on metacpan or search on metacpan
lib/Games/ABC_Path/Solver/App.pm view on Meta::CPAN
sub run
{
my $self = shift;
local @ARGV = @{$self->_argv};
my $man = 0;
my $help = 0;
my $gen_template = 0;
GetOptions(
view all matches for this distribution
view release on metacpan or search on metacpan
$rv;
}
sub usage
{
my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
my %M = ( 'I' => '*' );
$usage =~ s/^\s*perl\s+\S+/$^X $0/;
$usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
print <<ENDUSAGE;
exit 2;
}
sub strip
{
my $self = do { local(@ARGV,$/)=($0); <> };
my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
$copy =~ s/^(?=\S+)/ /gms;
$self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
$self =~ s/^SKIP.*(?=^__DATA__)/SKIP
if (\@ARGV && \$ARGV[0] eq '--unstrip') {
view all matches for this distribution
view release on metacpan or search on metacpan
$rv;
}
sub usage
{
my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
my %M = ( 'I' => '*' );
$usage =~ s/^\s*perl\s+\S+/$^X $0/;
$usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
print <<ENDUSAGE;
exit 2;
}
sub strip
{
my $self = do { local(@ARGV,$/)=($0); <> };
my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
$copy =~ s/^(?=\S+)/ /gms;
$self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
$self =~ s/^SKIP.*(?=^__DATA__)/SKIP
if (\@ARGV && \$ARGV[0] eq '--unstrip') {
view all matches for this distribution