File Coverage

blib/lib/Net/API/Telegram/Response.pm
Criterion Covered Total %
statement 19 53 35.8
branch 0 12 0.0
condition 0 6 0.0
subroutine 5 9 55.5
pod 1 2 50.0
total 25 82 30.4


line stmt bran cond sub pod time code
1             # -*- perl -*-
2             ##----------------------------------------------------------------------------
3             ## Telegram API - ~/lib/Net/API/Telegram/Response.pm
4             ## Version 0.2
5             ## Copyright(c) 2019 Jacques Deguest
6             ## Author: Jacques Deguest <jack@deguest.jp>
7             ## Created 2019/05/29
8             ## Modified 2019/06/02
9             ## All rights reserved
10             ##
11             ## This program is free software; you can redistribute it and/or modify it
12             ## under the same terms as Perl itself.
13             ##----------------------------------------------------------------------------
14             package Net::API::Telegram::Response;
15             BEGIN
16 0           {
17 1     1   1081 use strict;
  1         5  
  1         29  
18 1     1   10 use HTTP::Status ();
  1         2  
  1         16  
19 1     1   5 use IO::File;
  1         3  
  1         234  
20 1     1   78 our( $VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS );
21 1         2 our( $VERBOSE, $DEBUG );
22 1         21 @ISA = qw( Module::Generic );
23 1         4 @EXPORT = qw( );
24 1         2 %EXPORT_TAGS = ();
25 1         1 @EXPORT_OK = qw( );
26 1         630 $VERSION = '0.2';
27 1     1   8 use Devel::Confess;
  1         11  
  1         9  
28             };
29              
30             {
31             ## https://core.telegram.org/bots/api
32             $DEBUG = 3;
33             $VERBOSE = 0;
34             }
35              
36             sub init
37             {
38 0     0 1   my $self = shift( @_ );
39 0   0       my $resp = shift( @_ ) || return( $self->error( "No server response was provided." ) );
40 0 0         return( $self->error( "Object provided ($resp) is not a HTTP::Response object." ) ) if( !UNIVERSAL::isa( $resp, 'HTTP::Response' ) );
41 0           $self->{ 'data' } = '';
42 0           $self->SUPER::init( @_ );
43 0 0         if( !$self->{ 'data' } )
44             {
45 0   0       $self->{ 'data' } = $self->data2json( $resp->decoded_content ) ||
46             return( $self->error( "Unable to parse the json data received from server: ", $self->error ) );
47             }
48 0           $self->{ 'resp' } = $resp;
49 0           return( $self );
50             }
51              
52             sub data2json
53             {
54 0     0 0   my $self = shift( @_ );
55 0           my $data = shift( @_ );
56 0           my $unescape = shift( @_ );
57 0 0         return( $self->error( "No data provided to decode into json." ) ) if( !length( $data ) );
58 0 0         if( $unescape )
59             {
60 0           $data =~ s/\\\\r\\\\n/\n/gs;
61 0           $data =~ s/^\"|\"$//gs;
62 0           $data =~ s/\"\[|\]\"//gs;
63             }
64 0           my $json;
65             eval
66 0           {
67 0     0     local $SIG{ '__WARN__' } = sub{ };
68 0     0     local $SIG{ '__DIE__' } = sub{ };
69 0           $json = $self->{ 'json' }->decode( $data );
70             };
71 0 0         if( $@ )
72             {
73 0           my $fh = File::Temp->new( SUFFIX => '.js' );
74 0           my $file = $fh->filename;
75 0   0       my $io = IO::File->new( ">$file" ) || return( $self->error( "Unable to write to file $file: $!" ) );
76 0           $io->binmode( ":utf8" );
77 0           $io->autoflush( 1 );
78 0 0         $io->print( $data ) || return( $self->error( "Unable to write data to json file $file: $!" ) );
79 0           $io->close;
80 0           chmod( 0666, $file );
81 0           return( $self->error( sprintf( "An error occured while attempting to parse %d bytes of data into json: $@\nFailed raw data was saved in file $file", length( $data ) ) ) );
82             }
83 0           return( $json );
84             }
85              
86             1;
87              
88             __END__