view release on metacpan or  search on metacpan

lib/App/CamelPKI/SysV/Apache.pm  view on Meta::CPAN

    is($response->code, 404, "500 would be bad") or
        diag $response->content;
    unlike($webserver->tail_error_logfile,
           qr/certificate signature failure/, <<"EXPLANATION");
``certificate signature failure'' is the message one gets when mod_ssl
attempts to validate a certificate whose hash algorithm it doesn't
know about.
EXPLANATION
}

my $sha256directory = fresh_directory;

 view release on metacpan or  search on metacpan

script/cek-bpom-products  view on Meta::CPAN

You can also put configuration for multiple programs inside a single file, and use filter C<program=NAME> in section names, e.g. C<[program=NAME ...]> or C<[SOMESECTION program=NAME]>. The section will then only be used when the reading program match...

You can also filter a section by environment variable using the filter C<env=CONDITION> in section names. For example if you only want a section to be read if a certain environment variable is true: C<[env=SOMEVAR ...]> or C<[SOMESECTION env=SOMEVAR ...

To load and configure plugins, you can use either the C<-plugins> parameter (e.g. C<< -plugins=DumpArgs >> or C<< -plugins=DumpArgs@before_validate_args >>), or use the C<[plugin=NAME ...]> sections, for example:

 [plugin=DumpArgs]
 -event=before_validate_args
 -prio=99
 
 [plugin=Foo]
 -event=after_validate_args
 arg1=val1
 arg2=val2

 

which is equivalent to setting C<< -plugins=-DumpArgs@before_validate_args@99,-Foo@after_validate_args,arg1,val1,arg2,val2 >>.

List of available configuration parameters:

 format (see --format)
 get_product_detail (see --get-product-detail)

 view release on metacpan or  search on metacpan

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

        parent_command => $self,
    )->run;
}

subcommand $_ => 'App::Changelord::Command::' . ucfirst $_ =~ s/-(.)/uc $1/er
    for qw/ schema validate version bump init add git-gather print /;

1;

__END__

 view release on metacpan or  search on metacpan

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

  return undef;
}
sub setup_source_help {
  my ($pred, $node) = @_;
  require App::Chart::Sympred;
  App::Chart::Sympred::validate ($pred);
  # newer get higher priority
  unshift @source_help_list, [ $pred, $node ];
}

 view release on metacpan or  search on metacpan

cheats.txt  view on Meta::CPAN

curl --head www.google.com

# Check if website/URL is up (Jira,ping)
curl -s --head http://localhost:8081/secure/Dashboard.jspa | head -1

# Download files using curl and validate the checksum:
curl -LO "https://dl.k8s.io/release/$(curl -L -s https://dl.k8s.io/release/stable.txt)/bin/linux/amd64/kubectl-convert"
curl -LO "https://dl.k8s.io/release/$(curl -L -s https://dl.k8s.io/release/stable.txt)/bin/linux/amd64/kubectl-convert.sha256"
echo "$(cat kubectl-convert.sha256) kubectl-convert" | sha256sum --check
#
# Install the new command.

cheats.txt  view on Meta::CPAN

child.addEventListener("click", second);
parent.addEventListener("click", first, true);
when clicking child element, first method will be called before second.

# Add a function to an event (HTML Event Listener)
is_no_automatic_change.addEventListener("change", validate_general_tab_checks);
document.querySelector("input[name=NAME]").addEventListener("change", myFunc)

# Remove a function from an event (HTML Event Listener)
document.querySelector("input[name=NAME]").removeEventListener("change", myFunc, false)

cheats.txt  view on Meta::CPAN

#############################################################
## Perl Modules - Business::CreditCard
#############################################################

# Validate a credit card number.
perl -MBusiness::CreditCard -E 'say validate("5276 4400 6542 1319")'
1
#
perl -MBusiness::CreditCard -E 'say cardtype("5276 4400 6542 1319")'
MasterCard

cheats.txt  view on Meta::CPAN

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

# Modern::Perl defaults to v5.12 (bug!?)
perl -E 'say $^V'
v5.36.0
perl -Modern::Perl -e 'say Modern::Perl::validate_date(2022)'
:5.34
perl -Modern::Perl -e 'say Modern::Perl::validate_date()'
:5.12
perl                    -E 'sub abc ($n) {$n}'
perl -Modern::Perl=2022 -e 'sub abc ($n) {$n}'
perl -Modern::Perl      -e 'sub abc ($n) {$n}'
Illegal character in prototype for main::abc : $n at -e line 1.

