Changeset 923373f451ff8825cb260356023de52919dadd40 in xas


Ignore:
Timestamp:
11/24/14 11:18:24 (5 years ago)
Author:
Kevin L. Esteb <kevin@…>
Branches:
master
Children:
5eb7b854a18db0f58423dfe552cd5d8b836dc328
Parents:
a04c3b855f4ac4809a3dce3bc57149866918f8b9
git-author:
Kevin L. Esteb <kevin@…> (11/24/14 11:18:24)
git-committer:
Kevin L. Esteb <kevin@…> (11/24/14 11:18:24)
Message:

Did some fixups on various modules.

Location:
trunk
Files:
9 edited

Legend:

Unmodified
Added
Removed
  • trunk/Build.PL

    rdff4807c5e9a1c09d7cdd5f4b36e88914e6dedeb r923373f451ff8825cb260356023de52919dadd40  
    6969    use File::Spec::Functions qw( catfile catdir rel2abs ); 
    7070 
     71    # override and add a few things 
     72 
     73    sub new { 
     74        my $class = shift; 
     75 
     76        my $self = $class->SUPER::new(@_); 
     77 
     78        my $blib = $self->{properties}{blib}; 
     79        my $sbin = catfile($blib, 'sbin'); 
     80        $self->{properties}{sbindoc_dirs} = [ $sbin ]; 
     81 
     82        return $self; 
     83 
     84    } 
     85 
     86    # create man pages for files within sbin 
     87 
     88    sub manify_sbin_pods { 
     89        my $self    = shift; 
     90 
     91        my $files  = $self->_find_pods(  
     92            $self->{properties}{sbindoc_dirs}, 
     93            exclude => [ $self->file_qr('\.bat$') ]  
     94        ); 
     95 
     96        return unless keys %$files; 
     97 
     98        my $mandir = File::Spec->catdir( $self->blib, 'bindoc' ); 
     99        File::Path::mkpath( $mandir, 0, oct(777) ); 
     100 
     101        require Pod::Man; 
     102 
     103        foreach my $file (keys %$files) { 
     104 
     105            # Pod::Simple based parsers only support one document per instance. 
     106            # This is expected to change in a future version  
     107            # (Pod::Simple > 3.03). 
     108 
     109            # binaries go in section 1p 
     110 
     111            my $parser  = Pod::Man->new( section => '1p' );  
     112            my $manpage = $self->man1page_name( $file ) . '.' . 
     113                $self->config( 'man1ext' ); 
     114 
     115            my $outfile = File::Spec->catfile($mandir, $manpage); 
     116 
     117            next if $self->up_to_date( $file, $outfile ); 
     118 
     119            $self->log_verbose("Manifying $file -> $outfile\n"); 
     120 
     121            eval { $parser->parse_from_file( $file, $outfile ); 1 } 
     122                 or $self->log_warn("Error creating '$outfile': $@\n"); 
     123           
     124            $files->{$file} = $outfile; 
     125 
     126        } 
     127 
     128    } 
     129 
    71130    # set up directory structure and user/group accounts 
    72131 
  • trunk/lib/XAS/Apps/Test/RPC/Processor.pm

    reccf84fbcb238727abc24f067428166bae794186 r923373f451ff8825cb260356023de52919dadd40  
    3636 
    3737            $self->log->debug("$alias: keepalive enabled"); 
     38            $self->init_keepalive(); 
    3839            $self->enable_keepalive($socket); 
    3940 
     
    6566 
    6667    $self->init_json_server($methods); 
    67     $self->init_keepalive() if ($self->tcp_keepalive); 
    6868 
    6969    return $self; 
  • trunk/lib/XAS/Lib/Mixins/JSON/Client.pm

    rc5596c0d76dbacce5903e2d68a28b383557884c6 r923373f451ff8825cb260356023de52919dadd40  
    1 package XAS::Lib::RPC::JSON::Client; 
     1package XAS::Lib::Mixins::JSON::Client; 
    22 
    33our $VERSION = '0.02'; 
    44 
    5 use Params::Validate ':all'; 
     5use Params::Validate 'HASHREF'; 
    66 
    77use XAS::Class 
     8  debug     => 0, 
    89  version   => $VERSION, 
    9   base      => 'XAS::Lib::Net::Client', 
     10  base      => 'XAS::Base', 
    1011  codec     => 'JSON', 
    1112  constants => ':jsonrpc', 
    12   messages => { 
    13     jsonerr  => "error code: %s, reason: %s, extended: %s", 
    14     invid    => "the returned id doesn't match the supplied id", 
    15     errorapp => '%s', 
    16   }, 
    17   vars => { 
    18     PARAMS => { 
    19       -port => { optional => 1, default => RPC_DEFAULT_PORT }, 
    20       -host => { optional => 1, default => RPC_DEFAULT_ADDRESS }, 
    21     } 
    22   } 
     13  mixins    => 'call', 
    2314; 
    24  
    25 Params::Validate::validation_options( 
    26     on_fail => sub { 
    27         my $params = shift; 
    28         my $class  = __PACKAGE__; 
    29         XAS::Base::validation_exception($params, $class); 
    30     } 
    31 ); 
    3215 
    3316#use Data::Dumper; 
     
    3922sub call { 
    4023    my $self = shift; 
    41  
    42     my %p = validate(@_, { 
     24    my $p = $self->validate_params(\@_, { 
    4325        -method => 1, 
    4426        -id     => 1, 
     
    4931    my $response; 
    5032 
    51     while (my ($key, $value) = each(%{$p{'-params'}})) { 
     33    while (my ($key, $value) = each(%{$p->{'params'}})) { 
    5234 
    5335        $key =~ s/^-//; 
     
    5840    my $packet = { 
    5941        jsonrpc => RPC_JSON, 
    60         id      => $p{'-id'}, 
    61         method  => $p{'-method'}, 
     42        id      => $p->{'id'}, 
     43        method  => $p->{'method'}, 
    6244        params  => $params 
    6345    }; 
    6446 
    65     $self->put(encode($packet)); 
    66     $response = $self->get(); 
     47    $self->puts(encode($packet)); 
     48    $response = $self->gets(); 
    6749 
    6850    $response = decode($response); 
    6951 
    70     if ($response->{id} eq $p{'-id'}) { 
     52    if ($response->{id} eq $p->{'id'}) { 
    7153 
    7254        if ($response->{error}) { 
     
    7860                $self->throw_msg( 
    7961                    $type, 
    80                     'errorapp', 
     62                    'rpc_errorapp', 
    8163                    $info 
    8264                ); 
     
    8567 
    8668                $self->throw_msg( 
    87                     'xas.lib.mixins.json.client', 
    88                     'jsonerr', 
     69                    'xas.lib.mixin.json.client', 
     70                    'rpc_jsonerr', 
    8971                    $response->{error}->{code}, 
    9072                    $response->{error}->{message}, 
     
    9981 
    10082        $self->throw_msg( 
    101             'xas.lib.mixins.json.client', 
    102             'invid', 
     83            'xas.lib.mixin.json.client', 
     84            'rpc_invid', 
    10385        ); 
    10486 
     
    119101=head1 NAME 
    120102 
    121 XAS::Lib::RPC::JSON::Client - A JSON RPC interface for the XAS environment 
     103XAS::Lib::Mixins::JSON::Client - A mixin for a JSON RPC interface 
    122104 
    123105=head1 SYNOPSIS 
    124106  
    125  my $client = XAS::Lib::RPC::JSON::Client->new( 
     107 package Client 
     108 
     109 use XAS::Class 
     110     debug   => 0, 
     111     version => '0.01', 
     112     base    => 'XAS::Lib::Net::Client', 
     113     mixin   => 'XAS::Lib::Mixins::JSON::Client', 
     114 ; 
     115 
     116 package main 
     117 
     118  my $client = Client->new( 
    126119     -port => 9505, 
    127120     -host => 'localhost', 
     
    140133=head1 DESCRIPTION 
    141134 
    142 This modules implements a simple JSON RPC v2.0 client. It needs be extended 
    143 to be usefull. It doesn't support "Notification" calls. 
     135This modules implements a simple JSON RPC v2.0 client as a mixin. It  
     136doesn't support "Notification" calls. 
    144137 
    145138=head1 METHODS 
    146  
    147 =head2 new 
    148  
    149 This initializes the module. There are three parameters that can be passed.  
    150 They are the following: 
    151  
    152 =over 4 
    153  
    154 =item B<-port> 
    155  
    156 The IP port to connect to (default 9505). 
    157  
    158 =item B<-host> 
    159  
    160 The host to connect to (default 127.0.0.1). 
    161  
    162 =item B<-timeout> 
    163  
    164 An optional timeout, this defaults to 60 seconds. 
    165  
    166 =back 
    167  
    168 =head2 connect 
    169  
    170 Connect to the defined server. 
    171  
    172 =head2 disconnect 
    173  
    174 Disconnect from the defined server. 
    175139 
    176140=head2 call 
  • trunk/lib/XAS/Lib/Mixins/JSON/Server.pm

    reccf84fbcb238727abc24f067428166bae794186 r923373f451ff8825cb260356023de52919dadd40  
    1717  constants => 'HASH ARRAY :jsonrpc', 
    1818  mixins    => 'process_request process_response process_errors  
    19                 _rpc_request _rpc_result _rpc_error methods init_json_server', 
     19                methods init_json_server', 
    2020; 
    2121 
     
    6666            foreach my $r (@$request) { 
    6767 
    68                 $self->_rpc_request($r, $ctx); 
     68                _rpc_request($self, $r, $ctx); 
    6969 
    7070            } 
     
    7272        } else { 
    7373 
    74             $self->_rpc_request($request, $ctx); 
     74            _rpc_request($self, $request, $ctx); 
    7575 
    7676        } 
     
    9595    $self->log->debug("$alias: entering process_response"); 
    9696 
    97     $json = $self->_rpc_result($ctx->{id}, $output); 
     97    $json = _rpc_result($self, $ctx->{id}, $output); 
    9898 
    9999    $poe_kernel->post($alias, 'client_output', encode($json), $ctx); 
     
    109109    $self->log->debug("$alias: entering process_errors"); 
    110110 
    111     $json = $self->_rpc_error($ctx->{id}, $output->{code}, $output->{message}); 
     111    $json = _rpc_error($self, $ctx->{id}, $output->{code}, $output->{message}); 
    112112 
    113113    $poe_kernel->post($alias, 'client_output', encode($json), $ctx); 
     
    134134            if ($type eq ('xas.lib.mixins.json.server.rpc_method')) { 
    135135 
    136                 $packet = $self->_rpc_error($id, RPC_ERR_METHOD, $info); 
     136                $packet = _rpc_error($self, $id, RPC_ERR_METHOD, $info); 
    137137 
    138138            } elsif ($type eq ('xas.lib.mixins.json.server.rpc_version')) { 
    139139 
    140                 $packet = $self->_rpc_error($id, RPC_ERR_REQ, $info); 
     140                $packet = _rpc_error($self, $id, RPC_ERR_REQ, $info); 
    141141 
    142142            } elsif ($type eq ('xas.lib.mixins.json.server.rpc_format')) { 
    143143 
    144                 $packet = $self->_rpc_error($id, RPC_ERR_PARSE, $info); 
     144                $packet = _rpc_error($self, $id, RPC_ERR_PARSE, $info); 
    145145 
    146146            } elsif ($type eq ('xas.lib.mixins.json.server.rpc_notify')) { 
    147147 
    148                 $packet = $self->_rpc_error($id, RPC_ERR_INTERNAL, $info); 
     148                $packet = _rpc_error($self, $id, RPC_ERR_INTERNAL, $info); 
    149149 
    150150            } else { 
    151151 
    152152                my $msg = $type . ' - ' . $info; 
    153                 $packet = $self->_rpc_error($id, RPC_ERR_APP, $msg); 
     153                $packet = _rpc_error($self, $id, RPC_ERR_APP, $msg); 
    154154 
    155155            } 
    156156 
    157             $self->log->error($self->message('exception', $type, $info)); 
     157            $self->log->error_msg('exception', $type, $info); 
    158158 
    159159        } else { 
     
    161161            my $msg = sprintf("%s", $ex); 
    162162 
    163             $packet = $self->_rpc_error($id, RPC_ERR_SERVER, $msg); 
    164             $self->log->error($self->message('unexpected', $msg)); 
     163            $packet = _rpc_error($self, $id, RPC_ERR_SERVER, $msg); 
     164            $self->log->error_msg('unexpected', $msg); 
    165165 
    166166        } 
     
    170170        my $msg = sprintf("%s", $ex); 
    171171 
    172         $packet = $self->_rpc_error($id, RPC_ERR_APP, $msg); 
    173         $self->log->error($self->message('unexpected', $msg)); 
     172        $packet = _rpc_error($self, $id, RPC_ERR_APP, $msg); 
     173        $self->log->error_msg('unexpected', $msg); 
    174174 
    175175    } 
     
    235235        my $ex = $_; 
    236236 
    237         my $output = $self->_exception_handler($ex, $request->{id}); 
     237        my $output = _exception_handler($self, $ex, $request->{id}); 
    238238        $poe_kernel->post($alias, 'client_output', encode($output), $ctx); 
    239239 
     
    299299     if (my $socket = $self->{clients}->{$wheel}->{socket}) { 
    300300 
    301          $self->enable_keepalive($socket) if ($self->tcp_keepalive); 
     301         if ($self->tcp_keepalive) { 
     302 
     303             $self->log->info("keepalive enabled"); 
     304             $self->init_keepalive(); 
     305             $self->enable_keepalive($socket); 
     306 
     307         } 
    302308 
    303309     } 
     
    319325 
    320326     my $self = $class->SUPER::init(@_); 
    321      my @methods = ('echo'); 
     327     my @methods = ['echo']; 
    322328 
    323329     $self->init_json_server(\@methods); 
    324  
    325      $self->init_keepalive() if ($self->tcp_keepalive); 
    326330 
    327331     return $self; 
  • trunk/lib/XAS/Lib/Net/Client.pm

    re22902c645a6255449adf215abdd2c2842c35f0d r923373f451ff8825cb260356023de52919dadd40  
    238238sub setup { 
    239239    my $self = shift; 
    240      
     240 
    241241} 
    242242 
  • trunk/lib/XAS/Msgs/Base.msg

    r91b017ea5b23ccf691f883c7610d7e7a493633a2 r923373f451ff8825cb260356023de52919dadd40  
    6969json_rpc_notify   = the usage of json-rpc notifications is not supported 
    7070curl              = curl error: %s, reason: %s 
    71 xml_error         => %s 
    72 xml_parser        => unable to parse the document 
    73 xml_validate      => unable to validate the document 
     71xml_error         = %s 
     72xml_parser        = unable to parse the document 
     73xml_validate      = unable to validate the document 
     74rpc_jsonerr       = error code: %s, reason: %s, extended: %s 
     75rpc_invid         = the returned id doesn't match the supplied id 
     76rpc_errorapp      = %s 
  • trunk/perl-XAS.spec

    r493dfbe9da731403804599ae7bad95a2bca07fa2 r923373f451ff8825cb260356023de52919dadd40  
    5151 
    5252%build 
    53 %{__perl} Build.PL installdirs=site 
     53%{__perl} Build.PL installdirs=vendor 
    5454./Build 
    5555 
     
    6767./Build install destdir=$RPM_BUILD_ROOT create_packlist=0 
    6868./Build redhat destdir=$RPM_BUILD_ROOT 
     69 
    6970find $RPM_BUILD_ROOT -depth -type d -exec rmdir {} 2>/dev/null \; 
    70  
    7171%{_fixperms} $RPM_BUILD_ROOT/* 
    7272 
     
    103103%defattr(-,root,root,-) 
    104104%doc Changes perl-XAS.spec README 
    105 %{perl_sitelib}/* 
     105%{perl_vendorlib}/* 
    106106%config(noreplace) /etc/profile.d/xas.sh 
    107107/usr/local/share/man/man3/* 
  • trunk/profile.d/xas.bat

    rc91280cb582532e42a6555898e9c3662f7a6c282 r923373f451ff8825cb260356023de52919dadd40  
    2727rem set XAS_ETC="D:\XAS\etc" 
    2828rem set XAS_VAR="D:\var" 
     29rem set XAS_LIB="D:\var\lib" 
    2930rem set XAS_LOG="D:\var\log" 
    3031rem set XAS_RUN="D:\var\run" 
    31 rem set XAS_SPOOL="D:\var/spool" 
     32rem set XAS_SPOOL="D:\var\spool" 
  • trunk/profile.d/xas.sh

    rcee873e2fc762bd73fc3254470e4f650705d4840 r923373f451ff8825cb260356023de52919dadd40  
    1212#export XAS_MXPORT="25" 
    1313#export XAS_MXSERVER="localhost" 
    14 #export XAS_MXMAILER='smtp' 
     14#export XAS_MXMAILER='sendmail' 
    1515# 
    1616#export XAS_MQPORT="61613" 
     
    2121#export XAS_LOGTYPE="console" 
    2222# 
    23 #export XAS_ROOT="/usr" 
     23#export XAS_ROOT="/" 
    2424#export XAS_SBIN="/usr/sbin" 
    2525#export XAS_BIN="/usr/bin" 
    2626#export XAS_ETC="/etc/xas" 
    2727#export XAS_VAR="/var' 
     28#export XAS_LIB="/var/lib/xas" 
    2829#export XAS_LOG="/var/log/xas" 
    2930#export XAS_RUN="/var/run/xas" 
Note: See TracChangeset for help on using the changeset viewer.