App-PAIA

 view release on metacpan or  search on metacpan

lib/App/PAIA/Agent.pm  view on Meta::CPAN

        content => $opts{msg},
        headers => {
            'content-type'   => 'text/plain',
            'content-length' => length $opts{msg},
        }
    };
}

sub dump {
    my ($self, $msg) = @_;
    #  say ":$msg";
    $self->{dumper}->($msg);
}

sub dump_request {
    my ($self, $method, $url, $headers, $content) = @_;

    $self->dump("$method " . $url->path_query ." HTTP/1.1");
    $self->dump("Host: " . $url->host);
    $self->dump_message( $headers, $content );
}

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

            insecure => $_[0]->option('insecure'),
            logger   => $_[0]->logger,
            dumper   => $_[0]->dumper,
        );
    }
);

has logger => (
    default => sub {
        ($_[0]->app->global_options->verbose || $_[0]->app->global_options->debug)
            ? sub { say "# $_" for split "\n", $_[0]; }
            : sub { };
    }
);

has dumper => (
    default => sub {
        $_[0]->app->global_options->debug
            ? sub { say "> $_" for split "\n", $_[0]; }
            : sub { };
    }
);

sub base_url {
    my ($self, $name) = @_;
   
    # command line
    if ( defined $self->app->global_options->{$name} ) {
        return $self->app->global_options->{$name}; 

lib/App/PAIA/Command/change.pm  view on Meta::CPAN

    $self->auto_login_for('change');

    # Password should not be given as command line option, but as input
    # TODO: better way to get a new password, without echoing
    # e.g. use Term::ReadKey (ReadMode('noecho')) or TermTerm::ReadPassword
    #  See also App::Cmd::Plugin::Prompt or Term::ReadPassword
    {
        print "new password: ";
        chomp(my $pwd = scalar <STDIN>);
        if (length($pwd) < 4) {
            say "your password is too short!";
            redo;
        } else {
            print "please repeat: ";
            chomp(my $pwd2 = scalar <STDIN>);
            if ($pwd2 ne $pwd) {
                say "passwords don't match!"; 
                redo;
            }
        }
        $params{new_password} = $pwd;
    }
     
    $self->request( "POST", "$auth/change", \%params ); 
}

1;

lib/App/PAIA/Command/config.pm  view on Meta::CPAN

        my ($key, $value) = @$args;

        if (defined $value) {
            if (defined $self->config->file and -e $self->config->file) {
                $self->config->load;
            }
            $self->config->set( $key => $value );
            $self->config->store;
            return;
        } elsif( defined ($value = $self->config->get($key)) ) {
            say $value;
            return;
        } else {
            exit 1;
        }
    }
        
    $self->config->load;

    if ($opt->ini) {
        foreach ( sort keys %{$self->config->{data}} ) {
            say "$_=".$self->config->get($_); 
        }
    } else {
        return $self->config->{data};
    }
     
    return;
}

1;
__END__

lib/App/PAIA/Command/help.pm  view on Meta::CPAN

    if ($self->app->global_options->version) {
        $self->app->execute_command( $self->app->prepare_command('version') );
        exit;
    }

    if (@$args) {
        my $command = $args->[0];
        my ($cmd, $opt, $args) = $self->app->prepare_command(@$args);
        
        if (ref($cmd) =~ /::commands$/) { # unrecognized command
            say $self->app->usage->leader_text;
            return;
        }

        require Getopt::Long::Descriptive;
        Getopt::Long::Descriptive->VERSION(0.084);

        my (undef, $usage) = Getopt::Long::Descriptive::describe_options(
            $cmd->usage_desc, $cmd->opt_spec, App::PAIA->global_opt_spec
        );

        my $desc = $cmd->description; chomp $desc;
        say join "\n\n", grep { defined $_ } 
            eval { $usage->leader_text }, 
            length $desc ? $desc : undef,
            "Global options:\n".$self->app->usage->option_text;

        if ($cmd->usage->option_text) {
            say "Command options:";
            say eval { $cmd->usage->option_text };
        }

    } else {
        say $self->app->usage->leader_text;
        say;

        my @cmd_groups = (
            "PAIA auth commands" => [qw(login logout change)],
            "PAIA core commands" => [qw(patron items request renew cancel fees)],
            "client commands"    => [qw(config session help)]
        );

        while (@cmd_groups) {
            say shift(@cmd_groups) . ":";
            for my $command (@{ shift @cmd_groups }) {
                my $abstract = $self->app->plugin_for($command)->abstract;
                printf "%9s: %s\n", $command, $abstract;
            }
            say;
        }    

        say "call 'paia help <command>' or 'perldoc paia' for more details.";
    }
}

1;
__END__

=head1 NAME

App::PAIA::Command::help - show help

lib/App/PAIA/Command/session.pm  view on Meta::CPAN


our $VERSION = '0.30';

use App::PAIA::JSON;

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

    if (defined $self->session->file ) {
        my $data = $self->session->load;
        say encode_json($data) if $self->app->global_options->verbose;
        my $msg = $self->not_authentificated;
        die "$msg.\n" if $msg;
        say "session looks fine.";
    } else {
        die "no session file found.\n";
    }

    if (!$self->auth) {
        die "PAIA auth server URL not found\n";
    } else {
        $self->logger->('auth URL: '.$self->auth);
    }

lib/App/PAIA/Tester.pm  view on Meta::CPAN

    no warnings;
    *HTTP::Tiny::request = \&mock_http;
}

sub paia(@) { ## no critic
    $RESULT = test_app('App::PAIA' => [@_]);
}

sub PAIA($) { ## no critic
    my @args = split /\s+/, shift;
    say join ' ', '# paia', @args;
    paia(@args);
}

sub done_paia_test() {
    chdir $CWD;
    done_testing;
}

sub debug {
    say "# $_" for split "\n", join "\n", (
        "stdout: ".$RESULT->stdout,
        "stderr: ".$RESULT->stderr,
        "error: ".$RESULT->error // 'undef',
        "exit_code: ".$RESULT->exit_code
    );
}

1;
__END__



( run in 0.987 second using v1.01-cache-2.11-cpan-d7a12ab2c7f )