^sub \w+\( results from the CPAN

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

#line 476

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

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

view all matches for this distribution

Bolts

1 match

            },
        )
    );
}

sub contains(&;$) {
    my ($parent_meta, $code, $such_that_each) = @_;

    my $meta = _bag_meta($parent_meta);

    return sub {

        return $bag_meta;
    };
}


sub such_that_each($) {
    my ($meta, $params) = @_;
    return $params;
}


sub builder(&) {
    my ($meta, $code) = @_;
    $meta = _bag_meta($meta);

    return {
        blueprint => $meta->acquire('blueprint', 'built_injector', {

        }),
    };
}


sub dep($) {
    my ($meta, $path) = @_;
    $meta = _bag_meta($meta);

    $path = [ $path ] unless ref $path eq 'ARRAY';

        }),
    };
}


sub option($) {
    my ($meta, $p) = @_;

    my %bp = %$p;
    my %ip;
    for my $k (qw( isa does )) {

        blueprint => $meta->acquire('blueprint', 'given', \%bp),
    },
}


sub value($) {
    my ($meta, $value) = @_;

    return {
        blueprint => $meta->acquire('blueprint', 'literal', {
            value => $value,
        }),
    };
}


sub self() {
    my ($meta, $value) = @_;

    return {
        blueprint => $meta->acquire('blueprint', 'parent_bag'),
    };

view all matches for this distribution

Bot-Backbone

3 results

lib/Bot/Backbone.pm view on Meta::CPAN


    Class::Load::load_class($class_name);
    return $class_name;
}

sub send_policy($%) {
    my ($meta, $name, @config) = @_;

    my @final_config;
    while (my ($class_name, $policy_config) = splice @config, 0, 2) {
        $class_name = _resolve_class_name($meta, 'SendPolicy', $class_name);

lib/Bot/Backbone.pm view on Meta::CPAN


    $meta->add_send_policy($name, \@final_config);
}


sub service($%) {
    my ($meta, $name, %config) = @_;

    my $class_name = _resolve_class_name($meta, 'Service', $config{service});
    $config{service} = $class_name;

lib/Bot/Backbone.pm view on Meta::CPAN

           and $service_meta->has_bot_roles;
    }
}


sub dispatcher($$) {
    my ($meta, $name, $code) = @_;

    my $dispatcher = Bot::Backbone::Dispatcher->new;
    {
        $meta->building_dispatcher($dispatcher);

view all matches for this distribution

Bot-BasicBot-Pluggable-Module-Collection

2 results

    $default_object ||= $default_class->new;
    return $default_object;
}

my $import_called = 0;
sub import() {
    $import_called = 1;
    my $class = (grep /^-base$/i, @_) 
    ? scalar(caller)
    : $_[0];
    if (not defined $default_class) {

        $caller =~ s/.*:://;
        croak "Too late to call $caller()"
    }
}

sub find_my_self() {
    my $self = ref($_[0]) eq $default_class
    ? splice(@_, 0, 1)
    : default_object();
    return $self, @_;
}

sub blocks() {
    (my ($self), @_) = find_my_self(@_);

    croak "Invalid arguments passed to 'blocks'"
      if @_ > 1;
    croak sprintf("'%s' is invalid argument to blocks()", shift(@_))

    }

    return (@blocks);
}

sub next_block() {
    (my ($self), @_) = find_my_self(@_);
    my $list = $self->_next_list;
    if (@$list == 0) {
        $list = [@{$self->block_list}, undef];
        $self->_next_list($list);

        $block->run_filters;
    }
    return $block;
}

sub first_block() {
    (my ($self), @_) = find_my_self(@_);
    $self->_next_list([]);
    $self->next_block;
}

sub filters_delay() {
    (my ($self), @_) = find_my_self(@_);
    $self->_filters_delay(defined $_[0] ? shift : 1);
}

sub no_diag_on_only() {
    (my ($self), @_) = find_my_self(@_);
    $self->_no_diag_on_only(defined $_[0] ? shift : 1);
}

sub delimiters() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    my ($block_delimiter, $data_delimiter) = @_;
    $block_delimiter ||= $self->block_delim_default;
    $data_delimiter ||= $self->data_delim_default;
    $self->block_delim($block_delimiter);
    $self->data_delim($data_delimiter);
    return $self;
}

