[open-ils-commits] r854 - grpl/trunk/phone_renewal/lib/TelephoneRenewals (bott)
svn at svn.open-ils.org
svn at svn.open-ils.org
Wed Apr 7 14:37:46 EDT 2010
Author: bott
Date: 2010-04-07 14:37:42 -0400 (Wed, 07 Apr 2010)
New Revision: 854
Added:
grpl/trunk/phone_renewal/lib/TelephoneRenewals/Fieldmapper.pm
grpl/trunk/phone_renewal/lib/TelephoneRenewals/JSON.pm
Modified:
grpl/trunk/phone_renewal/lib/TelephoneRenewals/ERGateway.pm
grpl/trunk/phone_renewal/lib/TelephoneRenewals/EvergreenRenewal.pm
Log:
* Clean up some nasty regex hackery and utilize Fieldmapper calls in their places
* Update the code so it works with 1.6
Modified: grpl/trunk/phone_renewal/lib/TelephoneRenewals/ERGateway.pm
===================================================================
--- grpl/trunk/phone_renewal/lib/TelephoneRenewals/ERGateway.pm 2010-04-05 04:11:39 UTC (rev 853)
+++ grpl/trunk/phone_renewal/lib/TelephoneRenewals/ERGateway.pm 2010-04-07 18:37:42 UTC (rev 854)
@@ -5,6 +5,7 @@
use HTTP::Request::Common;
use JSON;
+use TelephoneRenewals::Fieldmapper;
my %service = (
'ACTOR' => 'open-ils.actor',
@@ -17,8 +18,10 @@
my ($class, $host) = @_;
my $self = {};
$self->{host} = $host;
- $self->{host_url} = "http://$host/gateway";
+ $self->{host_url} = "http://$host/osrf-gateway-v1";
bless $self, ref $class || $class;
+ system ("wget http://$host/reports/fm_IDL.xml -q -O /tmp/IDL.xml");
+ TelephoneRenewals::Fieldmapper->import(IDL => '/tmp/IDL.xml');
return $self;
}
@@ -94,11 +97,9 @@
my $cid = shift;
my $aref = [$cid];
my $res = $self->call_osrf('CIRC','open-ils.circ.fleshed.retrieve',$aref);
- ## The nasty kludge(tm)
- $res =~ s/(.*?S\sacp\-\-\*\/\[)(.*?)(\/\*\-\-S\s.*)/$2/;
- $res =~ s/\"//g;
- my @a = split(/,/,$res);
- return $a[6];
+ my $ac = decode_json $res;
+ my $copy = TelephoneRenewals::Fieldmapper::asset::copy->new($ac->{payload}->[0]->{copy}->{__p});
+ return $copy->barcode;
}
sub get_patron_id_from_circ {
@@ -106,11 +107,9 @@
my $cid = shift;
my $aref = [$cid];
my $res = $self->call_osrf('CIRC','open-ils.circ.fleshed.retrieve',$aref);
- ## The nasty kludge(tm)
- $res =~ s/(.*?S\scirc\-\-\*\/\[)(.*?)(\]\/\*\-\-.*)/$2/;
- $res =~ s/\"//g;
- my @a = split(/,/,$res);
- return $a[24];
+ my $ac = decode_json $res;
+ my $circ = TelephoneRenewals::Fieldmapper::action::circulation->new($ac->{payload}->[0]->{circ}->{__p});
+ return $circ->usr;
}
sub renew_item {
@@ -129,14 +128,13 @@
param=>"$j"
];
my $res = $ua->request($req);
- my $eg_status;
- my $due_date;
- ($eg_status = $res->content) =~ s/.*(textcode)(\":\")(\w*).*/$3/;
- if ($eg_status eq 'SUCCESS') {
- (my $due_date = $res->content) =~ s/.*(S circ--\*\/\[)(.*)(\]).*/$2/;
- my @due = split(/,/, $due_date);
- $due[9] =~ s/(\"\d\d\d\d-)(.*)T.*/$2/;
- $eg_status .= '|' . $due[9];
+ my $circ = decode_json $res->content;
+ my $ac = TelephoneRenewals::Fieldmapper::action::circulation->new($circ->{payload}->[0]->{payload}{circ}->{__p});
+ my $eg_status = $circ->{payload}->[0]->{textcode};
+ my $due_date = $ac->due_date;
+ if ($eg_status eq 'SUCCESS') {
+ $due_date =~ s/(\d\d\d\d-)(.*)(T.*)/$2/;
+ $eg_status .= '|' . $due_date;
}
return $eg_status; # any string other than "SUCCESS" will contain the failure reason
}
Modified: grpl/trunk/phone_renewal/lib/TelephoneRenewals/EvergreenRenewal.pm
===================================================================
--- grpl/trunk/phone_renewal/lib/TelephoneRenewals/EvergreenRenewal.pm 2010-04-05 04:11:39 UTC (rev 853)
+++ grpl/trunk/phone_renewal/lib/TelephoneRenewals/EvergreenRenewal.pm 2010-04-07 18:37:42 UTC (rev 854)
@@ -32,7 +32,7 @@
my $res;
if ($ver =~ /^1-2/){
$res = $self->{erg}->patron_exists($self->{authtoken},$library_card_number);
- }elsif ($ver =~ /^1-4/){
+ }else{
$res = $self->{erg}->get_patron_id($self->{authtoken},$library_card_number);
}
if ( $res eq 'ACTOR_USER_NOT_FOUND' ) {
Added: grpl/trunk/phone_renewal/lib/TelephoneRenewals/Fieldmapper.pm
===================================================================
--- grpl/trunk/phone_renewal/lib/TelephoneRenewals/Fieldmapper.pm (rev 0)
+++ grpl/trunk/phone_renewal/lib/TelephoneRenewals/Fieldmapper.pm 2010-04-07 18:37:42 UTC (rev 854)
@@ -0,0 +1,369 @@
+package TelephoneRenewals::Fieldmapper;
+use TelephoneRenewals::JSON;
+use Data::Dumper;
+use XML::LibXML;
+
+
+use vars qw/$fieldmap $VERSION/;
+
+sub publish_fieldmapper {
+ my ($self,$client,$class) = @_;
+
+ return $fieldmap unless (defined $class);
+ return undef unless (exists($$fieldmap{$class}));
+ return {$class => $$fieldmap{$class}};
+}
+
+
+sub classes {
+ return () unless (defined $fieldmap);
+ return keys %$fieldmap;
+}
+
+sub get_attribute {
+ my $attr_list = shift;
+ my $attr_name = shift;
+
+ my $attr = $attr_list->getNamedItem( $attr_name );
+ if( defined( $attr ) ) {
+ return $attr->getValue();
+ }
+ return undef;
+}
+
+sub load_fields {
+ my $field_list = shift;
+ my $fm = shift;
+
+ # Get attributes of the field list. Since there is only one
+ # <field> per class, these attributes logically belong to the
+ # enclosing class, and that's where we load them.
+
+ my $field_attr_list = $field_list->attributes();
+
+ my $sequence = get_attribute( $field_attr_list, 'oils_persist:sequence' );
+ if( ! defined( $sequence ) ) {
+ $sequence = '';
+ }
+ my $primary = get_attribute( $field_attr_list, 'oils_persist:primary' );
+
+ # Load attributes into the Fieldmapper ----------------------
+
+ $$fieldmap{$fm}{ sequence } = $sequence;
+ $$fieldmap{$fm}{ identity } = $primary;
+
+ # Load each field -------------------------------------------
+
+ my $array_position = 0;
+ for my $field ( $field_list->childNodes() ) { # For each <field>
+ if( $field->nodeName eq 'field' ) {
+
+ my $attribute_list = $field->attributes();
+
+ my $name = get_attribute( $attribute_list, 'name' );
+ next if( $name eq 'isnew' || $name eq 'ischanged' || $name eq 'isdeleted' );
+ my $virtual = get_attribute( $attribute_list, 'oils_persist:virtual' );
+ if( ! defined( $virtual ) ) {
+ $virtual = "false";
+ }
+ my $selector = get_attribute( $attribute_list, 'reporter:selector' );
+
+ $$fieldmap{$fm}{fields}{ $name } =
+ { virtual => ( $virtual eq 'true' ) ? 1 : 0,
+ position => $array_position,
+ };
+
+ # The selector attribute, if present at all, attaches to only one
+ # of the fields in a given class. So if we see it, we store it at
+ # the level of the enclosing class.
+
+ if( defined( $selector ) ) {
+ $$fieldmap{$fm}{selector} = $selector;
+ }
+
+ ++$array_position;
+ }
+ }
+
+ # Load the standard 3 virtual fields ------------------------
+
+ for my $vfield ( qw/isnew ischanged isdeleted/ ) {
+ $$fieldmap{$fm}{fields}{ $vfield } =
+ { position => $array_position,
+ virtual => 1
+ };
+ ++$array_position;
+ }
+}
+
+sub load_links {
+ my $link_list = shift;
+ my $fm = shift;
+
+ for my $link ( $link_list->childNodes() ) { # For each <link>
+ if( $link->nodeName eq 'link' ) {
+ my $attribute_list = $link->attributes();
+
+ my $field = get_attribute( $attribute_list, 'field' );
+ my $reltype = get_attribute( $attribute_list, 'reltype' );
+ my $key = get_attribute( $attribute_list, 'key' );
+ my $class = get_attribute( $attribute_list, 'class' );
+
+ $$fieldmap{$fm}{links}{ $field } =
+ { class => $class,
+ reltype => $reltype,
+ key => $key,
+ };
+ }
+ }
+}
+
+sub load_class {
+ my $class_node = shift;
+
+ # Get attributes ---------------------------------------------
+
+ my $attribute_list = $class_node->attributes();
+
+ my $fm = get_attribute( $attribute_list, 'oils_obj:fieldmapper' );
+ $fm = 'TelephoneRenewals::Fieldmapper::' . $fm;
+ my $id = get_attribute( $attribute_list, 'id' );
+ my $controller = get_attribute( $attribute_list, 'controller' );
+ my $virtual = get_attribute( $attribute_list, 'virtual' );
+ if( ! defined( $virtual ) ) {
+ $virtual = 'false';
+ }
+ my $tablename = get_attribute( $attribute_list, 'oils_persist:tablename' );
+ if( ! defined( $tablename ) ) {
+ $tablename = '';
+ }
+ my $restrict_primary = get_attribute( $attribute_list, 'oils_persist:restrict_primary' );
+
+ # Load the attributes into the Fieldmapper --------------------
+
+
+ $$fieldmap{$fm}{ hint } = $id;
+ $$fieldmap{$fm}{ virtual } = ( $virtual eq 'true' ) ? 1 : 0;
+ $$fieldmap{$fm}{ table } = $tablename;
+ $$fieldmap{$fm}{ controller } = [ split ' ', $controller ];
+ $$fieldmap{$fm}{ restrict_primary } = $restrict_primary;
+
+ # Load fields and links
+
+ for my $child ( $class_node->childNodes() ) {
+ my $nodeName = $child->nodeName;
+ if( $nodeName eq 'fields' ) {
+ load_fields( $child, $fm );
+ } elsif( $nodeName eq 'links' ) {
+ load_links( $child, $fm );
+ }
+ }
+}
+
+import();
+sub import {
+ my $class = shift;
+ my %args = @_;
+
+ return if (keys %$fieldmap);
+ return if (!$args{IDL});
+
+ # parse the IDL ...
+ my $parser = XML::LibXML->new();
+ my $file = $args{IDL} ;
+ my $fmdoc = $parser->parse_file( $file );
+ my $rootnode = $fmdoc->documentElement();
+
+ for my $child ( $rootnode->childNodes() ) { # For each <class>
+ my $nodeName = $child->nodeName;
+ if( $nodeName eq 'class' ) {
+ load_class( $child );
+ }
+ }
+
+ #-------------------------------------------------------------------------------
+ # Now comes the evil! Generate classes
+
+ for my $pkg ( __PACKAGE__->classes ) {
+ (my $cdbi = $pkg) =~ s/^TelephoneRenewals::Fieldmapper:://o;
+
+ eval <<" PERL";
+ package $pkg;
+ use base 'TelephoneRenewals::Fieldmapper';
+ PERL
+
+ if (exists $$fieldmap{$pkg}{proto_fields}) {
+ for my $pfield ( sort keys %{ $$fieldmap{$pkg}{proto_fields} } ) {
+ $$fieldmap{$pkg}{fields}{$pfield} = { position => $pos, virtual => $$fieldmap{$pkg}{proto_fields}{$pfield} };
+ $pos++;
+ }
+ }
+
+ TelephoneRenewals::JSON->register_class_hint(
+ hint => $pkg->json_hint,
+ name => $pkg,
+ type => 'array',
+ );
+
+ }
+}
+
+sub new {
+ my $self = shift;
+ my $value = shift;
+ $value = [] unless (defined $value);
+ return bless $value => $self->class_name;
+}
+
+sub decast {
+ my $self = shift;
+ return [ @$self ];
+}
+
+sub DESTROY {}
+
+sub AUTOLOAD {
+ my $obj = shift;
+ my $value = shift;
+ (my $field = $AUTOLOAD) =~ s/^.*://o;
+ my $class_name = $obj->class_name;
+
+ my $fpos = $field;
+ $fpos =~ s/^clear_//og ;
+
+ my $pos = $$fieldmap{$class_name}{fields}{$fpos}{position};
+
+ if ($field =~ /^clear_/o) {
+ { no strict 'subs';
+ *{$obj->class_name."::$field"} = sub {
+ my $self = shift;
+ $self->[$pos] = undef;
+ return 1;
+ };
+ }
+ return $obj->$field();
+ }
+
+ die "No field by the name $field in $class_name!"
+ unless (exists $$fieldmap{$class_name}{fields}{$field} && defined($pos));
+
+
+ { no strict 'subs';
+ *{$obj->class_name."::$field"} = sub {
+ my $self = shift;
+ my $new_val = shift;
+ $self->[$pos] = $new_val if (defined $new_val);
+ return $self->[$pos];
+ };
+ }
+ return $obj->$field($value);
+}
+
+sub Selector {
+ my $self = shift;
+ return $$fieldmap{$self->class_name}{selector};
+}
+
+sub Identity {
+ my $self = shift;
+ return $$fieldmap{$self->class_name}{identity};
+}
+
+sub RestrictPrimary {
+ my $self = shift;
+ return $$fieldmap{$self->class_name}{restrict_primary};
+}
+
+sub Sequence {
+ my $self = shift;
+ return $$fieldmap{$self->class_name}{sequence};
+}
+
+sub Table {
+ my $self = shift;
+ return $$fieldmap{$self->class_name}{table};
+}
+
+sub Controller {
+ my $self = shift;
+ return $$fieldmap{$self->class_name}{controller};
+}
+
+sub class_name {
+ my $class_name = shift;
+ return ref($class_name) || $class_name;
+}
+
+sub real_fields {
+ my $self = shift;
+ my $class_name = $self->class_name;
+ my $fields = $$fieldmap{$class_name}{fields};
+
+ my @f = grep {
+ !$$fields{$_}{virtual}
+ } sort {$$fields{$a}{position} <=> $$fields{$b}{position}} keys %$fields;
+
+ return @f;
+}
+
+sub has_field {
+ my $self = shift;
+ my $field = shift;
+ my $class_name = $self->class_name;
+ return 1 if grep { $_ eq $field } keys %{$$fieldmap{$class_name}{fields}};
+ return 0;
+}
+
+sub properties {
+ my $self = shift;
+ my $class_name = $self->class_name;
+ return keys %{$$fieldmap{$class_name}{fields}};
+}
+
+sub to_bare_hash {
+ my $self = shift;
+
+ my %hash = ();
+ for my $f ($self->properties) {
+ my $val = $self->$f;
+ $hash{$f} = $val;
+ }
+
+ return \%hash;
+}
+
+sub clone {
+ my $self = shift;
+ return $self->new( [@$self] );
+}
+
+sub api_level {
+ my $self = shift;
+ return $fieldmap->{$self->class_name}->{api_level};
+}
+
+sub cdbi {
+ my $self = shift;
+ return $fieldmap->{$self->class_name}->{cdbi};
+}
+
+sub is_virtual {
+ my $self = shift;
+ my $field = shift;
+ return $fieldmap->{$self->class_name}->{proto_fields}->{$field} if ($field);
+ return $fieldmap->{$self->class_name}->{virtual};
+}
+
+sub is_readonly {
+ my $self = shift;
+ my $field = shift;
+ return $fieldmap->{$self->class_name}->{readonly};
+}
+
+sub json_hint {
+ my $self = shift;
+ return $fieldmap->{$self->class_name}->{hint};
+}
+
+
+1;
Added: grpl/trunk/phone_renewal/lib/TelephoneRenewals/JSON.pm
===================================================================
--- grpl/trunk/phone_renewal/lib/TelephoneRenewals/JSON.pm (rev 0)
+++ grpl/trunk/phone_renewal/lib/TelephoneRenewals/JSON.pm 2010-04-07 18:37:42 UTC (rev 854)
@@ -0,0 +1,280 @@
+package TelephoneRenewals::JSON;
+
+use warnings;
+use strict;
+use JSON::XS;
+
+our $parser = JSON::XS->new;
+$parser->ascii(1); # output \u escaped strings for any char with a value over 127
+$parser->allow_nonref(1); # allows non-reference values to equate to themselves (see perldoc)
+
+our %_class_map = ();
+our $JSON_CLASS_KEY = '__c'; # points to the classname of encoded objects
+our $JSON_PAYLOAD_KEY = '__p'; # same, for payload
+
+
+
+=head1 NAME
+
+OpenSRF::Utils::JSON - Serialize/Vivify objects
+
+=head1 SYNOPSIS
+
+C<O::U::JSON> is a functional-style package which exports nothing. All
+calls to routines must use the fully-qualified name, and expect an
+invocant, as in
+
+ OpenSRF::Utils::JSON->JSON2perl($string);
+
+The routines which are called by existing external code all deal with
+the serialization/stringification of objects and their revivification.
+
+
+
+=head1 ROUTINES
+
+=head2 register_class_hint
+
+This routine is used by objects which wish to serialize themselves
+with the L</perl2JSON> routine. It has two required arguments, C<name>
+and C<hint>.
+
+ O::U::J->register_class_hint( hint => 'osrfException',
+ name => 'OpenSRF::DomainObject::oilsException');
+
+Where C<hint> can be any unique string (but canonically is the name
+from the IDL which matches the object being operated on), and C<name>
+is the language-specific classname which objects will be revivified
+as.
+
+=cut
+
+sub register_class_hint {
+ # FIXME hint can't be a dupe?
+ # FIXME fail unless we have hint and name?
+ # FIXME validate hint against IDL?
+ my ($pkg, %args) = @_;
+ # FIXME maybe not just store a reference to %args; the lookup
+ # functions are really confusing at first glance as a side effect
+ # of this
+ $_class_map{hints}{$args{hint}} = \%args;
+ $_class_map{classes}{$args{name}} = \%args;
+}
+
+
+=head2 JSON2perl
+
+Given a JSON-encoded string, returns a vivified Perl object built from
+that string.
+
+=cut
+
+sub JSON2perl {
+ # FIXME $string is not checked for any criteria, even existance
+ my( $pkg, $string ) = @_;
+ my $perl = $pkg->rawJSON2perl($string);
+ return $pkg->JSONObject2Perl($perl);
+}
+
+
+=head2 perl2JSON
+
+Given a Perl object, returns a JSON stringified representation of that
+object.
+
+=cut
+
+sub perl2JSON {
+ my( $pkg, $obj ) = @_;
+ # FIXME no validation of any sort
+ my $json = $pkg->perl2JSONObject($obj);
+ return $pkg->rawPerl2JSON($json);
+}
+
+
+
+=head1 INTERNAL ROUTINES
+
+=head2 rawJSON2perl
+
+Performs actual JSON -> data transformation, before
+L</JSONObject2Perl> is called.
+
+=cut
+
+sub rawJSON2perl {
+ my ($pkg, $json) = @_;
+ return undef unless (defined $json and $json =~ /\S/o);
+ return $parser->decode($json);
+}
+
+
+=head2 rawPerl2JSON
+
+Performs actual data -> JSON transformation, after L</perl2JSONObject>
+has been called.
+
+=cut
+
+sub rawPerl2JSON {
+ # FIXME is there a reason this doesn't return undef with no
+ # content as rawJSON2perl does?
+ my ($pkg, $perl) = @_;
+ return $parser->encode($perl);
+}
+
+
+=head2 JSONObject2Perl
+
+Routine called by L</JSON2perl> after L</rawJSON2perl> is called.
+
+At this stage, the JSON string will have been vivified as data. This
+routine's job is to turn it back into an OpenSRF system object of some
+sort, if possible.
+
+If it's not possible, the original data (structure), or one very much
+like it will be returned.
+
+=cut
+
+sub JSONObject2Perl {
+ my ($pkg, $obj) = @_;
+
+ # if $obj is a hash
+ if ( ref $obj eq 'HASH' ) {
+ # and if it has the "I'm a class!" marker
+ if ( defined $obj->{$JSON_CLASS_KEY} ) {
+ # vivify the payload
+ my $vivobj = $pkg->JSONObject2Perl($obj->{$JSON_PAYLOAD_KEY});
+ return undef unless defined $vivobj;
+
+ # and bless it back into an object
+ my $class = $obj->{$JSON_CLASS_KEY};
+ $class =~ s/^\s+//; # FIXME pretty sure these lines could condense to 's/\s+//g'
+ $class =~ s/\s+$//;
+ $class = $pkg->lookup_class($class) if $pkg->lookup_class($class);
+ return bless(\$vivobj, $class) unless ref $vivobj;
+ return bless($vivobj, $class);
+ }
+
+ # is a hash, but no class marker; simply revivify innards
+ for my $k (keys %$obj) {
+ $obj->{$k} = $pkg->JSONObject2Perl($obj->{$k})
+ unless ref $obj->{$k} eq 'JSON::XS::Boolean';
+ }
+ } elsif ( ref $obj eq 'ARRAY' ) {
+ # not a hash; an array. revivify.
+ for my $i (0..scalar(@$obj) - 1) {
+ $obj->[$i] = $pkg->JSONObject2Perl($obj->[$i])
+ unless (ref $obj->[$i] eq 'JSON::XS::Boolean');
+ # FIXME? This does nothing except leave any Booleans in
+ # place, without recursively calling this sub on
+ # them. I'm not sure if that's what's supposed to
+ # happen, or if they're supposed to be thrown out of the
+ # array
+ }
+ }
+
+ # return vivified non-class hashes, all arrays, and anything that
+ # isn't a hash or array ref
+ return $obj;
+}
+
+
+=head2 perl2JSONObject
+
+Routine called by L</perl2JSON> before L</rawPerl2JSON> is called.
+
+For OpenSRF system objects which have had hints about their classes
+stowed via L</register_class_hint>, this routine acts as a wrapper,
+encapsulating the incoming object in metadata about itself. It is not
+unlike the process of encoding IP datagrams.
+
+The only metadata encoded at the moment is the class hint, which is
+used to reinflate the data as an object of the appropriate type in the
+L</JSONObject2perl> routine.
+
+Other forms of data more-or-less come out as they went in, although
+C<CODE> or C<SCALAR> references will return what looks like an OpenSRF
+packet, but with a class hint of their reference type and an C<undef>
+payload.
+
+=cut
+
+sub perl2JSONObject {
+ my ($pkg, $obj) = @_;
+ my $ref = ref $obj;
+
+ return $obj unless $ref;
+ return $obj if $ref eq 'JSON::XS::Boolean';
+
+ my $jsonobj;
+
+ if(UNIVERSAL::isa($obj, 'HASH')) {
+ $jsonobj = {};
+ $jsonobj->{$_} = $pkg->perl2JSONObject($obj->{$_}) for (keys %$obj);
+ } elsif(UNIVERSAL::isa($obj, 'ARRAY')) {
+ $jsonobj = [];
+ $jsonobj->[$_] = $pkg->perl2JSONObject($obj->[$_]) for(0..scalar(@$obj) - 1);
+ }
+
+ if($ref ne 'HASH' and $ref ne 'ARRAY') {
+ $ref = $pkg->lookup_hint($ref) if $pkg->lookup_hint($ref);
+ $jsonobj = {$JSON_CLASS_KEY => $ref, $JSON_PAYLOAD_KEY => $jsonobj};
+ }
+
+ return $jsonobj;
+}
+
+
+=head2 lookup_class
+
+Given a class hint, returns the classname matching it. Returns undef
+on failure.
+
+=cut
+
+sub lookup_class {
+ # FIXME when there are tests, see if these two routines can be
+ # rewritten as one, or at least made to do lookup in the structure
+ # they're named after. best case: flatten _class_map, since hints
+ # and classes are identical
+ my ($pkg, $hint) = @_;
+ return undef unless $hint;
+ return $_class_map{hints}{$hint}{name}
+}
+
+
+=head2 lookup_hint
+
+Given a classname, returns the class hint matching it. Returns undef
+on failure.
+
+=cut
+
+sub lookup_hint {
+ my ($pkg, $class) = @_;
+ return undef unless $class;
+ return $_class_map{classes}{$class}{hint}
+}
+
+=head2 true
+
+Wrapper for JSON::XS::true. J::X::true and J::X::false, according to
+its documentation, "are JSON atoms become JSON::XS::true and
+JSON::XS::false, respectively. They are overloaded to act almost
+exactly like the numbers 1 and 0"
+
+=cut
+
+sub true { return $parser->true }
+
+=head2 false
+
+See L</true>
+
+=cut
+
+sub false { return $parser->false }
+
+1;
More information about the open-ils-commits
mailing list