view release on metacpan or  search on metacpan

inc/Module/Install.pm  view on Meta::CPAN

# Whether or not inc::Module::Install is actually loaded, the
# $INC{inc/Module/Install.pm} is what will still get set as long as
# the caller loaded module this in the documented manner.
# If not set, the caller may NOT have loaded the bundled version, and thus
# they may not have a MI version that works with the Makefile.PL. This would
# result in false errors or unexpected behaviour. And we don't want that.
my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
unless ( $INC{$file} ) { die <<"END_DIE" }

Please invoke ${\__PACKAGE__} with:

	use inc::${\__PACKAGE__};

not:

	use ${\__PACKAGE__};

lib/AWS/CloudFront/Distribution.pm  view on Meta::CPAN

);


sub update
{
  my $s = shift;
  
  my $type = 'UpdateDistribution';
  my $response = $s->cf->request( $type, Distribution => $s )->request();
  
  if( $response->error_code )
  {
    die $response->msg;
  }# end if()
}# end update()


sub delete
{
  my $s = shift;
  
  my $type = 'DeleteDistribution';
  my $response = $s->cf->request( $type, Id => $s->Id )->request();
  
  if( $response->error_code )
  {
    die $response->msg;
  }# end if()
}# end delete()


sub create_origin_access_identity
{
  my ($s, %args) = @_;
  
  my $type = 'CreateOriginAccessIdentity';
  my $response = $s->cf->request( $type,
    CallerReference => $s->CallerReference,
    Comment         => $args{Comment}
  )->request();
  
  if( $response->error_code )
  {
    die $response->msg;
  }# end if()
  
  my $xpc = $response->xpc;
  if( my ($node) = $xpc->findnodes('.//cf:CloudFrontOriginAccessIdentity') )
  {
    return AWS::CloudFront::OriginAccessIdentity->new(
      Id                => $xpc->findvalue('.//cf:Id', $node),
      S3CanonicalUserId => $xpc->findvalue('.//cf:S3CanonicalUserId', $node),
      CallerReference   => $xpc->findvalue('.//cf:CallerReference', $node),
      Location          => $response->response->header('Location'),
    );
  }
  elsif( my ($error) = $xpc->findnodes('.//cf:Error') )
  {
    if( my ($code) = $response->response->content =~ m{<Code>(.+?)</Code>}s )
    {
      # The origin already exists or some other error.
      die $code;
    }
    else
    {
      die "Invalid response: ", $response->response->content;
    }# end if()
  }
  else
  {
    die "Invalid response: ", $response->response->content;

lib/AWS/CloudFront/ResponseParser.pm  view on Meta::CPAN

  required  => 1,
);

has 'libxml'  => (
  is        => 'ro',
  isa       => 'XML::LibXML',
  required  => 1,
  default   => sub { XML::LibXML->new() },
);

has 'error_code' => (
  is        => 'rw',
  isa       => 'Str',
  required  => 0,
);

has 'error_message' => (
  is        => 'rw',
  isa       => 'Str',
  required  => 0,
);

has 'xpc' => (
  is        => 'ro',
  isa       => 'XML::LibXML::XPathContext',
  required  => 0,
);

has 'friendly_error' => (
  is        => 'ro',
  isa       => 'Str',
  required  => 0,
  default   => sub {
    my $s = shift;
    return unless $s->error_code || $s->error_message;
    $s->type . " call had errors: [" . $s->error_code . "] " . $s->error_message;
  }
);


sub BUILD
{
  my $s = shift;
  
  my $code = $s->response->code;
  
  # If we got a successful response and nothing was expected, we're done:
  if( $s->expect_nothing )
  {
    if( $code =~ m{^2\d\d} && ! $s->response->content )
    {
      return;
    }
    else
    {
      if( $s->_parse_errors() )
      {
#        die $s->friendly_error();
      }
      else
      {
        return;
      }# end if()
    }# end if()
  }
  else
  {
    $s->{xpc} = $s->_xpc_of_content();
  }# end if()
}# end BUILD()


sub _parse_errors
{
  my ($s) = @_;
  
  my $src = $s->response->content;
  
  # Do not try to parse non-xml:
  unless( $src =~ m/^[[:space:]]*</s )
  {
    ( my $code = $src ) =~ s/^[[:space:]]*\([0-9]*\).*$/$1/s;
    $s->error_code( $code );
    $s->error_message( $src );
    return 1;
  }# end unless()
  
  return 0;
}# end _parse_errors()


sub _xpc_of_content
{
  my ($s) = @_;
  
  my $src = $s->response->content;
  return unless $src =~ m/^[[:space:]]*</s;
  my $doc = $s->libxml->parse_string( $s->response->content );