sub spec_file() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    $self->_spec_file(shift);
    return $self;
}

sub spec_string() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    $self->_spec_string(shift);
    return $self;
}

sub filters() {
    (my ($self), @_) = find_my_self(@_);
    if (ref($_[0]) eq 'HASH') {
        $self->_filters_map(shift);
    }
    else {

        push @$filters, @_;
    }
    return $self;
}

sub filter_arguments() {
    $Test::Base::Filter::arguments;
}

sub have_text_diff {
    eval { require Text::Diff; 1 } &&
        $Text::Diff::VERSION >= 0.35 &&
        $Algorithm::Diff::VERSION >= 1.15;
}

sub is($$;$) {
    (my ($self), @_) = find_my_self(@_);
    my ($actual, $expected, $name) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    if ($ENV{TEST_SHOW_NO_DIFFS} or
         not defined $actual or

        ok $actual eq $expected,
           $name . "\n" . Text::Diff::diff(\$expected, \$actual);
    }
}

sub run(&;$) {
    (my ($self), @_) = find_my_self(@_);
    my $callback = shift;
    for my $block (@{$self->block_list}) {
        $block->run_filters unless $block->is_filtered;
        &{$callback}($block);


sub END {
    run_compare() unless $Have_Plan or $DIED or not $import_called;
}

sub run_compare() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    for my $block (@{$self->block_list}) {

            is($block->$x, $block->$y, $block->name ? $block->name : ());
        }
    }
}

sub run_is() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    for my $block (@{$self->block_list}) {

           $block->name ? $block->name : ()
          );
    }
}

sub run_is_deeply() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and exists($block->{$y});

           $block->name ? $block->name : ()
          );
    }
}

sub run_like() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and defined($y);

             $block->name ? $block->name : ()
            );
    }
}

sub run_unlike() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and defined($y);

        };
    }
    return $spec;
}

sub _strict_warnings() {
    require Filter::Util::Call;
    my $done = 0;
    Filter::Util::Call::filter_add(
        sub {
            return 0 if $done;

            $done = 1;
        }
    );
}

sub tie_output() {
    my $handle = shift;
    die "No buffer to tie" unless @_;
    tie $handle, 'Test::Base::Handle', $_[0];
}

    $ENV{TEST_SHOW_NO_DIFFS} = 1;
}

package Test::Base::Handle;

sub TIEHANDLE() {
    my $class = shift;
    bless \ $_[0], $class;
}

sub PRINT {


sub AUTOLOAD {
    return;
}

sub block_accessor() {
    my $accessor = shift;
    no strict 'refs';
    return if defined &$accessor;
    *$accessor = sub {
        my $self = shift;

view all matches for this distribution

Bot-BasicBot-Pluggable-Module-Gitbot

1 match

t/01-the-tests.t view on Meta::CPAN

        "repo_root is now: '$path'",
        '"!git repo_root <path>" converts relative paths to abs paths'
    );
}

sub _abbreviate($) { substr shift, 0, 7 }

sub _make_git_repo_with_n_commits($$$)
{
    my ($repo_dir, $repo_name, $n_commits) = @_;
    $repo_dir->mkdir($repo_name);
    my $repo_path = File::Spec->rel2abs(File::Spec->catdir($repo_dir, $repo_name));

view all matches for this distribution

Bot-BasicBot-Pluggable-WithConfig

2 results

    $default_object ||= $default_class->new;
    return $default_object;
}

my $import_called = 0;
sub import() {
    $import_called = 1;
    my $class = (grep /^-base$/i, @_) 
    ? scalar(caller)
    : $_[0];
    if (not defined $default_class) {

        $caller =~ s/.*:://;
        croak "Too late to call $caller()"
    }
}

sub find_my_self() {
    my $self = ref($_[0]) eq $default_class
    ? splice(@_, 0, 1)
    : default_object();
    return $self, @_;
}

sub blocks() {
    (my ($self), @_) = find_my_self(@_);

    croak "Invalid arguments passed to 'blocks'"
      if @_ > 1;
    croak sprintf("'%s' is invalid argument to blocks()", shift(@_))

    }

    return (@blocks);
}

sub next_block() {
    (my ($self), @_) = find_my_self(@_);
    my $list = $self->_next_list;
    if (@$list == 0) {
        $list = [@{$self->block_list}, undef];
        $self->_next_list($list);

        $block->run_filters;
    }
    return $block;
}

