view release on metacpan or  search on metacpan

script/dropbox-api  view on Meta::CPAN

    }
    $path =~ s|/$||;
    $path;
}

sub pretty($) {
    JSON->new->utf8->pretty->encode($_[0]);
}

use constant UNITS => [
    [ 'P', 1024 ** 4 * 1000, 1024 ** 5 ],

 view release on metacpan or  search on metacpan

lib/App/financeta/gui.pm  view on Meta::CPAN

    my ($self, $win) = @_;
    my $wiz = App::financeta::gui::security_wizard->new(owner => $win, gui => $self);
    return ($wiz->run() == mb::Ok) ? 1 : undef;
}

sub remove_indicator($) {
    my ($self, $win) = @_;
    my $result = $self->remove_indicator_wizard($win);
    if ($result and ref $result eq 'HASH') {
        $log->debug("Removing indicator: ", dumper($result));
        # we know here the name of the indicator, the index of the indicator and

lib/App/financeta/gui.pm  view on Meta::CPAN

        return 1;
    }
    return 0;
}

sub add_indicator($$$) {
    my ($self, $win, $data, $symbol) = @_;
    if ($self->add_indicator_wizard($win)) {
        my $iref = $self->current->{indicator};
        if ($self->run_and_display_indicator($win, $data, $symbol, [$iref])) {
            my ($ndata, $nsymbol, $indicators, $ndhr, $nbs) = $self->get_tab_data($win);

lib/App/financeta/gui.pm  view on Meta::CPAN

    return unless @tabs;
    my $idx = $win->data_tabs->pageIndex;
    return $self->_get_tab_data($win->data_tabs, $idx);
}

sub get_tab_data_by_name($$) {
    my ($self, $win, $name) = @_;
    return unless $win;
    my @tabs = grep { $_->name =~ /data_tabs/ } $win->get_widgets();
    return unless @tabs;
    my $pc = $win->data_tabs->pageCount - 1;

lib/App/financeta/gui.pm  view on Meta::CPAN

        $log->debug("Getting info for " . $dl->name);
        return wantarray ? ($dl->{-info}, $dl->name) : $dl->{-info};
    }
}

sub set_tab_info($$) {
    my ($self, $win, $info) = @_;
    return unless $win;
    my @tabs = grep { $_->name =~ /data_tabs/ } $win->get_widgets();
    return unless @tabs;
    my $idx = $win->data_tabs->pageIndex;

lib/App/financeta/gui.pm  view on Meta::CPAN

        $dl->{-info} = $info;
        return 1;
    }
}

sub set_tab_data_by_name($$) {
    my ($self, $win, $name, $p, $s, $ind, $hdr) = @_;
    return unless $win;
    return unless $name;
    my @tabs = grep { $_->name =~ /data_tabs/ } $win->get_widgets();
    return unless @tabs;

lib/App/financeta/gui.pm  view on Meta::CPAN

            return wantarray ? ($dl->{-buysells}, $dl->name) : $dl->{-buysells};
        }
    }
}

sub get_tab_names($) {
    my ($self, $win) = @_;
    return unless $win;
    my @tabs = grep { $_->name =~ /data_tabs/ } $win->get_widgets();
    return unless @tabs;
    my $pc = $win->data_tabs->pageCount - 1;

 view release on metacpan or  search on metacpan

lib/FlashVideo/Utils.pm  view on Meta::CPAN

  extract_title extract_info title_to_filename get_video_filename url_exists
  swfhash swfhash_data EXTENSIONS get_user_config_dir get_win_codepage
  is_program_on_path get_terminal_width json_unescape
  convert_sami_subtitles_to_srt from_xml);

sub debug(@) {
  # Remove some sensitive data
  my $string = "@_\n";
  $string =~ s/\Q$ENV{HOME}\E/~/g;
  print STDERR $string if $App::get_flash_videos::opt{debug};
}

sub info(@) {
  print STDERR "@_\n" unless $App::get_flash_videos::opt{quiet};
}

sub error(@) {
  print STDERR "@_\n";
}

