view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

		if ( my $code = $sym->{$pwd} ) {
			# Delegate back to parent dirs
			goto &$code unless $cwd eq $pwd;
		}
		unless ($$sym =~ s/([^:]+)$//) {
			# XXX: it looks like we can't retrieve the missing function
			# via $$sym (usually $main::AUTOLOAD) in this case.
			# I'm still wondering if we should slurp Makefile.PL to
			# get some context or not ...
			my ($package, $file, $line) = caller;
			die <<"EOT";

 view release on metacpan or  search on metacpan

lib/Apache2_4/AuthCookieMultiDBI.pm  view on Meta::CPAN

    my $auth_name = $r->auth_name;

    my $session_key;

    # Check that this looks like an encrypted hex-encoded string.
    if ( $encrypted_session_key !~ HEX_STRING_REGEX ) {
        my $message = "${self}\tencrypted session key '$encrypted_session_key' doesn't look like it's properly hex-encoded for auth realm $auth_name";
        $r->server->log_error( $message );
        return;
    }

 view release on metacpan or  search on metacpan

doc/README.upgrading_0.5x-0.6x  view on Meta::CPAN

   Half of the data keyed on URL was wrong, and the other half was
   fairly useless, so it is no longer returned at all.

   The fix:
   - remove all references to URLs in the regression hash, e.g.
     anything that looks like $re->{'run0'}->{'http://test.url/'}

5) What was stored in the 'threads' array reference (for each run),
   is now in the top-level of the regression hash for each run.
   The term threads was confusing, especially considering an upcoming
   rewrite will probably include multi-threaded request sending.

 view release on metacpan or  search on metacpan

Mysql.pm  view on Meta::CPAN