cheats.txt  view on Meta::CPAN

# Notebook example 6. multiple pages/tabs (PTk)
perl -MTk -MTk::NoteBook -le '$nb=MainWindow->new->NoteBook->pack; $nb->add("page0$_", -label => "Page $_") for 1..5; @pgs = map $nb->page_widget($_), $nb->pages; ($p,@rest)=@pgs; $nb1=$p->NoteBook->pack; $nb1->add("page1$_", -label => "Page $_") for...

# Entry widget validation options (PTk)
perl -MTk -le 'MainWindow->new->Entry(-validate => "key", -validatecommand => sub{$_[1] =~ /\d/}, -invalidcommand => sub{ print "ERROR" })->pack->focus; MainLoop'

# Making Scrollbars (PTk)
# When text widget is scrolled its "-yscrollcommand" command is invoked. This calls $s->set(...)
# When the scrollbar is clicked on "-command" is invoked which calls $t->yview(...)
perl -MTk -le '$mw=MainWindow->new; $s=$mw->Scrollbar; $t=$mw->Text(-yscrollcommand => ["set" => $s]); $s->configure(-command => ["yview" => $t]); $s->pack(-side => "right", -fill => "y"); $t->pack(-fill => "both"); MainLoop'

 view release on metacpan or  search on metacpan

lib/App/Chit/Command/chat.pm  view on Meta::CPAN

		[ "stdin",         "prompt from STDIN" ],
		[ "file=s",        "prompt from file" ],
	);
}

