view release on metacpan or  search on metacpan

XMLServer.pm  view on Meta::CPAN

  my $proto = shift;
  my $class = ref($proto) || $proto;
  my $self = {};

  my ($xmlserver, $node, $dir) = @_;
  $self->{field} = new DBIx::XMLServer::Field($xmlserver, $node);
  $self->{dir} = $dir;

  bless($self, $class);
  return $self;
}

sub orderspec {
  my $self = shift;
  my $spec = $self->{field}->select;
  for ($self->{dir}) {
    defined $_ or last;
    /^ascending$/ && do {
      $spec .= ' ASC';
      last;
    };
    /^descending$/ && do {
      $spec .= ' DESC';
      last;
    };
  }
  return $spec;
}

1;

package DBIx::XMLServer::Request;
use Carp;
use Text::Balanced qw(extract_bracketed);

our $VERSION = sprintf '%d.%03d', (q$Revision: 1.19 $ =~ /(\d+)\.(\d+)/);

if ($ lt v5.7)
{
  require Exporter;
  our @ISA = qw(Exporter);
  our @EXPORT = qw(IsNCNameStartChar IsNCNameChar);
}

# Look for an initial segment of the string which looks like an XPath
# pattern
sub get_xpath {
  my $text = shift;

  # Repeatedly skip XPath-like stuff and bracketed things
  while( (extract_bracketed($text, "[(\"'",
			    '[-|@_./:[:alnum:][:space:]]*')) [0]) {};
  # Skip any more XPath-like stuff
  $text =~ m'\G[-|@_./:[:alnum:][:space:]]*'g;

  return substr($text, 0, pos $text), substr($text, pos $text);
}

BEGIN {
  # This hack is because Perl 5.6.1 appears to be buggy and not
  # allow unicode character properties to be declared in a package
  # pther than main.
  our $property_package = $ lt v5.8 ? 'main' : 'DBIx::XMLServer::Request';
  eval <<END_PROPERTIES;
  package $property_package;

  # These are the ranges defined by XML 1.1, as these
  # are more up-to-date w.r.t Unicode those defined by
  # XML 1.0 (3rd ed).  They're also much simpler to specify.
  sub IsNCNameStartChar {
      return <<END;
41	5A
5F
61	7A
C0	D6
D8	F6
F8	2FF
370	37D
37F	1FFF
200C	200D
2070	218F
2C00	2FEF
3001	D7FF
F900	FDCF
FDF0	FFFD
10000	EFFFF
END
  }

  sub IsNCNameChar {
      return <<END;
2D	2E
30	39
41	5A
5F
61	7A
B7
C0	D6
D8	F6
F8	2FF
300	36F
370	37D
37F	1FFF
200C	200D
203F	2040
2070	218F
2C00	2FEF
3001	D7FF
F900	FDCF
FDF0	FFFD
10000	EFFFF
END
  }

END_PROPERTIES
}

# Definition of NCName as per XML Namespaces 1.1
use utf8;
our $NCName = qr/(?:\p{IsNCNameStartChar}\p{IsNCNameChar}*)/;