This module supplies a persistent database connection to Mysql. You will need to have mysqlperl installed on your system. You should really use Apache::DBI instead of this module (this module was written when DBI::Mysql had problems, which have since...

This is the first version of the first module I have ever written, so expect errors! Any feedback or suggestions are gratefully received.

All you really need is to replace Mysql with Apache::Mysql. 
When connecting to a database the module looks if a database 
handle from a previous connect request is already stored. If 
not, a new connection is established and the handle is stored 
for later re-use. The destroy method has been intentionally 
left empty. 

 view release on metacpan or  search on metacpan

1234567891  view on Meta::CPAN

#!/usr/bin/perl 
use 5.014 ; use warnings ; 
use Getopt::Std ; getopts 'd:f' , \my %o  ; 
use FindBin qw[ $Script ] ; 
use utf8 ; 
use Scalar::Util qw[ looks_like_number ] ; 
 
$ARGV[0] //= 20 ;
$o{d} //= 1 ;
my $bk = ( $o{f} ? '　' :' ' ) x $o{d} ; # 空白文字を $o{d}個連結する。 全角空白と半角空白を左に書いた。
my ($n1,$n2) = $ARGV[0] =~ m/(\d+)-(\d+)/ ? ($1,$2) : exists $ARGV[1] ? @ARGV : (1,$ARGV[0]) ; 
exit if map {say "'$_' seems not a number."} grep { ! looks_like_number $_ } ($n1,$n2) ;

my $out = '' ; 
for ( $n1 .. $n2 ) { 
  my $c = s/0{$o{d},}$//ro =~ s/^$/0/ro ; # 文末の1個以上の0を除去して、もしも全部消えたら0にする。
  $c = substr $bk . $c , -$o{d} , $o{d} ; 

 view release on metacpan or  search on metacpan

12567834  view on Meta::CPAN

use Getopt::Std ; getopts ',c:2:b:p' , \my %o  ; 
use Term::ANSIColor qw[ color :constants ] ; $Term::ANSIColor::AUTORESET = 1 ;
use FindBin qw[ $Script ] ; 
use List::Util qw[ min max uniq ] ; 
use utf8 ; 
use Scalar::Util qw[ looks_like_number ] ; 

no warnings ; 
* d3 = sub { $_[0] =~ s/(?<=\d)(?=(\d\d\d)+($|\D))/,/gr } ;
use warnings ; 

12567834  view on Meta::CPAN

my $p2 ; # 元のPDFファイルの最後のページ番号
my $p2a ; # $p2+1 以下の、 $p2a - $p1 が4の倍数となる最大の数。

# コマンド引数から、与え方に応じて3通りに、ページ数の最初と最後を取り出す。
($p1,$p2) = $ARGV[0] =~ m/(.*)(-|\.\.)(.*)/ ? ($1,$3) : exists $ARGV[1] ? @ARGV : (1,$ARGV[0]) ; 
exit if map {say "'$_' seems not a numbper."} grep { ! looks_like_number $_ } ($p1,$p2) ;
exit if  $p1 > $p2 && say "'$p1 <= $p2' does not hold." ;


 
# 最後に出力する紙の処理 および 出力枚数の算出

 view release on metacpan or  search on metacpan

lib/App/AFNI/SiemensPhysio.pm  view on Meta::CPAN

Get slice based respiration volume per time (RVT) regressors from physio collected on Siemens scanner

  my $p = SiemensPhysio->new({VERB=>1});
  # read MR data (get times, TR, nslices)
  #  looks at all files in this directory with "dicom_hinfo"
  $p->readMRdir('MRRaw/10824_20111108/rest_384x384.21/');

  # read pulse
  $p->readPhysio('10824/20111108/wpc4951_10824_20111108_110811.puls');
  # write card: $protocol_$sessionTime.puls.dat

 view release on metacpan or  search on metacpan

script/_acme-cpanauthors  view on Meta::CPAN

#
#=head2 COMPLETE_BASH_SUMMARY_ALIGN
#
#String. Either C<left> (the default) or C<right>.
#
#The C<left> align looks something like this:
#
# --bar      Summary about the bar option
# --baz      Summary about the baz option
# --foo      Summary about the foo option
# --schapen  Summary about the schapen option

script/_acme-cpanauthors  view on Meta::CPAN

#    for (@_) {
#        my $ref = ref($_);
#        if ($ref eq 'ARRAY') { $prev = $_ }
#        elsif ($ref eq 'HASH') { $meta = $_ }
#        elsif (!$ref) {
#            if (Scalar::Util::looks_like_number($_)) {
#                $status = $_;
#            } else {
#                $msg = $_;
#            }
#        }

 view release on metacpan or  search on metacpan

lib/App/Addex/Plugin/Nobody.pm  view on Meta::CPAN

# ABSTRACT: automatically add a recipient that goes nowhere

#pod =head1 DESCRIPTION
#pod
#pod The only valid "To" header that doesn't imply delivery somewhere
#pod looks something like this:
#pod
#pod   To: undisclosed-recipients: ;
#pod
#pod This plugin adds a virtual entry to your address book with that address.
#pod

lib/App/Addex/Plugin/Nobody.pm  view on Meta::CPAN

version 0.006

=head1 DESCRIPTION

The only valid "To" header that doesn't imply delivery somewhere
looks something like this:

  To: undisclosed-recipients: ;

This plugin adds a virtual entry to your address book with that address.

 view release on metacpan or  search on metacpan

lib/App/Addex/Output/Mutt.pm  view on Meta::CPAN

#pod and name.  Every other address will be aliased to one of those with an
#pod appended, incrementing counter.  The entry's name is added as the alias's "real
#pod name."
#pod
#pod If the entry has a "folder" value (given as a line in the card's "notes" that
#pod looks like "folder: value") a save-hook is created to save mail from the entry
#pod to that folder and a mailboxes line is created for the folder.  If the entry
#pod has a "sig" value, a send-hook is created to use that signature when composing
#pod a message to the entry.
#pod
#pod =head1 CONFIGURATION

lib/App/Addex/Output/Mutt.pm  view on Meta::CPAN

and name.  Every other address will be aliased to one of those with an
appended, incrementing counter.  The entry's name is added as the alias's "real
name."

If the entry has a "folder" value (given as a line in the card's "notes" that
looks like "folder: value") a save-hook is created to save mail from the entry
to that folder and a mailboxes line is created for the folder.  If the entry
has a "sig" value, a send-hook is created to use that signature when composing
a message to the entry.

=head1 PERL VERSION SUPPORT

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

		if ( my $code = $sym->{$pwd} ) {
			# Delegate back to parent dirs
			goto &$code unless $cwd eq $pwd;
		}
		unless ($$sym =~ s/([^:]+)$//) {
			# XXX: it looks like we can't retrieve the missing function
			# via $$sym (usually $main::AUTOLOAD) in this case.
			# I'm still wondering if we should slurp Makefile.PL to
			# get some context or not ...
			my ($package, $file, $line) = caller;
			die <<"EOT";

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

		if ( my $code = $sym->{$pwd} ) {
			# Delegate back to parent dirs
			goto &$code unless $cwd eq $pwd;
		}
		unless ($$sym =~ s/([^:]+)$//) {
			# XXX: it looks like we can't retrieve the missing function
			# via $$sym (usually $main::AUTOLOAD) in this case.
			# I'm still wondering if we should slurp Makefile.PL to
			# get some context or not ...
			my ($package, $file, $line) = caller;
			die <<"EOT";

 view release on metacpan or  search on metacpan

lib/App/ArduinoBuilder/System.pm  view on Meta::CPAN

sub execute_cmd {
  my ($cmd, %options) = @_;
  trace $cmd;
  if ($^O eq 'MSWin32') {
    # This fix cases where the command looks like: foo '--bar="baz"'
    #
    # TODO: Possibly we could just split the command using split_cmd
    # and then pass the list to system (and find something for the `` case).
    $cmd = quote_native(split_cmd($cmd));
  }

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

		if ( my $code = $sym->{$pwd} ) {
			# Delegate back to parent dirs
			goto &$code unless $cwd eq $pwd;
		}
		unless ($$sym =~ s/([^:]+)$//) {
			# XXX: it looks like we can't retrieve the missing function
			# via $$sym (usually $main::AUTOLOAD) in this case.
			# I'm still wondering if we should slurp Makefile.PL to
			# get some context or not ...
			my ($package, $file, $line) = caller;
			die <<"EOT";

 view release on metacpan or  search on metacpan

lib/App/BCVI/Plugins.pod  view on Meta::CPAN

  App::BCVI->register_installable();

=head1 COMMAND HANDLERS

When the listener receives a command it looks up the registered commands to
locate a handler method and then calls that method (with no arguments).

If the handler method expects a list of filenames, it can get them by calling:

  $self->get_filenames()

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

		if ( my $code = $sym->{$pwd} ) {
			# Delegate back to parent dirs
			goto &$code unless $cwd eq $pwd;
		}
		unless ($$sym =~ s/([^:]+)$//) {
			# XXX: it looks like we can't retrieve the missing function
			# via $$sym (usually $main::AUTOLOAD) in this case.
			# I'm still wondering if we should slurp Makefile.PL to
			# get some context or not ...
			my ($package, $file, $line) = caller;
			die <<"EOT";

 view release on metacpan or  search on metacpan

lib/App/Basis/Queue.pm  view on Meta::CPAN

            "this does not look like a datetime value I can use: '$params->{before}'"
        ) ;
        $params->{before} = _parse_datetime( time() ) ;
    } ;

# TODO: add in expired items too, plus the and processed=1 or process_failure =1 looks a bit wrong
    my $sql = "WHERE queue_name LIKE ?
        AND processed = 1
        OR process_failure = 1
        AND msg_type = ?
        AND added <= ?" ;

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

		if ( my $code = $sym->{$pwd} ) {
			# Delegate back to parent dirs
			goto &$code unless $cwd eq $pwd;
		}
		unless ($$sym =~ s/([^:]+)$//) {
			# XXX: it looks like we can't retrieve the missing function
			# via $$sym (usually $main::AUTOLOAD) in this case.
			# I'm still wondering if we should slurp Makefile.PL to
			# get some context or not ...
			my ($package, $file, $line) = caller;
			die <<"EOT";

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

		if ( my $code = $sym->{$pwd} ) {
			# Delegate back to parent dirs
			goto &$code unless $cwd eq $pwd;
		}
		unless ($$sym =~ s/([^:]+)$//) {
			# XXX: it looks like we can't retrieve the missing function
			# via $$sym (usually $main::AUTOLOAD) in this case.
			# I'm still wondering if we should slurp Makefile.PL to
			# get some context or not ...
			my ($package, $file, $line) = caller;
			die <<"EOT";

 view release on metacpan or  search on metacpan

colsummary  view on Meta::CPAN

use Encode qw[ decode_utf8 encode_utf8 ] ; 
use FindBin qw [ $Script ] ; 
use Getopt::Std ; getopts 'R:g:i:jl:m:suz=!@:#:0:2:' => \my %o ;
use List::Util qw/max min maxstr minstr/ ; 
use POSIX qw/strtod/;
use Scalar::Util qw/looks_like_number/;
use Term::ANSIColor qw/:constants color/ ; $Term::ANSIColor::AUTORESET = 1 ; 
use Time::HiRes qw [ gettimeofday tv_interval ] ; my ${ dt_start } = [ gettimeofday ] ; 

my $sdt = sprintf '%04d-%02d-%02d %02d:%02d:%02d', do{my @t= @{[localtime]}[5,4,3,2,1,0]; $t[0]+=1900; $t[1]++; @t } ; 
eval "use PerlIO::gzip;1" or die "PerlIO::gzip cannot be loaded, so -z does not work. ($Script, $sdt)\n" if $o{z} ; 

colsummary  view on Meta::CPAN

# 配列参照から、最小値最大値を取り出す 
sub minmaxstr ( $ ) {
  sub part ( &@ ) ; 
  sub RangeStr ( $$ ) ;
  my @gps = part {$_ eq '' ? 0 : looks_like_number $_ ? 1 : 2}  @{ $_[0] } ; 
  my @ostr ; 
  push @ostr, '' if $gps[0] ;  # 空文字列があるときの処理  
  push @ostr, RangeStr( min(@{$gps[1]}), max(@{$gps[1]}) ) if $gps[1] ;  # 数に見える値があるときの処理 
  push @ostr, RangeStr( minstr(@{$gps[2]}), maxstr(@{$gps[2]}) ) if $gps[2] ; # 数に見えない値があるときの処理 
  return @ostr; 

 view release on metacpan or  search on metacpan

scripts/backcolor  view on Meta::CPAN

#!/usr/bin/perl
use 5.014 ; use strict ; use warnings ; 
use Getopt::Std ; getopts 'd:s' ,\my%o ; 
use FindBin qw [ $Script ] ; 
use Term::ANSIColor qw[ :constants color ] ; $Term::ANSIColor::AUTORESET = 1 ; 
use Scalar::Util qw[ looks_like_number ] ; 
use List::Util qw[ min max ] ; 

$o{d} //= 1 ; # 色を1段階上げるのに、数値がいくつ高い必要があるか。


while ( <> ) { 
	my @F = do { chomp ; split /\t/o, $_ , -1 } ; 
	for ( @F ) { 
		if ( looks_like_number ( $_ ) ) { 
			my $n = $o{s} ? sqrt ( $_ ) : $_ ;
			my $d = max 0, min 5, int $n / $o{d} ; 
			my $c = "on_rgb00$d" ;
			$_ = color ($c) . $_ . color ('reset') ; 
		}

 view release on metacpan or  search on metacpan

lib/App/BorgRestore/PathTimeTable/DB.pm  view on Meta::CPAN

	# reach a parent path (directory) of $path.
	$log->tracef("Checking if cache invalidation is required") if TRACE;
	while ((my $slash_index = rindex($old_cache_path, "/")) != -1) {
		$self->{stats}->{cache_invalidation_loop_iterations}++;
		# Directories in the borg output cannot be differentiated by their
		# path, since their path looks just like a file path. I.e. there is no
		# directory separator (/) at the end of a directory path.
		#
		# Since we want to keep any directory in our cache, if it contains
		# $path, we can treat any cached path as a directory path. If the
		# cached path was really a directory, the new $path will also contain a

 view release on metacpan or  search on metacpan

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

            my $prog = $p->{exec} || $p->{cmndline};

            # in some OS like linux the binary is firefox-bin or firefox-esr,
            # while in some other like FreeBSD, it's firefox.
            do { $p->{_note} = "program is firefox binary"; goto FOUND } if $prog =~ m![/\\](firefox-bin|firefox-esr|firefox)(\z|\s)!;
            do { $p->{_note} = "fname looks like firefox"; goto FOUND } if $p->{fname} =~ /\A(Web Content|WebExtensions|firefox-bin|firefox-esr|firefox)\z/;
            goto NOT_FOUND;
          FOUND:
            log_trace "Found firefox process (PID=%d, prog (exec|cmndline)=%s, note=%s)", $p->{pid}, $prog, $p->{_note};
            return 1;
          NOT_FOUND:

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

        },
    },
    chrome => {
        filter => sub {
            my $p = shift;
            do { $p->{_note} = "fname looks like chrome"; goto FOUND } if $p->{fname} =~ /\A(chrome)\z/;
            goto NOT_FOUND;
          FOUND:
            log_trace "Found chrome process (PID=%d, cmdline=%s, note=%s)", $p->{pid}, $p->{cmndline}, $p->{_note};
            return 1;
          NOT_FOUND:

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

        },
    },
    opera => {
        filter => sub {
            my $p = shift;
            do { $p->{_note} = "fname looks like opera"; goto FOUND } if $p->{fname} =~ /\A(opera)\z/;
            goto NOT_FOUND;
          FOUND:
            log_trace "Found opera process (PID=%d, cmdline=%s, note=%s)", $p->{pid}, $p->{cmndline}, $p->{_note};
            return 1;
          NOT_FOUND:

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

        },
    },
    vivaldi => {
        filter => sub {
            my $p = shift;
            do { $p->{_note} = "fname looks like vivaldi"; goto FOUND } if $p->{fname} =~ /\A(vivaldi-bin)\z/;
            goto NOT_FOUND;
          FOUND:
            log_trace "Found vivaldi process (PID=%d, cmdline=%s, note=%s)", $p->{pid}, $p->{cmndline}, $p->{_note};
            return 1;
          NOT_FOUND:

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

        },
    },
    brave => {
        filter => sub {
            my $p = shift;
            do { $p->{_note} = "fname looks like brave"; goto FOUND } if $p->{fname} =~ /\A(brave)\z/;
            goto NOT_FOUND;
          FOUND:
            log_trace "Found brave process (PID=%d, cmdline=%s, note=%s)", $p->{pid}, $p->{cmndline}, $p->{_note};
            return 1;
          NOT_FOUND:

 view release on metacpan or  search on metacpan

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

    my $localdir = File::Spec->catdir( $blib, $type );
    next unless -e $localdir;

    if (my $dest = $self->install_destination($type)) {
      # thins alters the behavious of Module::Build, and
      # looks into the implementation
      if (   $self->install_path($type)
          && !File::Spec->file_name_is_absolute($dest)) {
        $dest = File::Spec->catdir( $self->_prefix, $dest );
      }
      $map{$localdir} = $dest;

 view release on metacpan or  search on metacpan

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

    my $self = shift;
    $self->{deps} = shift if @_;
    return $self->{deps};
}

# given a META.yml file (if no arguments, looks for a META.yml in the current
# directory), does the proper dep bundling
sub bundle_from_meta {
    my ($self, $file) = @_;
    $file ||= 'META.yml';

 view release on metacpan or  search on metacpan

lib/App/CELL/Guide.pm  view on Meta::CPAN

meta parameter's value any number of times, and L<App::CELL> will not care.
Initial C<meta> param settings are placed in a file entitled
C<$str_MetaConfig.pm> (where C<$str> is a string free of underscore
characters) in the sitedir. For example, if the application name is FooApp, its
initial C<meta> parameter settings could be contained in a file called
C<FooApp_MetaConfig.pm>. At initialization time, L<App::CELL> looks in
the sitedir for files matching this description, and attempts to load them.
(See L</How configuration files are named>.)

=head4 Core parameters

lib/App/CELL/Guide.pm  view on Meta::CPAN

is loaded and OK is returned. If a C<sitedir> argument is present but
invalid, an ERR status results. If no C<sitedir> argument was given, CELL
continues to the next step.

=item C<enviro> parameter -- 
if no C<sitedir> parameter is given, C<< $CELL->load >> looks for a
parameter called C<enviro> which it interprets as the name of an
environment variable containing the sitedir path.  If the C<enviro>
argument points to a valid sitedir, it is loaded and OK is returned. If an
C<enviro> argument is present but invalid, an ERR status results. If there
is no C<enviro> argument at all, CELL continues to the next step.

lib/App/CELL/Guide.pm  view on Meta::CPAN

regular expression for message files is:

    ^.+_Message(_[^_]+){0,1}.conf$

In less-precise human terms, this means that the initialization routine
looks for filenames consisting of at least three, but possibly four,
components:

=over

=item 1. the application name (this can be anything)

lib/App/CELL/Guide.pm  view on Meta::CPAN

C<.conf> -- this is stored in the C<language> attribute of the message
object.)

No sanity checks are conducted on the language tag. Whatever string
the regular expression produces becomes the language tag for all
messages in that file. If no language tag is found, CELL first looks for a
config parameter called C<CELL_DEFAULT_LANGUAGE> and, failing that, the
hard-coded fallback value is C<en>.

I'll repeat that, since it's important: CELL assumes that the message
file names contain the relevant language tag. If the message

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

		if ( my $code = $sym->{$pwd} ) {
			# Delegate back to parent dirs
			goto &$code unless $cwd eq $pwd;
		}
		unless ($$sym =~ s/([^:]+)$//) {
			# XXX: it looks like we can't retrieve the missing function
			# via $$sym (usually $main::AUTOLOAD) in this case.
			# I'm still wondering if we should slurp Makefile.PL to
			# get some context or not ...
			my ($package, $file, $line) = caller;
			die <<"EOT";

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

		if ( my $code = $sym->{$pwd} ) {
			# Delegate back to parent dirs
			goto &$code unless $cwd eq $pwd;
		}
		unless ($$sym =~ s/([^:]+)$//) {
			# XXX: it looks like we can't retrieve the missing function
			# via $$sym (usually $main::AUTOLOAD) in this case.
			# I'm still wondering if we should slurp Makefile.PL to
			# get some context or not ...
			my ($package, $file, $line) = caller;
			die <<"EOT";

 view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

		if ( my $code = $sym->{$pwd} ) {
			# Delegate back to parent dirs
			goto &$code unless $cwd eq $pwd;
		}
		unless ($$sym =~ s/([^:]+)$//) {
			# XXX: it looks like we can't retrieve the missing function
			# via $$sym (usually $main::AUTOLOAD) in this case.
			# I'm still wondering if we should slurp Makefile.PL to
			# get some context or not ...
			my ($package, $file, $line) = caller;
			die <<"EOT";

 view release on metacpan or  search on metacpan

lib/App/CPAN/Mini/Visit.pm  view on Meta::CPAN

        if ( $config{local} ) {
            $opt->merge_defaults( { minicpan => $config{local} } );
        }
    }

    # confirm minicpan directory that looks like minicpan
    return _exit_no_minicpan() if !$opt->get_minicpan;
    return _exit_bad_minicpan( $opt->get_minicpan ) if !-d $opt->get_minicpan;

    my $id_dir = dir( $opt->get_minicpan, qw/authors id/ );
    return _exit_bad_minicpan( $opt->get_minicpan ) if !-d $id_dir;