sub extract_title {
  my($browser) = @_;

 view release on metacpan or  search on metacpan

lib/App/gh/Git.pm  view on Meta::CPAN

Note that this is the only auto-exported function.

=cut

sub git_cmd_try(&$) {
	my ($code, $errmsg) = @_;
	my @result;
	my $err;
	my $array = wantarray;
	try {

 view release on metacpan or  search on metacpan

inc/Test/More.pm  view on Meta::CPAN

    return $tb->unlike(@_);
}

#line 476

sub cmp_ok($$$;$) {
    my $tb = Test::More->builder;

    return $tb->cmp_ok(@_);
}

 view release on metacpan or  search on metacpan

lib/App/livehttperf.pm  view on Meta::CPAN

    output => undef,
    output_xls => undef,
);

# subs
sub LOG(@)  { print @_, "\n" }
sub TRACE() { $OPTS{verbosity} >= 4; }
sub DEBUG() { $OPTS{verbosity} >= 3; }
sub INFO()  { $OPTS{verbosity} >= 2; }
sub WARN()  { $OPTS{verbosity} >= 1; }
sub ERROR() { ! $OPTS{quiet}; }

sub trim { s/\r?\n$// for @_ };
sub hb($) { return $_[0] ? 'Yes' : 'No' }

sub print_version {
    my $year = (localtime)[5] + 1900;
    my $years = $year != 2012 ? "2012-$year" : '2012';
    binmode STDOUT, ":utf8";

 view release on metacpan or  search on metacpan

lib/App/MadEye/Util.pm  view on Meta::CPAN

use Time::HiRes qw/gettimeofday/;
use Net::SNMP;

sub context () { App::MadEye->context } ## no critic.

sub timeout($$&) {    ## no critic.
    my ( $secs, $msg, $code ) = @_;

    context->log(debug => "run timer: '$msg', $secs");;

    my $last_alarm = 0;

 view release on metacpan or  search on metacpan

t/lib/App/makedpkg/Tester.pm  view on Meta::CPAN

our @cmd = qw(stdout stderr output error exit_code);
eval "sub $_() { my \$s=\$RESULT->$_; chomp \$s; \$s }" for @cmd;

our @EXPORT = (qw(makedpkg write_file write_yaml path), @cmd);

sub makedpkg(@) {
    $RESULT = test_app('App::makedpkg' => [@_]);
}

sub write_file(@) {
    open my $fh, ">", shift;
    print $fh @_;
    close $fh;
}

sub write_yaml(@) {
    my $file = shift;
    write_file($file, join "\n", "---", @_, "");
}

# always start in a new, temporary directory

 view release on metacpan or  search on metacpan

inc/Test/More.pm  view on Meta::CPAN

    return $tb->unlike(@_);
}

#line 476

sub cmp_ok($$$;$) {
    my $tb = Test::More->builder;

    return $tb->cmp_ok(@_);
}

 view release on metacpan or  search on metacpan

lib/NRun/Queue.pm  view on Meta::CPAN

# connect the currently running process to this queue.
#
# - must be called once before each fork() 
# - must be called before start() and next()
# - must be called in the parent's context
sub connect() {

    my $_self = shift;

    my ( $child, $parent );

 view release on metacpan or  search on metacpan

lib/App/olson.pm  view on Meta::CPAN

#
# list utilities
#

sub _all(&@) {
	my $match = shift(@_);
	foreach(@_) {
		return 0 unless $match->($_);
	}
	return 1;

lib/App/olson.pm  view on Meta::CPAN

#
# exceptions
#

sub _is_exception($) {
	return is_string($_[0]) && $_[0] =~ /\A[!?~]\z/;
}

sub _cmp_exception($$) { $_[0] cmp $_[1] }

#
# calendar dates
#

sub _caltime_offset($$) {
	my($rdns, $offset) = @_;
	return $rdns if _is_exception($rdns);
	return $offset if _is_exception($offset);
	my($rdn, $sod) = @$rdns;
	$sod += $offset;

lib/App/olson.pm  view on Meta::CPAN

	"zone disuse" => "!",
	"missing data" => "?",
	"offset change" => "~",
);

sub _handle_exception($$$) {
	my($val, $expect_rx, $err) = @_;
	if($err eq "") {
		return $val;
	} elsif($err =~ /\A
		$expect_rx\ in\ the\ [!-~]+\ timezone

lib/App/olson.pm  view on Meta::CPAN

		return bless({ rdn => $rdns->[0], sod => $rdns->[1] }, $class);
	}
	sub utc_rd_values { ($_[0]->{rdn}, $_[0]->{sod}, 0) }
}

sub _handle_forward_exception($$) {
	return _handle_exception($_[0],
		qr/time [-:TZ0-9]+ is not represented/, $_[1]);
}

{

lib/App/olson.pm  view on Meta::CPAN

		return bless({ rdn => $rdns->[0], sod => $rdns->[1] }, $class);
	}
	sub local_rd_values { ($_[0]->{rdn}, $_[0]->{sod}, 0) }
}

sub _handle_backward_exception($$) {
	return _handle_exception($_[0],
		qr/local time [-:T0-9]+ does not exist/, $_[1]);
}

#

lib/App/olson.pm  view on Meta::CPAN

	cmp => sub { $_[0] cmp $_[1] },
};

my $rdn_epoch_cjdn = 1721425;

sub _present_caltime($) {
	my($rdns) = @_;
	my($rdn, $sod) = @$rdns;
	use integer;
	return present_ymd($rdn + $rdn_epoch_cjdn).
		"T".sprintf("%02d:%02d:%02d", $sod/3600, $sod/60%60, $sod%60);

lib/App/olson.pm  view on Meta::CPAN

	(?:[0-9]{2}
	(?:[0-9]{2}
	)?)?)?)?)?
/x;

sub _parse_caltime($) {
	my($txt) = @_;
	my($y, $mo, $d, $h, $mi, $s) = ($txt =~ /\A
		([0-9]{4})
		(?:.*?([0-9]{2})
		(?:.*?([0-9]{2})

lib/App/olson.pm  view on Meta::CPAN

};

my $unix_epoch_rdn = 719163;

my $now_absolute_time;
sub _now_absolute_time() {
	return $now_absolute_time ||= do {
		my $nowu = time;
		[ int($nowu/86400) + $unix_epoch_rdn, $nowu % 86400 ];
	};
}

lib/App/olson.pm  view on Meta::CPAN

	rx => qr/[-+]/,
	parse => sub { $_[0] eq "+" ? 1 : 0 },
	cmp => sub { $_[0] <=> $_[1] },
};

sub _type_parse_from_gmatch($$) {
	my($type, $rtxt) = @_;
	my $typerx = $type->{rx} or die "can't input a @{[$type->{desc}]}\n";
	$$rtxt =~ /\G(
		[\+\-\/0-9\:A-Z_a-z]
		(?:[\ \+\-\/0-9\:A-Z_a-z]*[\+\-\/0-9\:A-Z_a-z])?

lib/App/olson.pm  view on Meta::CPAN

	my $valtxt = $1;
	$valtxt =~ /\A$typerx\z/ or die "malformed @{[$type->{desc}]}\n";
	return $type->{parse}->($valtxt);
}

sub _type_curry_xpresent($) {
	my($type) = @_;
	my $pew = exists($type->{present_exception_width}) ?
			$type->{present_exception_width} : 1;
	my $pfw = exists($type->{present_field_width}) ?
			$type->{present_field_width} : 0;

lib/App/olson.pm  view on Meta::CPAN

		$txt .= " " x ($pfw - length($txt)) if $pfw > length($txt);
		return $txt;
	};
}

sub _type_curry_xcmp($) {
	my($type) = @_;
	my $cmp_normal = $type->{cmp};
	return $type->{t_cmp} ||= sub {
		my($x, $y) = @_;
		if(_is_exception($x)) {

lib/App/olson.pm  view on Meta::CPAN

		my $get_offs = $attrclass{offset}->{curry_get}->($_[0]);
		return sub { _caltime_offset($when, $get_offs->($_[0])) };
	},
};

sub _parse_attribute_from_gmatch($) {
	my($rtxt) = @_;
	$$rtxt =~ /\G([a-zA-Z0-9_]+)/gc or die "missing attribute name\n";
	my $classname = $1;
	my $ac = $attrclass{$classname}
		or die "no such attribute class `$classname'\n";

lib/App/olson.pm  view on Meta::CPAN

	"<=" => sub { $_[0] <= 0 },
	">=" => sub { $_[0] >= 0 },
	"=" => sub { $_[0] == 0 },
);

sub _parse_criterion_from_gmatch($) {
	my($rtxt) = @_;
	my $attr = _parse_attribute_from_gmatch($rtxt);
	$$rtxt =~ /\G *(!)?([<>]=?|=|\?)/gc
		or die "syntax error in criterion\n";
	my($neg, $op) = ($1, $2);

lib/App/olson.pm  view on Meta::CPAN

		$line =~ s/ +\z//;
		print $line, "\n";
	}
};

sub run(@) {
	my $cmd = shift(@_);
	defined $cmd or die "no subcommand specified\n";
	($command{$cmd} || sub { die "unrecognised subcommand\n" })->(@_);
}

 view release on metacpan or  search on metacpan

t/10-dirs.t  view on Meta::CPAN

my ($stdout, $stderr);
tie $stdout, 'IPC::Shareable', 'stdout', { create => 'true' } or die "tie failed\n";;
tie $stderr, 'IPC::Shareable', 'stderr', { create => 'true' } or die "tie failed\n";;

# emulate calling ppp on command line
sub ppp(@) {
    $stdout = undef;
    $stderr = undef;

    my $pid = fork();
    if ($pid == 0) {

 view release on metacpan or  search on metacpan

script/perlall  view on Meta::CPAN

    print "\033[1;32m",join(" ",@_),"\033[0;0m\n";
  } elsif ($level == 1) { # bold red/black, major commands
    print "\033[1;39m",join(" ",@_),"\033[0;0m\n";
  }
}
sub _backup($) {
  my $f = shift;
  my $i = 1;
  while (-e "$f.$i") { $i++ }
  rename $f,"$f.$i";
}

 view release on metacpan or  search on metacpan

lib/App/Perlbrew/Util.pm  view on Meta::CPAN

sub uniq {
    my %seen;
    grep { !$seen{$_}++ } @_;
}

sub min(@) {
    my $m = $_[0];
    for(@_) {
        $m = $_ if $_ < $m;
    }
    return $m;

 view release on metacpan or  search on metacpan

lib/App/Phoebe/Ijirait.pm  view on Meta::CPAN

  my $bytes = encode_json $data;
  my $dir = $server->{wiki_dir};
  write_binary("$dir/ijirait.json", $bytes);
}

sub cleanup() {
  my $now = time;
  my %people = map { $_->{location} => 1 } @{$data->{people}};
  for my $room (@{$data->{rooms}}) {
    my @words;
    for my $word (@{$room->{words}}) {

 view release on metacpan or  search on metacpan

t/test.pm  view on Meta::CPAN

use IPC::Open3;

system 'env >/run/shm/env; p -3i > /run/shm/p';
my $windows = $^O =~ /^MSWin/;

sub slurp($) {
    my( $ret, $n ) = '';
    while( $n = sysread $_[0], my $txt, 1024 ) {
	$ret .= $txt;
    }
    unless( defined $n ) {

t/test.pm  view on Meta::CPAN

sub at {
    $at //= sprintf '#line %d "%s"', (caller 1)[2, 1];
}

# name and result to compare with $_
sub test($$) {
    at;
    my( $name, $ret ) = @_;
    if( $ret eq $_ ) {
	ok 1, $name;
    } elsif( $ENV{HARNESS_ACTIVE} ) { # make cpan tester show result

t/test.pm  view on Meta::CPAN

    }
    undef $at;
}

# run pl, expect $_
sub pl(@) {
    at;
    my @cmd = ($^X, '-W', '../pl', @_);
    my $name = join ' ', 'pl', map /[\s*?()[\]{}\$\\'";|&]|^$/ ? "'$_'" : $_, @_;
    if( $windows ) {
	require Win32::ShellQuote;

t/test.pm  view on Meta::CPAN

      slurp $fh;
    waitpid $pid, 0;
}

# run pl, expect shift
sub pl_e($@) {
    at;
    local $_ = shift;
    &pl;
}

# run pl, expect $_ altered by shift->()
sub pl_a(&@) {
    at;
    local $_ = $_;
    shift->();
    &pl;
}

 view release on metacpan or  search on metacpan

t/test.pm  view on Meta::CPAN

use strict;

use Test::Simple tests => $::tests;
use IPC::Open3;

sub slurp($) {
    my( $ret, $n ) = '';
    while( $n = sysread $_[0], my $txt, 1024 ) {
	$ret .= $txt;
    }
    unless( defined $n ) {

t/test.pm  view on Meta::CPAN

    }
    $ret;
}

# run pltest, expect $_
sub pltest(@) {
    my @cmd = ($^X, '-W', '../pltest', @_);
    if( $^O =~ /^MSWin/ ) {
	require Win32::ShellQuote;
	$cmd[2] = '..\pltest';
	@cmd = Win32::ShellQuote::quote_native( @cmd );

t/test.pm  view on Meta::CPAN

      or print "got: '$ret', expected: '$_'\n";
    waitpid $pid, 0;
}

# run pltest, expect shift
sub pl_e($@) {
    local $_ = shift;
    &pltest;
}

# run pltest, expect $_ altered by shift->()
sub pl_a(&@) {
    local $_ = $_;
    shift->();
    &pltest;
}

 view release on metacpan or  search on metacpan

lib/App/podweaver.pm  view on Meta::CPAN

use PPI::Document;
use Try::Tiny;

our $VERSION = '1.00';

sub FAIL()              { 0; }
sub SUCCESS_UNCHANGED() { 1; }
sub SUCCESS_CHANGED()   { 2; }

sub weave_file
{
    my ( $self, %input ) = @_;
    my ( $file, $no_backup, $write_to_dot_new, $weaver );

 view release on metacpan or  search on metacpan

lib/App/ppll.pm  view on Meta::CPAN

=head2 stop

=cut

sub stop( $self ) {
  $self->{parameters} = [];

  for my $worker ( @{ $self->{pool} } ) {
    $worker->stop;
  }

lib/App/ppll.pm  view on Meta::CPAN

    }
    return;
  };
} ## end sub _printer

sub _ps_four() {
  state $ps_four;

  unless ( defined $ps_four ) {
    $ps_four = $ENV{PS4};
    utf8::decode(              ## no critic [Subroutines::ProhibitCallsToUnexportedSubs]

lib/App/ppll.pm  view on Meta::CPAN

sub _split_fields ( $self, $str ) {
  return split( $self->{delimiter}, $str );
}

sub _string_colour( $str ) {
  return $COLOURS[ unpack( 'L', substr( md5( $str ), 0, 2 * 2 ) ) %
    scalar @COLOURS ];
}

sub _width( $self ) {
  return $ENV{COLUMNS}
    if $ENV{COLUMNS};

  return ( GetTerminalSize() )[0] // $WIDTH;
}

 view release on metacpan or  search on metacpan

lib/App/pscan/Command.pm  view on Meta::CPAN

    if( $@ ) {
        warn $@;
    }
}

sub run(){
    my $self=shift;
        $self->global_help if ($self->{help});
}

sub global_help {

 view release on metacpan or  search on metacpan

t/Util.pm  view on Meta::CPAN

use base qw(Exporter);
our @EXPORT = qw(p);

use Data::Dumper;

sub p($) {
    local $Data::Dumper::Indent    = 1;
    local $Data::Dumper::Deepcopy  = 1;
    local $Data::Dumper::Sortkeys  = 1;
    local $Data::Dumper::Terse     = 1;
    local $Data::Dumper::Useqq     = 1;

 view release on metacpan or  search on metacpan

script/s2p  view on Meta::CPAN

#
# Labels
#
# Error handling
#
sub Warn($;$){
    my( $msg, $loc ) = @_;
    $loc ||= '';
    $loc .= ': ' if length( $loc );
    warn( "$0: $loc$msg\n" );
}

$labNum = 0;
sub newLabel(){
    return 'L_'.++$labNum;
}

# safeHere: create safe here delimiter and  modify opcode and argument
#
sub safeHere($$){
    my( $codref, $argref ) = @_;
    my $eod = 'EOD000';
    while( $$argref =~ /^$eod$/m ){
        $eod++;
    }

script/s2p  view on Meta::CPAN

    $$argref .= "$eod\n";
}

# Emit: create address logic and emit command
#
sub Emit($$$$$$){
    my( $addr1, $addr2, $negated, $opcode, $arg, $fl ) = @_;
    my $cond = '';
    if( defined( $addr1 ) ){
        if( defined( $addr2 ) ){
	    $addr1 .= $addr2 =~ /^\d+$/ ? "..$addr2" : "...$addr2";

script/s2p  view on Meta::CPAN

    0;
}

# Write (w command, w flag): store pathname
#
sub Write($$$$$$){
    my( $addr1, $addr2, $negated, $opcode, $path, $fl ) = @_;
    $wFiles{$path} = '';
    Emit( $addr1, $addr2, $negated, $opcode, $path, $fl );
}


# Label (: command): label definition
#
sub Label($$$$$$){
    my( $addr1, $addr2, $negated, $opcode, $lab, $fl ) = @_;
    my $rc = 0;
    $lab =~ s/\s+//;
    if( length( $lab ) ){
	my $h;

script/s2p  view on Meta::CPAN

    $rc;
}

# BeginBlock ({ command): push block start
#
sub BeginBlock($$$$$$){
    my( $addr1, $addr2, $negated, $opcode, $arg, $fl ) = @_;
    push( @BlockStack, [ $fl, $addr1, $addr2, $negated ] );
    Emit( $addr1, $addr2, $negated, $opcode, $arg, $fl );
}

# EndBlock (} command): check proper nesting
#
sub EndBlock($$$$$$){
    my( $addr1, $addr2, $negated, $opcode, $arg, $fl ) = @_;
    my $rc;
    my $jcom = pop( @BlockStack );
    if( defined( $jcom ) ){
	$rc = Emit( $addr1, $addr2, $negated, $opcode, $arg, $fl );

script/s2p  view on Meta::CPAN

    $rc;
}

# Branch (t, b commands): check or create label, substitute default
#
sub Branch($$$$$$){
    my( $addr1, $addr2, $negated, $opcode, $lab, $fl ) = @_;
    $lab =~ s/\s+//; # no spaces at end
    my $h;
    if( length( $lab ) ){
	if( ! exists( $Label{$lab} ) ){

script/s2p  view on Meta::CPAN

    Emit( $addr1, $addr2, $negated, $opcode, '', $fl );
}

# Change (c command): is special due to range end watching
#
sub Change($$$$$$){
    my( $addr1, $addr2, $negated, $opcode, $arg, $fl ) = @_;
    my $kwd = $negated ? 'unless' : 'if';
    if( defined( $addr2 ) ){
        $addr1 .= $addr2 =~ /^\d+$/ ? "..$addr2" : "...$addr2";
	if( ! $negated ){

script/s2p  view on Meta::CPAN

}


# Comment (# command): A no-op. Who would've thought that!
#
sub Comment($$$$$$){
    my( $addr1, $addr2, $negated, $opcode, $arg, $fl ) = @_;
### $Code .= "# $arg\n";
    0;
}

# stripRegex from the current command. If we're in the first
# part of s///, trailing spaces have to be kept as the initial
# part of the replacement string.
#
sub stripRegex($$;$){
    my( $del, $sref, $sub ) = @_;
    my $regex = $del;
    print "stripRegex:$del:$$sref:\n" if $useDEBUG;
    while( $$sref =~ s{^(.*?)(\\*)\Q$del\E(\s*)}{}s ){
        my $sl = $2;

script/s2p  view on Meta::CPAN

}

# stripTrans: take a <del> terminated string from y command
#   honoring and cleaning up of \-escaped <del>'s
#
sub stripTrans($$){
    my( $del, $sref ) = @_;
    my $t = '';
    print "stripTrans:$del:$$sref:\n" if $useDEBUG;
    while( $$sref =~ s{^(.*?)(\\*)\Q$del\E}{}s ){
        my $sl = $2;

script/s2p  view on Meta::CPAN

    undef();
}

# makey - construct Perl y/// from sed y///
#
sub makey($$$){
    my( $fr, $to, $fl ) = @_;
    my $error = 0;

    # Ensure that any '-' is up front.
    # Diagnose duplicate contradicting mappings

script/s2p  view on Meta::CPAN

}

######
# makes - construct Perl s/// from sed s///
#
sub makes($$$$$$$){
    my( $regex, $subst, $path, $global, $print, $nmatch, $fl ) = @_;

    # make embedded newlines safe
    $regex =~ s/\n/\\n/g;
    $subst =~ s/\n/\\n/g;

script/s2p  view on Meta::CPAN

=cut

#####
# bre2p - convert BRE to Perl RE
#
sub peek(\$$){
    my( $pref, $ic ) = @_;
    $ic < length($$pref)-1 ? substr( $$pref, $ic+1, 1 ) : '';
}

sub bre2p($$$){
    my( $del, $pat, $fl ) = @_;
    my $led = $del;
    $led =~ tr/{([</})]>/;
    $led = '' if $led eq $del;

script/s2p  view on Meta::CPAN

#####
# sub2p - convert sed substitution to Perl substitution
#
sub sub2p($$$){
    my( $del, $subst, $fl ) = @_;
    my $led = $del;
    $led =~ tr/{([</})]>/;
    $led = '' if $led eq $del;

script/s2p  view on Meta::CPAN

    $res =~ s/\t/\\t/g;
    return ( $led ? $del : $led ) . $res . ( $led ? $led : $del );
}


sub Parse(){
    my $error = 0;
    my( $pdef, $pfil, $plin );
    for( my $icom = 0; $icom < @Commands; $icom++ ){
	my $cmd = $Commands[$icom];
	print "Parse:$cmd:\n" if $useDEBUG;

script/s2p  view on Meta::CPAN

##############
#### MAIN ####
##############

sub usage(){
    print STDERR "Usage: sed [-an] command [file...]\n";
    print STDERR "           [-an] [-e command] [-f script-file] [file...]\n";
}

###################

script/s2p  view on Meta::CPAN

#
$Func = <<'[TheEnd]';

# openARGV: open 1st input file
#
sub openARGV(){
    unshift( @ARGV, '-' ) unless @ARGV;
    my $file = shift( @ARGV );
    open( ARG, "<$file" )
    || die( "$0: can't open $file for reading ($!)\n" );
    $isEOF = 0;
}

# getsARGV: Read another input line into argument (default: $_).
#           Move on to next input file, and reset EOF flag $isEOF.
sub getsARGV(;\$){
    my $argref = @_ ? shift() : \$_;
    while( $isEOF || ! defined( $$argref = <ARG> ) ){
	close( ARG );
	return 0 unless @ARGV;
	my $file = shift( @ARGV );

script/s2p  view on Meta::CPAN

    1;
}

# eofARGV: end-of-file test
#
sub eofARGV(){
    return @ARGV == 0 && ( $isEOF = eof( ARG ) );
}

# makeHandle: Generates another file handle for some file (given by its path)
#             to be written due to a w command or an s command's w flag.
sub makeHandle($){
    my( $path ) = @_;
    my $handle;
    if( ! exists( $wFiles{$path} ) || $wFiles{$path} eq '' ){
        $handle = $wFiles{$path} = gensym();
	if( $doOpenWrite ){

script/s2p  view on Meta::CPAN

    return $handle;
}

# printQ: Print queued output which is either a string or a reference
#         to a pathname.
sub printQ(){
    for my $q ( @Q ){
	if( ref( $q ) ){
            # flush open w files so that reading this file gets it all
	    if( exists( $wFiles{$$q} ) && $wFiles{$$q} ne '' ){
		open( $wFiles{$$q}, ">>$$q" );

script/s2p  view on Meta::CPAN

[TheEnd]

# generate the sed loop
#
$Code .= <<'[TheEnd]';
sub openARGV();
sub getsARGV(;\$);
sub eofARGV();
sub printQ();

# Run: the sed loop reading input and applying the script
#
sub Run(){
    my( $h, $icnt, $s, $n );
    # hack (not unbreakable :-/) to avoid // matching an empty string
    my $z = "\000"; $z =~ /$z/;
    # Initialize.
    openARGV();

script/s2p  view on Meta::CPAN

if( $GenKey{'l'} ){
    $Proto .= "sub _l();\n";
    $Func .= <<'[TheEnd]';
# _l: l command processing
#
sub _l(){
    my $h = $_;
    my $mcpl = 70;
    # transform non printing chars into escape notation
    $h =~ s/\\/\\\\/g;
    if( $h =~ /[^[:print:]]/ ){

script/s2p  view on Meta::CPAN

if( $GenKey{'r'} ){
    $Proto .= "sub _r(\$);\n";
    $Func .= <<'[TheEnd]';
# _r: r command processing: Save a reference to the pathname.
#
sub _r($){
    my $path = shift();
    push( @Q, \$path );
}

[TheEnd]

script/s2p  view on Meta::CPAN

if( $GenKey{'t'} ){
    $Proto .= "sub _t();\n";
    $Func .= <<'[TheEnd]';
# _t: t command - condition register test/reset
#
sub _t(){
    my $res = $CondReg;
    $CondReg = 0;
    $res;
}

script/s2p  view on Meta::CPAN

if( $GenKey{'w'} ){
    $Proto .= "sub _w(\$);\n";
    $Func .= <<'[TheEnd]';
# _w: w command and s command's w flag - write to file
#
sub _w($){
    my $path   = shift();
    my $handle = $wFiles{$path};
    if( ! $doOpenWrite && ! defined( fileno( $handle ) ) ){
	open( $handle, ">$path" )
	|| die( "$0: $path: cannot open ($!)\n" );

script/s2p  view on Meta::CPAN

TheEnd

    my $wf = "'" . join( "', '",  keys( %wFiles ) ) . "'";
    if( $wf ne "''" ){
	print <<TheEnd;
sub makeHandle(\$);
for my \$p ( $wf ){
   exit( 1 ) unless makeHandle( \$p );
}
TheEnd
   }

 view release on metacpan or  search on metacpan

lib/App/sh2p/Parser.pm  view on Meta::CPAN

use App::sh2p::Compound;
use App::sh2p::Trap;
use App::sh2p::Utils;

sub convert(\@\@);

our $VERSION = '0.06';
our $DEBUG   = 0;

###########################################################

 view release on metacpan or  search on metacpan

script/skos2jskos  view on Meta::CPAN

## Logging methods
use Term::ANSIColor;
my $colored = -t STDOUT;    ## no critic

sub error($) {              ## no critic
    say STDERR ( $colored ? colored( $_[0], 'red' ) : $_[0] );
}

sub fatal($) {              ## no critic
    error $_[0];
    exit 1;
}

sub warning($) {            ## no critic
    say STDERR ( $colored ? colored( $_[0], 'yellow' ) : $_[0] );
}

sub info($) {               ## no critic
    return if $opt{quiet};
    say( $colored ? colored( $_[0], 'green' ) : $_[0] );
}

sub debug($) {              ## no critic
    return unless $opt{verbose};
    say( $colored ? colored( $_[0], 'white' ) : $_[0] );
}

sub trace($) {              ## no critic
    return unless $opt{verbose} > 1;
    say $_[0];
}

## check where to get RDF data from

 view release on metacpan or  search on metacpan

scripts/t1generate  view on Meta::CPAN

       $s2 += $x ** 2 ; 
       print "$x\n" ; 
   }
}

sub SecondInfo( ) {   #  処理したことについての二次情報を出力
    use FindBin qw [ $Script ] ; 
    print STDERR 
       CYAN "[$Script] " , 
       CYAN "random numbers generated = ", BRIGHT_CYAN $o{g} ,
       CYAN ", sum = " , BRIGHT_CYAN  sprintf("%g", $s1 ) ,

 view release on metacpan or  search on metacpan

scripts/t2generate  view on Meta::CPAN

       $s2 += $x ** 2 ; 
       print "$x\n" ; 
   }
}

sub SecondInfo( ) {   #  処理したことについての二次情報を出力
    use FindBin qw [ $Script ] ; 
    my $t = $o{a} ? ' -a' : '' ;
    print STDERR 
       CYAN "[$Script$t] " , 
       CYAN "random numbers generated = ", BRIGHT_CYAN $o{g} ,

 view release on metacpan or  search on metacpan

lib/App/whatthecommit.pm  view on Meta::CPAN

our @EXPORT_OK = qw(goodie);
our $VERSION   = '0.02';
our $HOOK
    = 'echo $(curl -L http://whatthecommit.com/ 2>/dev/null | grep -Po \'(?<=\<p\>).*$\') > "$1"';

sub goodie($) {
    my $git                = shift;
    my $prepare_commit_msg = $git . "/.git/hooks/prepare-commit-msg";
    open my $REPO, ">$prepare_commit_msg"
        or die( print "Cannot open $prepare_commit_msg\n" );
    print $REPO $HOOK;

 view release on metacpan or  search on metacpan

lib/App/wmiirc/Backlight.pm  view on Meta::CPAN

# So on my vaio the down works here, but up doesn't(?!), I've hacked it into the
# acpi stuff instead -- urgh. Serves me right for buying proprietary Sony stuff
# I guess.

sub key_backlight_down(XF86MonBrightnessDown) {
  system qw(xbacklight -steps 1 -time 0 -dec 10);
}

sub key_backlight_up(XF86MonBrightnessUp) {
  system qw(xbacklight -steps 1 -time 0 -inc 10);
}

1;

 view release on metacpan or  search on metacpan

t/01-options.t  view on Meta::CPAN

binmode STDOUT, ':utf8';
binmode STDERR, ':utf8';

use Test::More tests => 90;

sub is_fuzzy($$$);

my $PERL= $^X;
my $OS  = $^O;
my $WIN = $OS =~ m{^MSWin} ? 1 : 0;

t/01-options.t  view on Meta::CPAN

  { my $command= join( ' ', @_);
    if( grep /-v/, $ARGV[0]) { warn "$command\n"; }
    return `$command`;
  }

sub is_fuzzy($$$)
  { my( $got, $expected, $message)= @_;
    (my $stripped_expected= $expected)=~ s{\s}{}g;
    (my $stripped_got= $got)=~ s{\s}{}g;
    if( $stripped_got eq $stripped_expected)
      { ok( 1, $message); }

 view release on metacpan or  search on metacpan

lib/App/ygeo.pm  view on Meta::CPAN

    }

    return $result_flag;
}

sub _isin($$) {
    my ( $val, $array_ref ) = @_;

    return 0 unless $array_ref && defined $val;
    for my $v (@$array_ref) {
        return 1 if $v eq $val;