sub first_block() {
    (my ($self), @_) = find_my_self(@_);
    $self->_next_list([]);
    $self->next_block;
}

sub filters_delay() {
    (my ($self), @_) = find_my_self(@_);
    $self->_filters_delay(defined $_[0] ? shift : 1);
}

sub no_diag_on_only() {
    (my ($self), @_) = find_my_self(@_);
    $self->_no_diag_on_only(defined $_[0] ? shift : 1);
}

sub delimiters() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    my ($block_delimiter, $data_delimiter) = @_;
    $block_delimiter ||= $self->block_delim_default;
    $data_delimiter ||= $self->data_delim_default;
    $self->block_delim($block_delimiter);
    $self->data_delim($data_delimiter);
    return $self;
}

sub spec_file() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    $self->_spec_file(shift);
    return $self;
}

sub spec_string() {
    (my ($self), @_) = find_my_self(@_);
    $self->check_late;
    $self->_spec_string(shift);
    return $self;
}

sub filters() {
    (my ($self), @_) = find_my_self(@_);
    if (ref($_[0]) eq 'HASH') {
        $self->_filters_map(shift);
    }
    else {

        push @$filters, @_;
    }
    return $self;
}

sub filter_arguments() {
    $Test::Base::Filter::arguments;
}

sub have_text_diff {
    eval { require Text::Diff; 1 } &&
        $Text::Diff::VERSION >= 0.35 &&
        $Algorithm::Diff::VERSION >= 1.15;
}

sub is($$;$) {
    (my ($self), @_) = find_my_self(@_);
    my ($actual, $expected, $name) = @_;
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    if ($ENV{TEST_SHOW_NO_DIFFS} or
         not defined $actual or

        ok $actual eq $expected,
           $name . "\n" . Text::Diff::diff(\$expected, \$actual);
    }
}

sub run(&;$) {
    (my ($self), @_) = find_my_self(@_);
    my $callback = shift;
    for my $block (@{$self->block_list}) {
        $block->run_filters unless $block->is_filtered;
        &{$callback}($block);


sub END {
    run_compare() unless $Have_Plan or $DIED or not $import_called;
}

sub run_compare() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    for my $block (@{$self->block_list}) {

            is($block->$x, $block->$y, $block->name ? $block->name : ());
        }
    }
}

sub run_is() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    for my $block (@{$self->block_list}) {

           $block->name ? $block->name : ()
          );
    }
}

sub run_is_deeply() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and exists($block->{$y});

           $block->name ? $block->name : ()
          );
    }
}

sub run_like() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and defined($y);

             $block->name ? $block->name : ()
            );
    }
}

sub run_unlike() {
    (my ($self), @_) = find_my_self(@_);
    $self->_assert_plan;
    my ($x, $y) = $self->_section_names(@_);
    for my $block (@{$self->block_list}) {
        next unless exists($block->{$x}) and defined($y);

        };
    }
    return $spec;
}

sub _strict_warnings() {
    require Filter::Util::Call;
    my $done = 0;
    Filter::Util::Call::filter_add(
        sub {
            return 0 if $done;

            $done = 1;
        }
    );
}

sub tie_output() {
    my $handle = shift;
    die "No buffer to tie" unless @_;
    tie $handle, 'Test::Base::Handle', $_[0];
}

    $ENV{TEST_SHOW_NO_DIFFS} = 1;
}

package Test::Base::Handle;

sub TIEHANDLE() {
    my $class = shift;
    bless \ $_[0], $class;
}