sub validate_args ( $self, $opt, $args ) {
	unless ( $opt->{stdin} or $opt->{file} ) {
		$self->usage_error( "expected a prompt on the command line, or -i, or -f" )
			unless ( @$args == 1 and length($args->[0]) > 2 );
	}
	

 view release on metacpan or  search on metacpan

script/restart-chrome  view on Meta::CPAN

You can also put configuration for multiple programs inside a single file, and use filter C<program=NAME> in section names, e.g. C<[program=NAME ...]> or C<[SOMESECTION program=NAME]>. The section will then only be used when the reading program match...

You can also filter a section by environment variable using the filter C<env=CONDITION> in section names. For example if you only want a section to be read if a certain environment variable is true: C<[env=SOMEVAR ...]> or C<[SOMESECTION env=SOMEVAR ...

To load and configure plugins, you can use either the C<-plugins> parameter (e.g. C<< -plugins=DumpArgs >> or C<< -plugins=DumpArgs@before_validate_args >>), or use the C<[plugin=NAME ...]> sections, for example:

 [plugin=DumpArgs]
 -event=before_validate_args
 -prio=99
 
 [plugin=Foo]
 -event=after_validate_args
 arg1=val1
 arg2=val2

 

which is equivalent to setting C<< -plugins=-DumpArgs@before_validate_args@99,-Foo@after_validate_args,arg1,val1,arg2,val2 >>.

List of available configuration parameters:

 chrome_cmd (see --chrome-cmd)
 format (see --format)

 view release on metacpan or  search on metacpan

ChangeLog  view on Meta::CPAN

5.1.2 - 2nd January 2016
    * Load gravitars in a protocol-agnostic fashion.

5.1.1 - 4th July 2015
    * Updated default RSS-feed to validate correctly.

5.1.0 - 16th June 2015
    * Allow per-post templates.
	* Allow posts to be truncated.
	* Allow user to configure the man/max/step-size of the tag-cloud.

 view release on metacpan or  search on metacpan

lib/App/Cinema/Controller/Comment.pm  view on Meta::CPAN

		$c->res->redirect( $c->uri_for('/menu/about') );
		return 0;
	}
	my $form    = $self->formbuilder;
	my $comment = $form->field('desc');
	if ( $form->submitted && $form->validate ) {
		if ( $form->submitted eq 'Preview' ) {
			$c->stash->{message} = $comment;
		}
		elsif ( $form->submitted eq 'Save' ) {
			$c->model('MD::Comment')->create(

 view release on metacpan or  search on metacpan

lib/App/ClusterSSH/Config.pm  view on Meta::CPAN

    $self->{title} = uc($Script);

    $clusters = App::ClusterSSH::Cluster->new();

    return $self->validate_args(%args);
}

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

    my @unknown_config = ();

    foreach my $config ( sort( keys(%args) ) ) {

lib/App/ClusterSSH/Config.pm  view on Meta::CPAN

    # tidy up entries, just in case
    $read_config{terminal_font} =~ s/['"]//g
        if ( $read_config{terminal_font} );

    $self->validate_args(%read_config);
}

sub load_configs {
    my ( $self, @configs ) = @_;

lib/App/ClusterSSH/Config.pm  view on Meta::CPAN

=item $config->parse_config_file('<filename>');

Read in configuration from given filename

=item $config->validate_args();

Validate and apply all configuration loaded at this point

=item $path = $config->search_dirs('<name>', @seaarch_directories);

 view release on metacpan or  search on metacpan

lib/Module/Starter/Plugin/App/Cmd.pm  view on Meta::CPAN

    #     [ 'name=s' => "Name", {default => \$SUPER::config->{name} || undef} ],
    # );
    return ();
}

sub validate_args {
    my ( \$self, \$opt, \$args ) = \@_;
    
    # Example validation
    # 
    # \$self->usage_message('Your error here') unless (\$some_condition);

 view release on metacpan or  search on metacpan

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

#pod       [ "blortex|X",  "use the blortex algorithm" ],
#pod       [ "recheck|r",  "recheck all results"       ],
#pod     );
#pod   }
#pod
#pod   sub validate_args {
#pod     my ($self, $opt, $args) = @_;
#pod
#pod     # no args allowed but options!
#pod     $self->usage_error("No args allowed") if @$args;
#pod   }

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

#pod =method execute_command
#pod
#pod   $app->execute_command($cmd, \%opt, @args);
#pod
#pod This method will invoke C<validate_args> and then C<run> on C<$cmd>.
#pod
#pod =cut

sub execute_command {
  my ($self, $cmd, $opt, @args) = @_;

  local our $active_cmd = $cmd;

  $cmd->validate_args($opt, \@args);
  $cmd->execute($opt, \@args);
}

#pod =method plugin_search_path
#pod

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

#pod =method usage_error
#pod
#pod   $self->usage_error("Something's wrong!");
#pod
#pod Used to die with nice usage output, during C<validate_args>.
#pod
#pod =cut

sub usage_error {
  my ($self, $error) = @_;

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

      [ "blortex|X",  "use the blortex algorithm" ],
      [ "recheck|r",  "recheck all results"       ],
    );
  }

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

    # no args allowed but options!
    $self->usage_error("No args allowed") if @$args;
  }

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

=head2 execute_command

  $app->execute_command($cmd, \%opt, @args);

This method will invoke C<validate_args> and then C<run> on C<$cmd>.

=head2 plugin_search_path

This method returns the plugin_search_path as set.  The default implementation,
if called on "YourApp::Cmd" will return "YourApp::Cmd::Command"

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

=head2 usage_error

  $self->usage_error("Something's wrong!");

Used to die with nice usage output, during C<validate_args>.

=head1 TODO

=over 4

 view release on metacpan or  search on metacpan

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

    }
}

# ----------------------------------------------------------------
# Create (and return) option definitions from wanted option sets
# (given as class names). Also install the validate_args() subroutine
# that will call validate_opts() on all wanted option sets.
# ----------------------------------------------------------------
sub composed_of {
    my $self = shift;
    my @option_classes = @_;  # list of class names with wanted options sets

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

    # install a dispatcher of all validating methods
    Sub::Install::reinstall_sub ({
        code => sub {
            foreach my $set (@option_classes) {
                next if ref ($set);
                if ($set->can ('validate_opts')) {
                    $set->validate_opts ($self, @_);
                }
            }
        },
        as   => 'validate_args',
                               });
    # add the configuration options
    return (@opt_spec, { getopt_conf => $self->getopt_conf() } );
}

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

   opt_spec()

=item Methods that you may overwrite

   usage_desc()
   validate_args()
   usage_error()
   getopt_conf()
   ...

=item Methods that you just call

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

   sub usage_desc {
       return shift->SUPER::usage_desc() . ' ...and anything else';
   }

=head2 B<validate_args>

Originally, this method was meant to check (validate) the command-line
arguments (remember that arguments are whatever remains on the
command-line after options defined in the L<opt_spec|"opt_spec">
method have been processed). The options themselves could be already
validated by various subroutines and attributes given in the option
specifications (as described, sometimes only vaguely, in the
L<Getopt::Long::Descriptive>). But sometimes, it is useful to have all
validation, of options and of arguments, in one place - so we have
this method.

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

an arrayref containing all remaining arguments on the command-line.

I<Important:> Some predefined sets of options (see the L<"PREDEFINED
SETS OF OPTIONS">) do also some checking (or other actions, like
printing the version and exiting) and this checking is invoked from
the C<App::Cmdline>'s validate_args method. Therefore, it is strongly
recommended that if you overwrite this method, you also call the SUPER:

   sub validate_args {
       my ($self, $opt, $args) = @_;
       $self->SUPER::validate_args ($opt, $args);
       if ($opt->number and scalar @$args != $opt->number) {
          $self->usage_error ("Option --number does not correspond with the number of arguments");
       }
   }

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

       return
           [ 'h'         => "display a short usage message"  ],
           [ 'version|v' => "display a version"              ];
   }

