File Coverage

blib/lib/Net/API/Telegram/Response.pm
Criterion Covered Total %
statement 16 49 32.6
branch 0 12 0.0
condition 0 6 0.0
subroutine 4 8 50.0
pod 1 2 50.0
total 21 77 27.2


line stmt bran cond sub pod time code
1             # -*- perl -*-
2             ##----------------------------------------------------------------------------
3             ## Telegram API - ~/lib/Net/API/Telegram/Response.pm
4             ## Version v0.200.1
5             ## Copyright(c) 2019 Jacques Deguest
6             ## Author: Jacques Deguest <jack@deguest.jp>
7             ## Created 2019/05/29
8             ## Modified 2024/09/05
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             {
17 1     1   1337 use strict;
  1         3  
  1         80  
18 1     1   8 use HTTP::Status ();
  1         2  
  1         24  
19 1     1   6 use IO::File;
  1         3  
  1         349  
20 1     1   4 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         3 %EXPORT_TAGS = ();
25 1         3 @EXPORT_OK = qw( );
26 1         696 $VERSION = 'v0.200.1';
27             };
28              
29             {
30             # https://core.telegram.org/bots/api
31             $DEBUG = 3;
32             $VERBOSE = 0;
33             }
34              
35             sub init
36             {
37 0     0 1   my $self = shift( @_ );
38 0   0       my $resp = shift( @_ ) || return( $self->error( "No server response was provided." ) );
39 0 0         return( $self->error( "Object provided ($resp) is not a HTTP::Response object." ) ) if( !UNIVERSAL::isa( $resp, 'HTTP::Response' ) );
40 0           $self->{ 'data' } = '';
41 0           $self->SUPER::init( @_ );
42 0 0         if( !$self->{ 'data' } )
43             {
44 0   0       $self->{ 'data' } = $self->data2json( $resp->decoded_content ) ||
45             return( $self->error( "Unable to parse the json data received from server: ", $self->error ) );
46             }
47 0           $self->{ 'resp' } = $resp;
48 0           return( $self );
49             }
50              
51             sub data2json
52             {
53 0     0 0   my $self = shift( @_ );
54 0           my $data = shift( @_ );
55 0           my $unescape = shift( @_ );
56 0 0         return( $self->error( "No data provided to decode into json." ) ) if( !length( $data ) );
57 0 0         if( $unescape )
58             {
59 0           $data =~ s/\\\\r\\\\n/\n/gs;
60 0           $data =~ s/^\"|\"$//gs;
61 0           $data =~ s/\"\[|\]\"//gs;
62             }
63 0           my $json;
64             eval
65 0           {
66 0     0     local $SIG{ '__WARN__' } = sub{ };
67 0     0     local $SIG{ '__DIE__' } = sub{ };
68 0           $json = $self->{ 'json' }->decode( $data );
69             };
70 0 0         if( $@ )
71             {
72 0           my $fh = File::Temp->new( SUFFIX => '.js' );
73 0           my $file = $fh->filename;
74 0   0       my $io = IO::File->new( ">$file" ) || return( $self->error( "Unable to write to file $file: $!" ) );
75 0           $io->binmode( ":utf8" );
76 0           $io->autoflush( 1 );
77 0 0         $io->print( $data ) || return( $self->error( "Unable to write data to json file $file: $!" ) );
78 0           $io->close;
79 0           chmod( 0666, $file );
80 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 ) ) ) );
81             }
82 0           return( $json );
83             }
84              
85             1;
86              
87             __END__