sub PRINT {


sub AUTOLOAD {
    return;
}

sub block_accessor() {
    my $accessor = shift;
    no strict 'refs';
    return if defined &$accessor;
    *$accessor = sub {
        my $self = shift;

view all matches for this distribution

Bot-Cobalt

1 match

lib/Bot/Cobalt/Plugin/Auth.pm view on Meta::CPAN


use File::Spec;


### Constants, mostly for internal retvals:
sub ACCESS_LIST() { 0 }
sub DB_PATH()     { 1 }


sub new {
  bless [
    +{}, ## ACCESS_LIST

view all matches for this distribution

Bot-Net

3 results

lib/Bot/Net/Bot.pm view on Meta::CPAN


You may choose to use it or not.

=cut

sub bot($) { 'bot_'.shift }

=head1 setup

This method is called to tell the bot to startup. It finds all the mixins that have been added into the class and calls the L</setup> method for each.

view all matches for this distribution

Bot-Telegram

1 match

t/lib/Bot/Telegram/Test.pm view on Meta::CPAN

  bot_api
};

my @UPDATES = qw/message edited_message edited_channel_post callback_query/;

sub timer(&$) { Mojo::IOLoop -> timer(pop, pop) } ## no critic

sub loop_for_a_second {
  timer { Mojo::IOLoop -> stop } 1;
  Mojo::IOLoop -> start;
}

t/lib/Bot/Telegram/Test.pm view on Meta::CPAN


    update_id => $id,
  };
}

sub json_response(;$) { ## no critic
  Mojo::Message::Response
    -> new
    -> body(encode_json shift);
}

view all matches for this distribution

Bread-Board

1 match

lib/Bread/Board.pm view on Meta::CPAN

    my $path = shift;
    Bread::Board::Dependency->new(service_path => $path);
}

my $LITERAL_ANON = 0;
sub literal($) {
    my $value = shift;
    Bread::Board::Literal->new(
        name => 'LITERAL_ANON_' . $LITERAL_ANON++,
        value => $value,
    );

view all matches for this distribution

Bricklayer-Templater

1 match

lib/Bricklayer/Templater/Sequencer.pm view on Meta::CPAN


=cut


# returns a string with the replacement text for the parsed token
sub return_parsed($$$$) {
    my $Self = shift;
    my $Env = shift;
    my $Parameters = shift;
    my $handler_loc = shift;

lib/Bricklayer/Templater/Sequencer.pm view on Meta::CPAN


actually runs through the list of tokens and loades the handler or retrieves it from the handler cache to run.

=cut

sub parse_tokens($$$$) {
    my $TokenList = shift;
    my $App = shift;
    my $Parameters = shift;
    my $handler_loc = shift;
    my $ParsedText;

view all matches for this distribution

BsDiPa

1 match

test.pl view on Meta::CPAN

#@ Automated test for S-bsdipa (make test).

#use Test::Simple tests => 1;
use Test2::API qw/context/;
our @EXPORT = qw/ok done_testing/;
sub ok($;$){
	my ($bool, $name) = @_;
	my $ctx = context();
	$ctx->ok($bool, $name);
	$ctx->release;
	return $bool

view all matches for this distribution

Bundle-PBib

2 results

lib/Biblio/Database.pm view on Meta::CPAN

	#  SuperTitle	Booktitle
	#  Source	URL
	#  Location	Address
	#  Howpublished	Howpublish
	#  );
sub quoteField($$;$) {
	my ($self, $field, $ignoreCase) = @_;
	my $mapping = $self->{'column-mapping'} || {};
	$field = $mapping->{$field} if exists($mapping->{$field});
	$field = "\"$field\"" if $self->{'quote-column-name'};
	$field = "lower($field)" if $ignoreCase

view all matches for this distribution

Bundle-Perl6

1 match

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

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

#line 423

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

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

view all matches for this distribution

Buscador

1 match

lib/Buscador.pm view on Meta::CPAN

use Buscador::Config;
Buscador->config->{cache_options}{class} = "Cache::FileCache";

use Maypole::Constants;
our $home;
sub debug() {0}

BEGIN { 
    require Email::Store;

    Email::Store->import(Buscador::Config->dsn, verbose => 1 );

view all matches for this distribution

Business-BankAccount-NZ

1 match

#
# Each digit is multiplied by a corresponding value in the @vals array
# and added to the total.  The total is then divided by 11.  If there
# is a remainer then the account number is invalid.
#
sub nab_account($) {
    my ($self) = @_;
    # Get account digits in an array
    my @acc = get_acc_array($self->{account_no});
    # Values by which to multiply the digits
    my @vals = (7, 6, 5, 4, 3, 2, 1);

# Each digit is multiplied by a corresponding value in the @vals array.
# If the result is more than 1 digit long then the digits are added together
# and that result is added to the total.  The total is then divided by 11.  If there
# is a remainer then the account number is invalid.
#
sub rb_account($) {
    my ($self) = @_;
    # Get the account number digits
    my @acc = get_acc_array($self->{account_no});
    # The suffix
    my $suff = $self->{suffix};

# value in the @vals or @vals2 arrays.  If the result is more than 1 digit long then 
# the digits are added together until the result is only 1 digit long, and that result 
# is added to the total.  The total is then divided by 10.  If there is a remainer 
# then the account number is invalid.
#
sub ub_account($) {
    my ($self) = @_;
    # Get the digits of the account number
    my @acc = get_acc_array($self->{account_no});
    # The suffix
    my $suff = $self->{suffix};

#
# Each digit is multiplied by a corresponding value in the @vals array 
# and the result is added to the total.  The total is then divided by 10.  If there
# is a remainer then the account number is invalid.
#
sub cwrb_account($) {
    my ($self) = @_;
    # The account number digits
    my @acc = get_acc_array($self->{account_no});
    # The suffix
    my $suff = $self->{suffix};

# total is then divided by 11.  If there is a remainer then the account number 
# is invalid.
#
# Banks include:
# 01, 02, 03, 06, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 27, 30 and 31
sub other_account($) {
    my ($self) = @_;
    # Get the account number digits
    my @acc = get_acc_array($self->{account_no});
    # Get the branch number digits
    my @branch = get_acc_array($self->{branch});

	return 0;
    }
}

# Return the account number as an array
sub get_acc_array($) {
    my ($acc_no) = @_;
    return split('', $acc_no);
}

# Multiply the two numbers together and add up any extra digits once.
sub multi_add($$) {
    my ($a, $b) = @_;
    my $prod = $a * $b;
    my $res = 0;
    my @nums = split('', $prod);

    return $res;
}

# Multiply the two numbers together and add up any extra digits
# until you have only one digit.
sub multi_add2($$) {
    my ($a, $b) = @_;
    my $prod = $a * $b;
    my $res = $prod;
    my @nums = split('', $prod);
    while($#nums >= 1) {

view all matches for this distribution

Business-CAMT

2 results


my $urnbase = 'urn:iso:std:iso:20022:tech:xsd';
my $moddir  = Path::Class::File->new(__FILE__)->dir;
my $xsddir  = $moddir->subdir('CAMT', 'xsd');
my $tagdir  = $moddir->subdir('CAMT', 'tags');
sub _rootElement($) { pack_type $_[1], 'Document' }  # $ns parameter

# The XSD filename is like camt.052.001.12.xsd.  camt.052.001.* is
# expected to be incompatible with camt.052.002.*, but *.12.xsd can
# usually parse *.11.xsd
my %xsd_files;

# Translations from abbreviated XML tags to longer names, loaded on
# demand.
my $tagtable;


sub new(%)
{	my ($class, %args) = @_;
    (bless {}, $class)->init(\%args);
}

sub init($)
{	my ($self, $args) = @_;

	# Collect the names of all CAMT schemes in this distribution
	foreach my $f (grep !$_->is_dir && $_->basename =~ /\.xsd$/, $xsddir->children)
	{	$f->basename =~ /^camt\.([0-9]{3}\.[0-9]{3})\.([0-9]+)\.xsd$/ or panic $f;

    $self;
}

#-------------------------

sub schemas() { $_[0]->{RC_schemas} }

#-------------------------

sub read($%)
{	my ($self, $src, %args) = @_;

	my $dom
	  = ! ref $src ? XML::LibXML->load_xml($src =~ /\<.*\>/ ? (string => $src) : (location => $src))
	  : $src->isa('IO::Handle') || $src->isa('GLOB') ? XML::LibXML->load_xml(IO => $src)

		camt    => $self,
	);
}


sub fromHASH($%)
{	my ($self, $data, %args) = @_;
	my $type = $args{type} or panic;
	my ($set, $version) = $type =~ /^(?:camt\.)?([0-9]+\.[0-9]+)\.([0-9]+)$/
		or error __x"Unknown message type '{type}'", type => $type;

		camt    => $self,
	);
}


sub create($$%)
{	my ($self, $type, $data) = @_;
	my ($set, $version) = $type =~ /^(?:camt\.)?([0-9]+\.[0-9]+)\.([0-9]+)$/
		or error __x"Unknown message type '{type}'", type => $type;

	Business::CAMT::Message->create(

		camt    => $self,
	);
}


sub write($$%)
{	my ($self, $fn, $msg, %args) = @_;

	my $set      = $msg->set;
	my $versions = $xsd_files{$set}
		or error __x"Message set '{set}' is unsupported.", set => $set;

	$xml;
}

#-------------------------

sub _loadXsd($$)
{	my ($self, $set, $version) = @_;
	my $file = $xsd_files{$set}{$version};
	$self->{BC_loaded}{$file}++ or $self->schemas->importDefinitions($file);
}

my %msg_readers;
sub schemaReader($$$)
{	my ($self, $set, $version, $ns) = @_;
	my $r = $self->{BC_r} ||= {};
	return $r->{$ns} if $r->{$ns};

	$self->_loadXsd($set, $version);

		key_rewrite   => $self->{BC_long} ? $self->tag2fullnameTable : undef,
	);
}


sub schemaWriter($$$)
{	my ($self, $set, $version, $ns) = @_;
	my $w = $self->{BC_w} ||= {};
	return $w->{$ns} if $w->{$ns};

	$self->_loadXsd($set, $version);

	NEWER  => sub { (grep $_ >= $_[1], @{$_[2]})[0] },
	NEWEST => sub { _exact(@_) || ($_[1] <= $_[2][-1] ? $_[2][-1] : undef) },
	ANY    => sub { _exact(@_) || $_[2][-1] },
);

sub matchSchema($$%)
{	my ($self, $set, $version, %args) = @_;
	my $versions = $xsd_files{$set} or panic "Unknown set $set";

	my $ruler = $args{rule} ||= $self->{BC_rule};
	my $rule  = ref $ruler eq 'CODE' ? $ruler : $rules{$ruler}

	
	$rule->($set, $version, [ sort { $a <=> $b } keys %$versions ]);
}


sub knownVersions(;$)
{	my ($self, $set) = @_;
	my @s;
	foreach my $s ($set ? $set : sort keys %xsd_files)
	{	push @s, map "camt.$s.$_", sort {$a <=> $b} keys %{$xsd_files{$s}};
	}
	@s;
}


sub fullname2tagTable()
{	my $self = shift;
	$self->{BC_toAbbr} ||= +{ reverse %{$self->tag2fullnameTable} };
}


sub tag2fullnameTable()
{	my $self = shift;
	$self->{BC_toLong} ||= +{
		map split(/,/, $_, 2), grep !/,$/, $tagdir->file('index.csv')->slurp(chomp => 1)
	};
}

view all matches for this distribution

Business-OnlinePayment-InternetSecure

1 match

InternetSecure.pm view on Meta::CPAN

				VI => 'Visa',
			};


# Convenience functions to avoid undefs and escape products strings
sub _def($) { defined $_[0] ? $_[0] : '' }
sub _esc($) { local $_ = shift; tr/|:/ /s; tr/"`/'/s; return $_ }


sub set_defaults {
	my ($self) = @_;

view all matches for this distribution

Business-OnlinePayment-PPIPayMover

1 match

lib/Business/OnlinePayment/PPIPayMover/CreditCardRequest.pm view on Meta::CPAN

# * The chage type indicates what action to take with this credit card
# * transaction.
# * @see #setChargeType(String)
# * @return the String passed to setChargeType or an empty String if the charge type was not set
#
sub GetChargeType()
{
  my $self = shift;
  $self->{strChargeType};
}

view all matches for this distribution

Business-Shipping-UPS_XML

1 match

lib/Business/Shipping/UPS_XML/Parser.pm view on Meta::CPAN

	  $self->{'_name'} = undef;
	  $self->{'_contents'} = undef;
   }
   # print "End Level " . $self->{'_level'} . "\n";
}
sub spawn_new_object() {

   my $self = shift;

   my $contents = $self->{'_contents'};
   my $name = $self->{'_name'};

view all matches for this distribution

C-Analyzer

1 match


=cut

#################### subroutine header end ####################

sub init() {
	my ($self) = @_;
	&clean();
	my $folder  = "";
	my $opt     = "";
	my $cppPath = "";


=cut

#################### subroutine header end ####################

sub calltree() {
	my ( $class, $functions ) = @_;
	my @funclist = ();
	if ( defined($functions) ) {
		@funclist = @{$functions};
	}


=cut

#################### subroutine header end ####################

sub getListOfCFiles() {
	my ( $folder, $opt ) = @_;
	my @cfiles = ();
	my $OS     = $^O;
	$$folder =~ s/\//\\/g;
	if (   ( defined $OS )


=cut

#################### subroutine header end ####################

sub prepareCalltreeInit() {
	my ($function) = shift;
	my $localtime  = localtime();
	my @calls      = ();
	if ( exists $calls{$$function} ) {
		@calls = @{ $calls{$$function} };


=cut

#################### subroutine header end ####################

sub generateCalltree() {
	my ( $function, $tabcount ) = ( shift, shift );
	if ( $calls{$function} ) {
		push( @rec_track, $function );
		my @calls = @{ $calls{$function} };
		shift(@calls);


=cut

#################### subroutine header end ####################

sub runGnuPreprocessor() {
	my ( $cfiles, $cppPath, $cppOpts ) = @_;
	my ( $prepfile, $prep_str );
	my @ppfiles = ();
	my $len     = scalar(@$$cfiles);
	my $cnt     = 0;


=cut

#################### subroutine header end ####################

sub identifyFunctionsAndCalls() {
	my ( $ppfiles, $opt, $folder ) = @_;
	my $fun_calls;
	foreach my $ppfile (@$$ppfiles) {
		$fun_calls = parseCFile( \$ppfile, \$$opt, \$$folder );
		updateHashTable( \$fun_calls );


=cut

#################### subroutine header end ####################

sub parseCFile() {
	my ( $infile, $opt_s, $FolderName ) = shift;
	my @t_funs_calls = ();
	my @pplines      = ();
	my $OpenCount    = 0;
	my $CloseCount   = 0;


=cut

#################### subroutine header end ####################

sub updateHashTable() {
	my $fun_calls  = shift;
	my $OpenCount  = 0;
	my $CloseCount = 0;
	my $function;
	my $FUNCTIONFOUND = 0;

None

=cut

#################### subroutine header end ####################
sub trim($) {
	my $string = shift;
	$string =~ s/^\s+// if defined($string);
	$string =~ s/\s+$// if defined($string);
	return $string;
}

None

=cut

#################### subroutine header end ####################
sub clean() {
	%calls       = ();
	@calls_table = ();
	@rec_track   = ();
	return;
}

view all matches for this distribution

C-Include

2 results

}


###########################
# TEXT PARSER
sub parse() {
    my $self = shift;
    my %define;

    # Define defaults
    $self->{''}{VERSION} = $VERSION;


    @$self{ keys %define } = values %define;
}


sub sizeof($){
    my ($self, $op) = @_;

    return $self->{typedef}{$op}[1]         if exists $self->{typedef}{$op};
    return $self->{struct}{$op}{''}{length} if exists $self->{struct}{$op};
    return 0;
}


sub make_struct($){
    my ($self, $struct) = @_;
    die "WARNING: Can't make struct with unknown type: '$struct'!\n"
        unless exists $self->{struct}{$struct};
    return new C::Include::Struct( $self->{struct}{$struct} );
}


sub defined($){ return exists shift->{$_[0]}; }
sub INC{ return exists($INC{scalar($_[0] || caller)}) ? $INC{scalar($_[0] || caller)} : undef; }
sub import{ shift; $INC{scalar(caller)} = new C::Include( @_ ) if @_; }


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


use 5.005;
use strict;
use Storable;

sub new($){
    my ($class, $self) = @_;
    $self = Storable::dclone( $self );
    bless $self, $class;
}

sub pack(;$){
    my ($self, $FILE, $data) = (shift, shift);

    if( $$self{''}{bitsets} ){
        for my $item( @{$$self{''}{bitsets}} ){
            my $i = $#{$$item{fields}};

    print $FILE $data if $FILE and defined fileno $FILE;

    return $data;
}

sub unpack($;$$){
    my $self = shift;
    my $data = shift;
    
    if( defined fileno $data ){
        my( $pos, $len ) = ( shift || 0, shift || $$self{''}{length} );

    }

    return 1;
}

sub link($$){
    my ($self, $old, $new) = @_;

    $old = \$self->{$old} unless ref $old;
    $_ == $old and return $_ = $new for @{ $self->{''}{buffers} };
    die "Can't relink!";
}

sub size(){ return shift->{''}{length} }

1;

__END__

view all matches for this distribution

CAD-Calc

1 match

lib/CAD/Calc.pm view on Meta::CPAN

Returns the value of $CAD::Calc::pi

  pi;

=cut
sub pi() {
	return($pi);
} # end subroutine pi definition
########################################################################

=head1 Functions

view all matches for this distribution

CAD-Mesh3D

1 match

lib/CAD/Mesh3D.pm view on Meta::CPAN


Grabs the individual x, y, or z coordinate from a vertex

=cut

sub getx($) { shift()->[XCOORD] }
sub gety($) { shift()->[YCOORD] }
sub getz($) { shift()->[ZCOORD] }

=head3 createMesh

 my $m = createMesh();          # empty
 my $s = createMesh($f, ...);   # pre-populated

view all matches for this distribution

CAM-PDF-Annot

1 match

be used across calls and update references across objects (and avoid
adding the same object more than once).

=cut

sub appendAnnotation($$$\%) {
	my ( $self, $page, $otherDoc, $otherAnnotRef, $refKeys ) = @_;

	# Sanity check: it only appends objects of /Type /Annot /Subtype /Square|Circle|Polygon|Text
	# returns an empty hash reference
	return {} if ( $otherDoc->getValue( $otherAnnotRef )->{Subtype}{value} !~ /(Square|Circle|Polygon|Text)/ );

	else {
		return $newkey;
	}
}

sub _appendAppearanceObject() {
	my ( $self, $otherDoc, $annotRef, $refKeys ) = @_;
	my $annotVal = $self->getValue( $annotRef );
	my %refs =();

	# Check if this annot has a reference to an APeareance object

		}
	}
	return %refs;
}

sub _appendPopupObject() {
	my ( $self, $page, $otherDoc, $annotRef, $parentKeys, $refKeys ) = @_;
	my $annotVal = $self->getValue( $annotRef );
	my $annots = $self->getPage( $page )->{Annots};
	my %refs =();

contains CAM::PDF::Nodes (see C<CAM::PDF>) of type 'reference' refering
to the annotations.

=cut

sub getAnnotations($) {
		my ( $self, $p ) = @_;
		return $self->getValue( $self->getPage( $p )->{Annots} ) || [];
}

1;

view all matches for this distribution

CBOR-XS

4 results

XS.pm view on Meta::CPAN


=back

=cut

sub tag($$) {
   bless [@_], CBOR::XS::Tagged::;
}

sub CBOR::XS::Tagged::tag {
   $_[0][0] = $_[1] if $#_;

view all matches for this distribution

CDB_File

1 match

CDB_File.pm view on Meta::CPAN

    goto &CLEAR;
}

# Must be preloaded for the prototype.

sub create(\%$$;$$) {
    my ( $RHdata, $fn, $fntemp, $option_key, $is_utf8 ) = @_;

    die("utf8 CDB_Files are not supported below Perl 5.14") if $option_key && $option_key eq 'utf8' && $is_utf8 && $] < "5.014";

    my $cdb = CDB_File->new( $fn, $fntemp, $option_key || '', $is_utf8 || 0 ) or return undef;

view all matches for this distribution

CECALA

2 results

PixelsAndColor/manysq.pl view on Meta::CPAN

if( $opts{w} ) { $width = $opts{w} ; }
if( $opts{h} ) { $height = $opts{h} ; }
if( $opts{b} ) { $background = $opts{b} ; }
if( $opts{f} ) { $fill = $opts{f} ; }

sub set_of_squares( $$$$$$ ) {
	my( $c, $xA, $yA, $m, $p, $a ) = @_;
	my $xB = $xA + $a;
	my $yB = $yA;
	my $xC = $xB;
	my $yC = $yA + $a;

view all matches for this distribution

CFDI

5 results

lib/CFDI/Location/XPath.pm view on Meta::CPAN

  my $content = shift;
  return unless defined $content && ref $content eq CONTENT;
  bless {_current=>'/',_rootRef=>$content,_currentRef=>$content},$class;
}

sub xpath($_){
  return unless $#_ == 1;
  local $_;
  my $self;
  $_[0] && ref $_[0] ? ($self,$_) : ($_,$self) = @_;
  return unless defined && !ref && length;

view all matches for this distribution

CGI-AIS-Session

1 match