=item B<validate_opts>

This method, if exists, will be called from the
L<validate_args|"validate_args"> method. Its purpose is to do
something with the options belonging to (predefined by) this class.

It gets four parameters, C<$app> (the class name of your application),
C<$caller> (who is calling), C<$opts> (an object allowing to access
all options) and C<$args> (an arrayref with the remaining arguments

 view release on metacpan or  search on metacpan

lib/App/Cme/Command/check.pm  view on Meta::CPAN

use base qw/App::Cme::Common/;

use Config::Model::ObjTreeScanner;

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

    $self->check_unknown_args($args);
    $self->process_args($opt,$args);
    return;

 view release on metacpan or  search on metacpan

lib/App/Codit/Plugins/Colors.pm  view on Meta::CPAN

	my $bframe = $fframe->Frame->pack(-fill => 'x');

	$bframe->Button(
		-text => 'Insert',
		-command => sub {
			if ($picker->validate($color)) {
				$self->cmdExecute('edit_insert', 'insert', $color);
				$picker->historyAdd($picker->getHEX);
				$picker->historyUpdate;
			}
		},
	)->pack(@padding, -side => 'left', -expand => 1, -fill => 'x');

	$bframe->Button(
		-text => 'Copy',
		-command => sub {
			if ($picker->validate($color)) {
				$self->clipboardClear;
				$self->clipboardAppend($color);
				$picker->historyAdd($picker->getHEX);
				$picker->historyUpdate;
			}

lib/App/Codit/Plugins/Colors.pm  view on Meta::CPAN

	my @sel = $self->cmdExecute('doc_get_sel');
	my $pick = $self->_pick;
	if (@sel) {
		my $text = $self->cmdExecute('doc_get_text', @sel);
		chomp($text);
		if ($self->_pick->validate($text)) {
			$pick->put($text);
			$self->_ent($pick->notationCurrent);
			$self->updateEntry;
		}
	}

lib/App/Codit/Plugins/Colors.pm  view on Meta::CPAN

sub updateEntry {
	my ($self, $value) = @_;
	$value = $self->_ent->get unless defined $value;
	my $pick = $self->_pick;
	if ($self->_pick->validate($value)) {
		$self->_ind($pick->getHEX);
		$self->_ent->configure(-foreground => $self->configGet('-foreground'));
		$self->_pick($value);
	} else {
		$self->_ind($self->configGet('-background'));

 view release on metacpan or  search on metacpan

lib/App/Config/Chronicle.pm  view on Meta::CPAN

    my $definitions        = shift;
    my $containing_section = shift;

    $containing_section->meta->make_mutable;
    foreach my $definition_key (keys %{$definitions}) {
        $self->_validate_key($definition_key, $containing_section);
        my $definition = $definitions->{$definition_key};
        if ($definition->{isa} eq 'section') {
            $self->_create_section($containing_section, $definition_key, $definition);
            $self->_create_attributes($definition->{contains}, $containing_section->$definition_key);
        } elsif ($definition->{global}) {

lib/App/Config/Chronicle.pm  view on Meta::CPAN

    $section->$writer($attribute);

    return $attribute;
}

sub _validate_key {
    my $self    = shift;
    my $key     = shift;
    my $section = shift;

    if (grep { $key eq $_ } qw(path parent_path name definition version data_set check_for_update save_dynamic refresh_interval)) {

 view release on metacpan or  search on metacpan

lib/App.pm  view on Meta::CPAN

The first AOP
feature planned is the printing of arguments on entry to a method and
the printing of arguments and return values on exit of a a method.

This is useful
for debugging and the generation of object-message traces to validate
or document the flow of messages through the system.

Detailed Conditions:

  * use(001) class does not exist: throw a App::Exception

 view release on metacpan or  search on metacpan

script/create-random-file  view on Meta::CPAN

You can also put configuration for multiple programs inside a single file, and use filter C<program=NAME> in section names, e.g. C<[program=NAME ...]> or C<[SOMESECTION program=NAME]>. The section will then only be used when the reading program match...

You can also filter a section by environment variable using the filter C<env=CONDITION> in section names. For example if you only want a section to be read if a certain environment variable is true: C<[env=SOMEVAR ...]> or C<[SOMESECTION env=SOMEVAR ...

To load and configure plugins, you can use either the C<-plugins> parameter (e.g. C<< -plugins=DumpArgs >> or C<< -plugins=DumpArgs@before_validate_args >>), or use the C<[plugin=NAME ...]> sections, for example:

 [plugin=DumpArgs]
 -event=before_validate_args
 -prio=99
 
 [plugin=Foo]
 -event=after_validate_args
 arg1=val1
 arg2=val2

 

which is equivalent to setting C<< -plugins=-DumpArgs@before_validate_args@99,-Foo@after_validate_args,arg1,val1,arg2,val2 >>.

List of available configuration parameters:

 format (see --format)
 interactive (see --interactive)

 view release on metacpan or  search on metacpan

LICENSE  view on Meta::CPAN

    License to anyone who comes into possession of a copy.  This
    License will therefore apply, along with any applicable section 7
    additional terms, to the whole of the work, and all its parts,
    regardless of how they are packaged.  This License gives no
    permission to license the work in any other way, but it does not
    invalidate such permission if you have separately received it.

    d) If the work has interactive user interfaces, each must display
    Appropriate Legal Notices; however, if the Program has interactive
    interfaces that do not display Appropriate Legal Notices, your
    work need not make them do so.

 view release on metacpan or  search on metacpan

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

        [ 'debug|d',         'display debugging information',  { default => $App::Critique::CONFIG{'DEBUG'}, implies => 'verbose' } ],
        [ 'verbose|v',       'display additional information', { default => $App::Critique::CONFIG{'VERBOSE'}                     } ],
    );
}

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

    $self->usage_error('The git-work-tree does not exist (' . $opt->git_work_tree . ')')
        unless -d $opt->git_work_tree;
}

 view release on metacpan or  search on metacpan

lib/App/Dazz/Command/contained.pm  view on Meta::CPAN

    $desc .= ucfirst(abstract) . ".\n";
    $desc .= "\tAll operations are running in a tempdir and no intermediate files are kept.\n";
    return $desc;
}

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

    if ( @{$args} < 1 ) {
        my $message = "This command need one or more input files.\n\tIt found";
        $message .= sprintf " [%s]", $_ for @{$args};

 view release on metacpan or  search on metacpan

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

    );
}



sub validate_args {
    my ($self, $opt, $args) = @_;
    $self->usage_error("Bad command") if @$args;
    $self->usage if $opt->{help};
}

 view release on metacpan or  search on metacpan

lib/App/Deps/Verify/App/VerifyDeps/Command/plinst.pm  view on Meta::CPAN

        [ "input|i=s\@", "the input files" ],
        [ "notest",      "speed up installation by skipping the tests" ],
    );
}

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

    # no args allowed but options!
    $self->usage_error("No args allowed") if @$args;

 view release on metacpan or  search on metacpan

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

#
# The routines used to pack and unpack a list of disks for
# transmission could take any form, really. The key things to consider
# are that (a) arbitrary spoofed data can't result in us introducing
# security issues (so solutions that involve eval'ing the packed data
# are out, unless we validate that the data is in the expected form)
# and (b) we take into consideration quoting issues (such as not using
# spaces as separators, since they may appear in disk labels). As it
# happens, YAML can solve both of these problems for us. It may not
# make best use of space, but at least it's quick and easy to
# implement.

 view release on metacpan or  search on metacpan

script/dir2dist  view on Meta::CPAN

You can also put configuration for multiple programs inside a single file, and use filter C<program=NAME> in section names, e.g. C<[program=NAME ...]> or C<[SOMESECTION program=NAME]>. The section will then only be used when the reading program match...

You can also filter a section by environment variable using the filter C<env=CONDITION> in section names. For example if you only want a section to be read if a certain environment variable is true: C<[env=SOMEVAR ...]> or C<[SOMESECTION env=SOMEVAR ...

To load and configure plugins, you can use either the C<-plugins> parameter (e.g. C<< -plugins=DumpArgs >> or C<< -plugins=DumpArgs@before_validate_args >>), or use the C<[plugin=NAME ...]> sections, for example:

 [plugin=DumpArgs]
 -event=before_validate_args
 -prio=99
 
 [plugin=Foo]
 -event=after_validate_args
 arg1=val1
 arg2=val2

 

which is equivalent to setting C<< -plugins=-DumpArgs@before_validate_args@99,-Foo@after_validate_args,arg1,val1,arg2,val2 >>.

List of available configuration parameters:

 dirs (see --dirs)
 format (see --format)

 view release on metacpan or  search on metacpan

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

use autodie;
use warnings;

use File::BaseDir qw(config_files);
use File::ShareDir qw(module_file);
use Kwalify qw(validate);
use Path::Tiny qw(path);
use YAML::XS ();

##############################################################################
# Helper methods

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

        my $error = lcfirst($@);
        chomp($error);
        $error =~ s{ \n }{ }xms;
        die "$error\n";
    }
    eval { validate($schema_ref, $data_ref) };
    if ($@) {
        my $errors = $@;
        chomp($errors);
        die "schema validation for $path failed:\n$errors\n";
    }

 view release on metacpan or  search on metacpan

lib/App/Dochazka/CLI/Commands/Interval.pm  view on Meta::CPAN

resulting status object.

=cut

sub _interval_new {
    my ( $code, $tsrange, $long_desc ) = validate_pos( @_,
        { type => SCALAR },
        { type => SCALAR },
        { type => SCALAR|UNDEF, optional => 1 },
    );

lib/App/Dochazka/CLI/Commands/Interval.pm  view on Meta::CPAN

=head3 _fillup

=cut

sub _fillup {
    my ( %ARGS ) = validate( @_, {
        eid => { type => SCALAR },
        code => { type => SCALAR, optional => 1 },
        date_list => { type => ARRAYREF, optional => 1 },
        tsrange => { type => SCALAR, optional => 1 },
        dry_run => { type => SCALAR },

 view release on metacpan or  search on metacpan

lib/App/Dochazka/Common/Model.pm  view on Meta::CPAN

sub make_filter {

    # take a list consisting of the names of attributes that the 'filter'
    # routine will retain -- these must all be scalars
    my ( @attr ) = validate_pos( @_, map { { type => SCALAR }; } @_ );

    return sub {
        if ( @_ % 2 ) {
            die "Odd number of parameters given to filter routine!";
        }

lib/App/Dochazka/Common/Model.pm  view on Meta::CPAN

sub make_reset {

    # take a list consisting of the names of attributes that the 'reset'
    # method will accept -- these must all be scalars
    my ( @attr ) = validate_pos( @_, map { { type => SCALAR }; } @_ );

    # construct the validation specification for the 'reset' routine:
    # 1. 'reset' will take named parameters _only_
    # 2. only the values from @attr will be accepted as parameters
    # 3. all parameters are optional (indicated by 0 value in $val_spec)

lib/App/Dochazka/Common/Model.pm  view on Meta::CPAN

    return sub {
        # process arguments
        my $self = shift;
        #confess "Not an instance method call" unless ref $self;
        my %ARGS;
        %ARGS = validate( @_, $val_spec ) if @_ and defined $_[0];

        # Set attributes to run-time values sent in argument list.
	# Attributes that are not in the argument list will get set to undef.
        map { $self->{$_} = $ARGS{$_}; } @attr;

lib/App/Dochazka/Common/Model.pm  view on Meta::CPAN

sub make_accessor {
    my ( $subname, $type ) = @_;
    $type = $type || { type => SCALAR | UNDEF, optional => 1 };
    sub {
        my $self = shift;
        validate_pos( @_, $type );
        $self->{$subname} = shift if @_;
        $self->{$subname} = undef unless exists $self->{$subname};
        return $self->{$subname};
    };
}

lib/App/Dochazka/Common/Model.pm  view on Meta::CPAN

=cut

sub make_TO_JSON {

    my ( @attr ) = validate_pos( @_, map { { type => SCALAR }; } @_ );

    return sub {
        my $self = shift;
        my $unblessed_copy;

lib/App/Dochazka/Common/Model.pm  view on Meta::CPAN

=cut

sub make_compare {

    my ( @attr ) = validate_pos( @_, map { { type => SCALAR }; } @_ );

    return sub {
        my ( $self, $other ) = validate_pos( @_, 1, 1 );
        return if ref( $other ) ne ref( $self );
        
        return eq_deeply( $self, $other );
    }
}

lib/App/Dochazka/Common/Model.pm  view on Meta::CPAN

=cut

sub make_compare_disabled {

    my ( @attr ) = validate_pos( @_, map { { type => SCALAR }; } @_ );

    return sub {
        my ( $self, $other ) = validate_pos( @_, 1, 1 );
        return $self->compare( $other) unless grep { $_ eq 'disabled' } @attr;
        return if ref( $other ) ne ref( $self );
        my $self_disabled = $self->{'disabled'};
        delete $self->{'disabled'};
        my $other_disabled = $other->{'disabled'};

lib/App/Dochazka/Common/Model.pm  view on Meta::CPAN

=cut

sub make_clone {

    my ( @attr ) = validate_pos( @_, map { { type => SCALAR }; } @_ );

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

        my ( %h, $clone );

lib/App/Dochazka/Common/Model.pm  view on Meta::CPAN

=cut

sub make_attrs {

    my ( @attrs ) = validate_pos( @_, map { { type => SCALAR }; } @_ );

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

        return \@attrs;

lib/App/Dochazka/Common/Model.pm  view on Meta::CPAN

=cut

sub make_get {

    my ( @attrs ) = validate_pos( @_, map { { type => SCALAR }; } @_ );

    return sub {
        my ( $self, $attr ) = @_;

        if ( grep { $_ eq $attr } @attrs ) {

lib/App/Dochazka/Common/Model.pm  view on Meta::CPAN

=cut

sub make_set {

    my ( @attrs ) = validate_pos( @_, map { { type => SCALAR }; } @_ );

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

        if ( grep { $_ eq $attr } @attrs ) {

 view release on metacpan or  search on metacpan

lib/App/Dochazka/REST/ACL.pm  view on Meta::CPAN

of C<privlevel>.

=cut

sub check_acl {
    my ( %ARGS ) = validate( @_, {
        profile => { type => SCALAR, regex => qr/^(passerby)|(inactive)|(active)|(admin)|(forbidden)$/ }, 
        privlevel => { type => SCALAR, regex => qr/^(passerby)|(inactive)|(active)|(admin)$/ }, 
    } );
    return exists( $acl_lookup{$ARGS{privlevel}}->{$ARGS{profile}} )
        ? 1

 view release on metacpan or  search on metacpan

lib/App/Dochazka/WWW/Dispatch.pm  view on Meta::CPAN

    # two possibilities: login/logout attempt or normal AJAX call
    if ( $method =~ m/^LOGIN/i ) {
        $log->debug( "Incoming login/logout attempt" );
        if ( $path =~ m/^login/i ) {
            return $self->validate_user_credentials( $body );
        } else {
            return $self->_logout( $body );
        }
    }

lib/App/Dochazka/WWW/Dispatch.pm  view on Meta::CPAN

    my $hr = $rr->{'hr'};
    return $self->_prep_ajax_response( $hr, $rr->{'body'} );
}


=head2 validate_user_credentials

Called either from C<process_post> on login AJAX requests originating from the
JavaScript side (i.e. the login screen in login-dialog.js, via login.js), or
directly from C<is_authorized> if the MFILE_WWW_BYPASS_LOGIN_DIALOG mechanism
is activated.

lib/App/Dochazka/WWW/Dispatch.pm  view on Meta::CPAN

Returns a status object - OK means the login was successful; all other statuses
mean unsuccessful.

=cut

sub validate_user_credentials {
    my ( $self, $body ) = @_;
    $log->debug( "Entering " . __PACKAGE__ . "::validate_user_credentials()" );

    my $r = $self->request;
    my $session = $self->session;
    my $nick = $body->{'nam'};
    my $password = $body->{'pwd'};