File Coverage

blib/lib/Net/SharePoint/Basic.pm
Criterion Covered Total %
statement 176 319 55.1
branch 52 118 44.0
condition 37 121 30.5
subroutine 30 42 71.4
pod 25 25 100.0
total 320 625 51.2


line stmt bran cond sub pod time code
1             package Net::SharePoint::Basic;
2              
3             # Copyright 2018 VMware, Inc.
4             # SPDX-License-Identifier: Artistic-1.0-Perl
5              
6 19     19   1114666 use 5.10.1;
  19         284  
7 19     19   84 use strict;
  19         31  
  19         446  
8 19     19   75 use warnings FATAL => 'all';
  19         33  
  19         725  
9 19     19   9351 use utf8;
  19         235  
  19         82  
10              
11 19     19   591 use Carp qw(carp croak confess cluck longmess shortmess);
  19         35  
  19         1186  
12 19     19   100 use File::Basename;
  19         33  
  19         1292  
13 19     19   7562 use IO::Scalar;
  19         192324  
  19         794  
14 19     19   9502 use Storable;
  19         47622  
  19         930  
15              
16 19     19   7252 use Data::UUID;
  19         9421  
  19         1024  
17 19     19   142 use File::Path;
  19         39  
  19         794  
18 19     19   10691 use JSON::XS;
  19         81129  
  19         993  
19 19     19   10483 use LWP::UserAgent;
  19         803822  
  19         754  
20 19     19   8752 use POSIX qw(strftime);
  19         103823  
  19         113  
21 19     19   23125 use URI::Escape;
  19         40  
  19         935  
22              
23 19     19   10068 use Data::Dumper;
  19         107202  
  19         1099  
24              
25 19     19   131 use base 'Exporter';
  19         35  
  19         76190  
26              
27             our @EXPORT = qw(
28             $DEFAULT_SHAREPOINT_TOKEN_FILE $DEFAULT_SHAREPOINT_CONFIG_FILE
29             $DEFAULT_RETRIES $DEFAULT_CHUNK_SIZE $MAX_LOG_SIZE
30             );
31              
32             =head1 NAME
33              
34             Net::SharePoint::Basic - Basic interface to Microsoft SharePoint REST API
35              
36             =head1 VERSION
37              
38             Version 0.13
39              
40             =cut
41              
42             our $VERSION = '0.13';
43              
44             our %PATTERNS = (
45             payload => "grant_type=client_credentials&client_id=%1\$s\@%3\$s&client_secret=%2\$s&resource=%4\$s/%5\$s\@%3\$s&scope=%4\$s/%5\$s\@%3\$s",
46             upload => "https://%1\$s/%2\$s/_api/web/GetFolderByServerRelativeUrl('/%2\$s/Shared Documents/%4\$s')/files/add(overwrite=true,url='%3\$s')",
47             download => "https://%1\$s/%2\$s/_api/web/GetFolderByServerRelativeUrl('/%2\$s/Shared Documents/%4\$s')/files('%3\$s')/\$value",
48             makedir => "https://%1\$s/%2\$s/_api/SP.AppContextSite(\@target)/web/folders/add('Shared Documents/%4\$s')?\@target='https://%1\$s/%2\$s'",
49             delete => "https://%1\$s/%2\$s/_api/web/GetFolderByServerRelativeUrl('/%2\$s/Shared Documents/%3\$s')/recycle",
50             list => {
51             files => "https://%1\$s/%2\$s/_api/web/GetFolderByServerRelativeUrl('/%2\$s/Shared Documents/%3\$s')/Files",
52             folders => "https://%1\$s/%2\$s/_api/web/GetFolderByServerRelativeUrl('/%2\$s/Shared Documents/%3\$s')/Folders",
53             },
54             chunk => {
55             start => "https://%1\$s/%2\$s/_api/web/GetFileByServerRelativeUrl('/%2\$s/Shared Documents/%4\$s/%3\$s')/startupload(uploadId=guid'%5\$s')",
56             continue => "https://%1\$s/%2\$s/_api/SP.AppContextSite(\@target)/web/GetFileByServerRelativeUrl('/%2\$s/Shared Documents/%4\$s/%3\$s')/continueupload(uploadId=guid'%5\$s', fileOffset='%6\$s')?\@target='https://%1\$s/%2\$s'",
57             finish => "https://%1\$s/%2\$s/_api/SP.AppContextSite(\@target)/web/GetFileByServerRelativeUrl('/%2\$s/Shared Documents/%4\$s/%3\$s')/finishupload(uploadId=guid'%5\$s', fileOffset='%6\$s')?\@target='https://%1\$s/%2\$s'",
58             },
59             move => "https://%1\$s/%2\$s/_api/SP.AppContextSite(\@target)/web/GetFileByServerRelativeUrl('/%2\$s/Shared Documents/%3\$s')/moveto(newurl='/%2\$s/Shared Documents/%4\$s', flags=1)?\@target='https://%1\$s/%2\$s'",
60             copy => "https://%1\$s/%2\$s/_api/SP.AppContextSite(\@target)/web/GetFileByServerRelativeUrl('/%2\$s/Shared Documents/%3\$s')/copyto(strnewurl='/%2\$s/Shared Documents/%4\$s', boverwrite=true)?\@target='https://%1\$s/%2\$s'",
61             );
62             our $DEFAULT_SHAREPOINT_TOKEN_FILE = '/var/run/sharepoint.token';
63             our $DEFAULT_SHAREPOINT_CONFIG_FILE = '/etc/sharepoint.conf';
64              
65             our %DEFAULT_SHAREPOINT_POST_PARAMS = (
66             Accept => 'application/json;odata=verbose',
67             Content_Type => 'application/json;odata=verbose',
68             );
69             our $MAX_LOG_SIZE = 500000;
70             our $DEFAULT_CHUNK_SIZE = 200000000;
71             our $DEFAULT_RETRIES = 3;
72              
73             =head1 SYNOPSIS
74              
75             Net::SharePoint::Basic - Basic interface to Microsoft SharePoint REST API.
76              
77             This module provides a basic interface for managing the Shared Documents catalog in the Microsoft SharePoint site via its REST API. In the current version only the following actions are supported:
78              
79             * generating a connection token
80             * upload file or string
81             * download file content and save it
82             * list contents of folder
83             * create new folder
84             * delete file or folder
85              
86             More actions are expected to be added in the future as well as we plan to increase the versatility of the arguments accepted by this module and the sample implementation of a client, 'sp-client', that comes with it.
87              
88             The interface is object oriented. A few constants are exported.
89              
90             The full testing (and naturally the full usage) of the module requires a working SharePoint site configuration. The structure of the configuration file will be described in this manual as well. The sample configuration file provided in this distribution will not work against SharePoint and plays the role of a placeholder only.
91              
92             use Net::SharePoint::Basic;
93              
94             my $sp = Net::SharePoint::Basic->new({config_file => 'sharepoint.conf'});
95             # creates Shared Documents/test
96             my $response = $sp->makedir({retries => 1}, '/test');
97             # uploads a string as Shared Documents/test/teststring
98             $sp->upload({}, '/test/teststring', 'abcd');
99             # uploads a file 'testfile' into Shared Documents/test/
100             $sp->upload({type => 'file'}, '/test/', 'testfile');
101             # downloads contents of a file
102             $sp->download({}, '/test/teststring');
103             # downloads contents and saves it to a file
104             $sp->download({save_file => 'testfile'}, '/test/teststring');
105             # lists contents of a folder
106             $sp->list({}, '/test');
107             # deletes the folder
108             $sp->delete({}, '/test');
109             # moves an object
110             $sp->move({}, '/test-file', '/test-moved-file');
111             # copies an object
112             $sp->copy({}, '/test-moved-file', '/test-file');
113              
114             This module was developed based on the MSDN SharePoint REST API at https://msdn.microsoft.com/en-us/library/office/jj860569.aspx .
115              
116             =head1 EXPORT
117              
118             The following constants (all can be overridden through either configuration file or constructor options) are exported:
119              
120             =over
121              
122             =item $DEFAULT_SHAREPOINT_TOKEN_FILE
123              
124             The default location of the authorization token file (/var/run/sharepoint.token'
125              
126             =item $DEFAULT_SHAREPOINT_CONFIG_FILE
127              
128             The default location of the SharePoint portal configuration (/etc/sharepoint.conf)
129              
130             =item $DEFAULT_RETRIES
131              
132             The default number of retries to perform a REST action (3)
133              
134             =item $DEFAULT_CHUNK_SIZE
135              
136             The default chunk size for uploading large items. (200000000 bytes)
137              
138             =item $MAX_LOG_SIZE
139              
140             The maxium number of logged actions to keep (see C method (500000)
141              
142             =back
143              
144             =head1 CONFIGURATION FILE
145              
146             The module can work with a configuration file of the following format:
147              
148             configuration_option value
149              
150             The lines starting with '#' are ignored. The multiline values can be broken by using a backslash '\' sign. A sample configuration file is provided in the 't/' directory. It will NOT work with a Microsoft SharePoint instance, it is a placeholder file, useful only for internal tests. The default location of the configuration file assumed by the module is /etc/sharepoint.conf . The recognized options in the configuration file are:
151              
152             * module configuration:
153             o token_file - where to store the SharePoint token
154             o max_log_size - maximum log size of $object->{log} (q.v.)
155             o retries - number of retries
156             o chunk_size - size of a chunk for upload in chunks of large files
157             * SharePoint configuration:
158             o sharepoint_client_id - UUID of this client for SharePoint
159             o sharepoint_client_secret - client secret for generating the access token
160             o sharepoint_tenant_id - UUID of the SharePoint tenant
161             o sharepoint_principal_id - UUID of the SharePoint principal
162             o sharepoint_host - the hostname of the SharePoint portal
163             o sharepoint_site - the site to work with in SharePoint
164             o sharepoint_access_url - URL to request the token from
165              
166             =cut
167              
168             =head1 ENVIROMENT VARIABLES
169              
170             The following environment variables control the SharePoint client's behavior, for the purpose of debugging output:
171              
172             * NET_SHAREPOINT_VERBOSE - enable verbose output
173             * NET_SHAREPOINT_DEBUG - enable debug output
174              
175             =cut
176              
177             =head1 SUBROUTINES/METHODS
178              
179             =head2 verbose ($)
180              
181             Utility function printing some extra messages. Newline is automatically appended.
182             Parameters: the message to print (if a verbosity setting is on).
183             Returns: void
184              
185             =cut
186              
187             sub verbose ($) {
188              
189 4     4 1 3470 my $message = shift;
190 4         14 binmode STDERR, ':utf8';
191 4 100 100     97 print STDERR "$message\n" if $ENV{NET_SHAREPOINT_VERBOSE} || $ENV{NET_SHAREPOINT_DEBUG};
192             }
193              
194             =head2 debug ($)
195              
196             Utility function printing some debug messages. Newline is automatically appended.
197             Parameters: the message to print (if a verbosity setting is on).
198             Returns: void
199              
200             =cut
201              
202             sub debug ($) {
203              
204 10     10 1 3865 my $message = shift;
205 10 100       70 print STDERR "$message\n" if $ENV{NET_SHAREPOINT_DEBUG};
206             }
207              
208             =head2 timedebug ($)
209              
210             Utility function printing some debug messages with timestamp prepended. Newline is automatically appended.
211             Parameters: the message to print (if a verbosity setting is on).
212             Returns: void
213              
214             =cut
215              
216             sub timedebug ($) {
217              
218 1     1 1 1289 my $message = shift;
219 1 50       65 (print STDERR localtime(time) . " $message\n") if $ENV{NET_SHAREPOINT_DEBUG};
220             }
221              
222             =head2 version (;$)
223              
224             Utility function returning the version of the package
225             Parameters: Do not exit after printing version (optional)
226             Returns: never.
227              
228             =cut
229              
230             sub version (;$) {
231              
232 1     1 1 1247 print $VERSION, "\n";
233 1 50       8 exit 0 unless shift;
234             }
235              
236             =head2 read_file ($)
237              
238             Utility function that reads file into a string or dies if the file is not available.
239             Parameters: the file to read
240             Returns: the contents of the file as a string
241              
242             =cut
243              
244             sub read_file ($) {
245              
246 2     2 1 1405 my $file = shift;
247              
248 2         9 local $/ = undef;
249 2         9 debug "Reading $file";
250 2 100       95 open(my $mail_fh, '<', $file) or die "Can't read file $file: $!";
251 1         25 my $content = <$mail_fh>;
252 1         11 close $mail_fh;
253              
254 1         7 $content;
255             }
256              
257             =head2 write_file ($$;$)
258              
259             Utility function thgat writes the given string into a file, creating the necessary directories above it if necessary. Dies if the write is unsuccessful.
260             Parameters: the contents
261             the file to write
262             [optional] force binary mode in writing
263             Returns: the file path that was written.
264              
265             =cut
266              
267             sub write_file ($$;$) {
268              
269 1     1 1 957 my $content = shift;
270 1         3 my $file = shift;
271 1   50     6 my $binary = shift || 0;
272              
273 1         26 my $dir = dirname($file);
274 1 50       153 mkpath($dir) unless -d $dir;
275 1 50   1   33 open my $fh, $binary ? '>:raw' : '>:encoding(utf8)', $file or die "Couldn't open file $file for writing: $!";
  1 50       6  
  1         2  
  1         6  
276 1 50       9628 binmode $fh if $binary;
277 1         11 print $fh $content;
278 1         55 close $fh;
279 1         8 verbose "Wrote file $file";
280 1         6 $file;
281             }
282              
283             =head2 read_config ($)
284              
285             Utility function that reads the sharepoint configuration file of whitespace separated values. See the detailed description of C
286             Parameters: the configuration file
287             Returns: Hash of configuration parameters and their values.
288              
289             =cut
290              
291             sub read_config ($) {
292              
293 5     5 1 74 my $config_file = shift;
294 5         8 my $config = {};
295              
296 5 50       195 open(my $conf_fh, '<', $config_file) or return 0;
297 5         143 while (<$conf_fh>) {
298 40 100       86 next if /^\#/;
299 38 100       83 next unless /\S/;
300 36         58 s/^\s+//;
301 36         105 s/\s+$//;
302 36         103 my ($key, $value) = split(/\s+/, $_, 2);
303 36 100       67 unless ($value) {
304 2         5 $config->{$key} = undef;
305 2         5 next;
306             }
307 34         44 chomp $value;
308 34         72 while ($value =~ /\\$/) {
309 6         16 my $extra_value = <$conf_fh>;
310 6 50       15 next if $extra_value =~ /^\#/;
311 6 50       14 next unless $extra_value =~ /\S/;
312 6         15 $extra_value =~ s/^\s+//;
313 6         16 $extra_value =~ s/\s+$//;
314 6         12 chop $value;
315 6         15 $value =~ s/\s+$//;
316 6         16 $value .= " $extra_value";
317             }
318 34         145 $config->{$key} = $value;
319             }
320 5         64 close $conf_fh;
321 5         33 return $config;
322             }
323              
324             =head2 new ($;$)
325              
326             The constructor. Creates the Net::SharePoint::Basic object
327             Parameters: optional hash with keys corresponding to the configuration file fields. Will override even the given a specific configuration file.
328             Returns: Net::SharePoint::Basic object.
329              
330             =cut
331              
332             sub new ($;$) {
333              
334 8     8 1 2464 my $class = shift;
335 8   100     28 my $opts = shift || {};
336              
337 8         15 my $self = {};
338 8 100       23 if ($opts->{config_file}) {
339 4         14 $self->{config} = read_config($opts->{config_file});
340             }
341             else {
342 4 50       93 $self->{config} = read_config($DEFAULT_SHAREPOINT_CONFIG_FILE)
343             if -f $DEFAULT_SHAREPOINT_CONFIG_FILE;
344             }
345 8   100     42 $self->{config} ||= {};
346 8         12 for my $key (keys %{$opts}) {
  8         31  
347 9 100       27 next if $key eq 'config_file';
348 5 50       11 next unless defined $opts->{$key};
349 5         21 debug "Setting $key to $opts->{$key}";
350 5         18 $self->{config}{$key} = $opts->{$key};
351             }
352 8         20 $self->{token} = { ts => 0 };
353 8         16 $self->{next_guid} = 1;
354 8   66     37 $self->{config}{token_file} ||= $DEFAULT_SHAREPOINT_TOKEN_FILE;
355 8   66     39 $self->{config}{max_log_size} ||= $MAX_LOG_SIZE;
356 8   66     31 $self->{config}{chunk_size} ||= $DEFAULT_CHUNK_SIZE;
357 8   33     36 $self->{config}{retries} ||= $DEFAULT_RETRIES;
358 8   33     64 $ENV{NET_SHAREPOINT_DEBUG} ||= $opts->{debug};
359 8   33     49 $ENV{NET_SHAREPOINT_VERBOSE} ||= $opts->{verbose};
360 8         18 bless $self, $class;
361 8         32 $self;
362             }
363              
364             =head2 dump_config ($)
365              
366             Dumps the supplied config and exits
367             Arguments: the options hash
368             Returns: void
369             Caveat: will dump the credentials as well. Use with caution.
370              
371             =cut
372              
373             sub dump_config ($) {
374              
375 11     11 1 13671 my $self = shift;
376              
377 11         18 for my $opt (keys %{$self->{config}}) {
  11         39  
378 121   50     1779 printf "%-25s %s\n", $opt, $self->{config}{$opt} || 'undef';
379             }
380             }
381              
382             =head2 validate_config ($;@)
383              
384             Validates the configuration for the SharePoint client. Checks basic syntactic requirements for the key configuration parameters expected to make connection with the REST API.
385             Parameters: [optional] a list of extra options that would require to be defined by the application
386             Returns: Error string if there was an error, empty string otherwise.
387              
388             =cut
389              
390             sub validate_config ($;@) {
391              
392 2     2 1 1524 my $self = shift;
393 2         6 my @extra_opts = @_;
394              
395 2         4 my $opts = $self->{config};
396 2         4 my $validated = '';
397              
398 2 50       7 return "Config was not found\n" unless $opts;
399 2         6 for my $id (qw(sharepoint_client_id sharepoint_tenant_id sharepoint_principal_id)) {
400 6 100       23 if (! $opts->{$id}) {
    50          
401 3         8 $validated .= "Missing $id in configuration\n";
402             }
403             elsif ($opts->{$id} !~ /^\w{8}-\w{4}-\w{4}-\w{4}-\w{12}$/) {
404 0         0 $validated .= "Badly formatted $id $opts->{$id} in configuration\n";
405             }
406             }
407             $validated .= "SharePoint secret must be 44-char string ending with =\n"
408             unless $opts->{sharepoint_client_secret}
409 2 100 66     15 && $opts->{sharepoint_client_secret} =~ /^(\S){43}\=/;
410             $validated .= "SharePoint access URL must start with https://\n"
411             unless $opts->{sharepoint_access_url}
412 2 100 66     12 && $opts->{sharepoint_access_url} =~ m|^https://|;
413             $validated .= "SharePoint host must be defined\n"
414 2 100       7 unless $opts->{sharepoint_host};
415             $validated .= "SharePoint Site must include 'sites' in the URL\n"
416             unless $opts->{sharepoint_site}
417 2 100 66     12 && $opts->{sharepoint_site} =~ m|^sites/.+|;
418 2         5 for my $extra_opt (@extra_opts) {
419             $validated .= "Option $extra_opt must be set according to the app"
420 0 0       0 unless $opts->{$extra_opt};
421             }
422 2         11 return $validated;
423             }
424              
425             =head2 log_it ($$;$)
426              
427             Log a message into the object. The messages are stored in the $object->{log} array reference. If the amount of messages exceeds $MAX_LOG_SIZE or $self->{config}{max_log_size} (if set), the older messages are shifted out of the log.
428             Parameters: the message
429             [optional] the severity (default - 'info')
430             Returns: the shifted discarded message if any
431              
432             =cut
433              
434             sub log_it ($$;$) {
435              
436 3     3 1 3985 my $self = shift;
437 3         5 my $message = shift;
438 3   50     8 my $severity = shift || 'info';
439              
440 3   100     13 $self->{log} ||= [];
441 3         4 push(@{$self->{log}}, [
  3         9  
442             time, $severity, $message
443             ]);
444 3 100       4 shift @{$self->{log}} if @{$self->{log}} > $self->{config}{max_log_size};
  1         2  
  3         10  
445             }
446              
447             =head2 create_payload ($)
448              
449             Creates an authorization request payload
450             Arguments: the options hashref containing the sharepoint data
451             Returns: the escaped payload
452              
453             =cut
454              
455             sub create_payload ($) {
456              
457 1     1 1 6 my $self = shift;
458              
459             my $payload = sprintf(
460             $PATTERNS{payload},
461             $self->{config}{sharepoint_client_id},
462             $self->{config}{sharepoint_client_secret},
463             $self->{config}{sharepoint_tenant_id},
464             $self->{config}{sharepoint_principal_id},
465             $self->{config}{sharepoint_host}
466 1         12 );
467 1         5 uri_escape($payload, "^A-Za-z0-9\-\._~\&\=");
468             }
469              
470             =head2 update_token ($$)
471              
472             Updates the SharePoint Token
473             Arguments: the options hashref containing sharepoint data
474             Returns: 1 upon success
475             undef upon failure
476              
477             =cut
478              
479             sub update_token ($) {
480              
481 0     0 1 0 my $self = shift;
482              
483 0   0     0 $self->{ua} ||= LWP::UserAgent->new();
484 0   0     0 $self->{token}{payload} ||= $self->create_payload();
485 0         0 verbose "Getting a fresh token";
486             my $token_response = $self->{ua}->post(
487             $self->{config}{sharepoint_access_url},
488             Content_Type => 'application/x-www-form-urlencoded',
489             Content => $self->{token}{payload}
490 0         0 );
491 0 0       0 unless ($token_response->is_success) {
492 0         0 $self->log_it(
493             "Updating token failed: " .
494             Dumper decode_json($token_response->content),
495             'error'
496             );
497 0         0 return undef;
498             }
499 0         0 my $json = decode_json($token_response->content);
500 0         0 $self->{token}{ts} = $json->{expires_on};
501 0         0 $self->{token}{token} = $json->{access_token};
502 0         0 $self->{token}{type} = $json->{token_type};
503 0         0 1;
504             }
505              
506              
507             =head2 init_token ($)
508              
509             Initializes a SharePoint token ( by calling ->update_token() ) and stores it in the $self->{config}{token_file}
510             Parameters: none
511             Returns: 1 if success
512             undef if failure
513              
514             =cut
515              
516             sub init_token ($) {
517              
518 0     0 1 0 my $self = shift;
519              
520 0         0 my $token_file = $self->{config}{token_file};
521 0 0       0 if (-f $token_file) {
522 0         0 $self->log_it("Trying to use token file $token_file", 'debug');
523 0         0 $self->{token} = retrieve $token_file;
524             return undef if (
525 0 0 0     0 time > $self->{token}{ts} - 1200
526             ) and ! $self->update_token();
527             }
528             else {
529 0 0       0 return undef unless $self->update_token();
530             }
531 0         0 store $self->{token}, $token_file;
532             $DEFAULT_SHAREPOINT_POST_PARAMS{Authorization} =
533 0         0 "$self->{token}{type} $self->{token}{token}";
534 0         0 1;
535             }
536              
537             =head2 create_sharepoint_url ($$;@)
538              
539             Creates the SharePoint URL to operate against, filling the relevant pattern with the actual data.
540             Parameters: the options hashref of the following keys
541             pattern - the ready pattern (usually used in chunk upload) - or
542             type - the type of the pattern
543             (upload, download, list, makedir, delete) and
544             subtype (for list only) - "files" or "folders"
545             folder - the sharepoint folder/path to operate upon
546             object - the sharepoint object to operate upon
547             See %PATTERNS in the source code for more details on the URL construction.
548             Returns: the filled URL string
549              
550             =cut
551              
552             sub create_sharepoint_url ($$;@) {
553              
554 39     39 1 17601 my $self = shift;
555 39         51 my $opts = shift;
556              
557 39 100 33     187 return undef unless $opts && ($opts->{pattern} || $opts->{type});
      66        
558 38   100     91 my $folder = $opts->{folder} || '';
559 38 50       70 $folder = '.' if $folder eq '/';
560 38   100     75 my $object = $opts->{object} || '';
561 38         58 my @extra_args = @_;
562 38         46 my $pattern = $opts->{pattern};
563 38 50       65 if (! $pattern) {
564 38 100       82 if (! $PATTERNS{$opts->{type}}) {
565 1         91 warn "Unknown type $opts->{type} of URL requested";
566 1         10 return undef;
567             }
568 37 100       83 if (ref $PATTERNS{$opts->{type}}) {
569 21 100 66     72 if (! $opts->{subtype} || ! $PATTERNS{$opts->{type}}->{$opts->{subtype}}) {
570 1         73 warn "Pattern type $opts->{type} requires a valid subtype";
571 1         18 return undef;
572             }
573 20         38 $pattern = $PATTERNS{$opts->{type}}->{$opts->{subtype}};
574             }
575             else {
576 16         24 $pattern = $PATTERNS{$opts->{type}};
577             }
578             }
579             $pattern =~
580 0         0 s|Shared Documents|"Shared Documents/$self->{config}{base_subfolder}"|ge
581 36 50       76 if $self->{config}{base_subfolder};
582             my $url = sprintf(
583             $pattern,
584             $self->{config}{sharepoint_host},
585             $self->{config}{sharepoint_site},
586 36   33     184 $object // (),
587             $folder, @extra_args,
588             );
589              
590 36         88 $url;
591             }
592              
593             =head2 try ($$$%)
594              
595             Tries to execute a SharePoint REST API call
596             Parameters: the options hashref with the following parameters:
597             action - mandatory, one of upload, download, list, makedir, delete,
598             chunk_upload_start, chunk_upload_continue, chunk_upload_finish
599             retries - optional, number of retries defaults to $DEFAULT_RETRIES
600             the url to try
601             extra http header options hash:
602             Accept => 'application/json;odata=verbose',
603             Content_Type => 'application/json;odata=verbose',
604             Authorization => 'Bearer TOKEN_STRING',
605             and for upload also:
606             Content_Length => length($data),
607             Content => $data,
608             Returns: the HTTP response if the API call was successful
609             undef otherwise
610              
611             =cut
612              
613             sub try ($$$%) {
614              
615 0     0 1 0 my $self = shift;
616 0         0 my $opts = shift;
617 0         0 my $url = shift;
618 0         0 my %http_opts = @_;
619              
620 0   0     0 $self->{ua} ||= LWP::UserAgent->new();
621 0   0     0 $opts->{retries} ||= $DEFAULT_RETRIES;
622              
623 0 0 0     0 my $method = $opts->{action} eq 'download' || $opts->{action} eq 'list' ?
624             'get' : 'post';
625 0         0 while ($opts->{retries}) {
626 0 0       0 unless ($self->init_token()) {
627 0         0 $self->log_it("Failed to initialize token", "error");
628 0         0 die "Failed to initialize token: $self->{log}[-2][2]";
629             }
630 0         0 debug "Trying url $url";
631 0   0     0 $http_opts{Authorization} ||= $DEFAULT_SHAREPOINT_POST_PARAMS{Authorization};
632 0         0 my $response = $self->{ua}->$method($url, %http_opts);
633 0 0       0 if ($response->is_success) {
634 0         0 $self->log_it("Item $opts->{action} successful");
635 0         0 return $response;
636             }
637 0         0 $opts->{retries}--;
638 0         0 $self->log_it(
639             "Couldn't $opts->{action} item ($opts->{retries} attempts remaining).\n" . $response->content, 'error'
640             );
641             }
642 0         0 return undef;
643             }
644              
645             =head2 get_chunk_pattern ($$)
646              
647             Selects correct pattern for uploading a chunk, depending on the stage of the upload.
648             Parameters: the chunk's number (0..N)
649             the number of total chunks (N)
650             Returns: the start upload pattern for the first chunk
651             the finish upload pattern for the last chunk
652             the continue upload pattern for the rest
653             Caveat: uses when() feature.
654              
655             =cut
656              
657             sub get_chunk_pattern ($$) {
658              
659 0     0 1 0 my $chunk_n = shift;
660 0         0 my $total_chunks = shift;
661              
662 0 0       0 my $pattern = $chunk_n == $total_chunks
    0          
663             ? 'finish' : $chunk_n == 0
664             ? 'start' : 'continue';
665              
666 0         0 $PATTERNS{chunk}->{$pattern};
667             }
668              
669             =head2 upload_in_chunks ($$$$$;$)
670              
671             Uploads a string in chunks, useful for uploading large volumes of data above the default SharePoint limit, usually 250000000 bytes.
672             Parameters: the options hash with the number of retries as the only used key.
673             the string scalar of data to upload
674             the SharePoint object basename to create
675             the SharePoint path to put the object in
676             (optional) the chunk size. Defaults to either configured chunk size or to $DEFAULT_CHUNK_SIZE.
677             Returns: the cumulative C response. If any of the tries fails aborts and returns 0.
678             Caveat: the object must already be exist in SharePoint, even with zero size. See C.
679              
680             =cut
681              
682             sub upload_in_chunks ($$$$$;$) {
683              
684 0     0 1 0 my $self = shift;
685 0         0 my $opts = shift;
686 0         0 my $item = shift;
687 0         0 my $object = shift;
688 0         0 my $folder = shift;
689 0   0     0 my $chunk = shift || $self->{config}{chunk_size} || $DEFAULT_CHUNK_SIZE;
690              
691 0 0       0 my $size = length(ref $item ? $$item : $item);
692 0         0 my $total_chunks = int($size/$chunk);
693              
694 0         0 my $ug = Data::UUID->new();
695 0         0 my $guid = $ug->to_string($ug->create());
696 0         0 my $r;
697 0         0 for my $chunk_n (0..$total_chunks) {
698 0 0       0 my $data = substr(
699             (ref $item ? $$item : $item),
700             $chunk_n*$chunk, $chunk
701             );
702 0         0 my $pattern = get_chunk_pattern($chunk_n, $total_chunks);
703 0 0       0 my $upload_url = $self->create_sharepoint_url({
704             pattern => $pattern,
705             object => $object,
706             folder => $folder,
707             }, $guid, $chunk_n ? $chunk_n * $chunk : ());
708 0         0 $self->log_it("Chunk upload ($pattern) to $upload_url", 'debug');
709             $r = $self->try(
710             {
711             action => "chunk_upload_$pattern",
712             retries => $opts->{retries} || $self->{config}{retries},
713             },
714 0   0     0 $upload_url, (
715             %DEFAULT_SHAREPOINT_POST_PARAMS,
716             Content_Length => length($data),
717             Content => $data,
718             )
719             );
720 0 0       0 return 0 unless $r;
721             }
722 0         0 $r;
723             }
724              
725             =head2 upload ($$$$)
726              
727             Uploads a file or a string to SharePoint. Initiates the upload in chunks if necessary, generating the zero sized file for it before calling C
728             Parameters: the options hash with
729             type - "file" means we're uploading a file
730             retries - the number of retries
731             the SharePoint target. If it's a path ending with '/', basename of the file is being appended.
732             the item - file or data string
733             Returns: the HTTP response object if successful.
734             0 when the upload fails or
735             when the file is unreadable or
736             when the upload is of a string and no target filename is specified.
737              
738             =cut
739              
740             sub upload ($$$$) {
741              
742 0     0 1 0 my $self = shift;
743 0         0 my $opts = shift;
744 0         0 my $target = shift;
745 0         0 my $item = shift;
746              
747 0         0 my ($object, $folder) = fileparse($target);
748 0   0     0 $opts->{type} ||= '';
749 0 0 0     0 if (! $object && $opts->{type} ne 'file') {
750 0         0 warn "Cannot upload without target filename";
751 0         0 return 0;
752             }
753 0   0     0 $object ||= basename($item);
754 0 0       0 if ($opts->{type} eq 'file') {
755 0 0       0 if (! -f $item) {
756 0         0 warn "File $item does not exist, ignoring";
757 0         0 return 0;
758             }
759 0         0 $item = read_file($item);
760             }
761 0         0 my $upload_url = $self->create_sharepoint_url({
762             type => 'upload',
763             object => $object,
764             folder => $folder,
765             });
766 0 0       0 if (length(ref $item ? $$item : $item) > $self->{config}{chunk_size}) {
    0          
767             my $r = $self->try(
768             {
769             action => 'upload',
770             retries => $opts->{retries} || $self->{config}{retries},
771             },
772 0   0     0 $upload_url, (
773             %DEFAULT_SHAREPOINT_POST_PARAMS,
774             Content_Length => 0,
775             Content => '',
776             )
777             );
778 0 0       0 return 0 unless $r;
779 0         0 $self->upload_in_chunks($opts, $item, $object, $folder);
780             }
781             else {
782 0         0 $self->log_it("Upload to $upload_url", 'debug');
783             return $self->try(
784             {
785             action => 'upload',
786             retries => $opts->{retries} || $self->{config}{retries},
787             },
788 0   0     0 $upload_url, (
789             %DEFAULT_SHAREPOINT_POST_PARAMS,
790             Content_Length => length($item),
791             Content => ref $item ? $$item : $item,
792             )
793             ) || 0;
794             }
795             }
796              
797             =head2 download ($$$;$)
798              
799             Downloads an object from SharePoint, optionally saving it into a file.
800             Parameters: the options hashref
801             save_file - the local path to save (or see target below)
802             retries - the number of retries
803             the SharePoint path to download
804             (optional) the target local path to save. If target (or save_file value) is a directory, use basename of the SharePoint path for filename. The directory tree is created via C.
805             Returns: 0 if download failed
806             path contents as a string scalar if string is requested
807             saved path if a file save is requested
808              
809             =cut
810              
811             sub download ($$$;$) {
812              
813 0     0 1 0 my $self = shift;
814 0         0 my $opts = shift;
815 0         0 my $item = shift;
816 0   0     0 my $target = shift || '';
817              
818 0 0       0 $opts->{save_file} = $target if $target;
819 0         0 my $download_url = $self->create_sharepoint_url({
820             type => 'download',
821             object => basename($item),
822             folder => dirname($item),
823             });
824 0         0 $self->log_it("Download from $download_url", 'debug');
825             my $response = $self->try(
826             {
827             action => 'download',
828             retries => $opts->{retries} || $self->{config}{retries},
829             },
830 0   0     0 $download_url, %DEFAULT_SHAREPOINT_POST_PARAMS,
831             );
832 0 0       0 return 0 if ! defined $response;
833 0 0       0 return $response->content unless $opts->{save_file};
834 0 0       0 $opts->{save_file} .= "/" . basename($item) if -d $opts->{save_file};
835 0         0 write_file($response->content, $opts->{save_file}, 1);
836 0         0 return $opts->{save_file};
837             }
838              
839             =head2 list ($$;$)
840              
841             Gets the contents of a given SharePoint folder. Note that you cannot list a file, you need to provide its path (event if it is root), and filter the results. Two API calls are issued, one to list files in the folders, one to list subfolders.
842             Parameters: the options hashref
843             path - the path to list
844             retries - the number of retries
845             path - (optional) - alternative way to specify path to list
846             Returns: a decoded JSON structure of the REST API response or
847             an empty list in case of failure.
848             For the interpretation of the results for an actual listing, see the print_list_reports subroutine in the example SharePoint client provided in the package.
849              
850             =cut
851              
852             sub list ($$;$) {
853              
854 0     0 1 0 my $self = shift;
855 0         0 my $opts = shift;
856 0   0     0 my $path = shift || $opts->{path};
857              
858 0         0 my @results = ();
859 0         0 for my $list_type (qw(files folders)) {
860             my $list_url = $self->create_sharepoint_url({
861 0         0 pattern => $PATTERNS{list}->{$list_type},
862             object => $path,
863             });
864 0         0 $self->log_it("Listing $list_url", 'debug');
865             my $list_response = $self->try(
866             {
867             action => 'list',
868             retries => $opts->{retries} || $self->{config}{retries},
869             },
870 0   0     0 $list_url, %DEFAULT_SHAREPOINT_POST_PARAMS,
871             );
872 0 0       0 next unless defined $list_response;
873 0         0 my $json = decode_json($list_response->content);
874 0         0 push(@results, @{$json->{d}{results}});
  0         0  
875             }
876 0         0 return \@results;
877             }
878              
879             =head2 makedir ($$$)
880              
881             Creates a new folder in SharePoint.
882             Parameters: the options hashref
883             retries - the number of retries
884             the folder to create
885             Returns: the REST API response as returned by C
886              
887             =cut
888              
889             sub makedir ($$$) {
890              
891 0     0 1 0 my $self = shift;
892 0         0 my $opts = shift;
893 0         0 my $folder = shift;
894              
895 0         0 my $mkdir_url = $self->create_sharepoint_url({
896             type => 'makedir',
897             folder => $folder,
898             });
899 0         0 $self->log_it("Creating folder $mkdir_url", 'debug');
900             $self->try(
901             {
902             action => 'makedir',
903             retries => $opts->{retries} || $self->{config}{retries},
904             },
905 0   0     0 $mkdir_url, %DEFAULT_SHAREPOINT_POST_PARAMS,
906             );
907             }
908              
909             =head2 delete ($$$)
910              
911             Deletes an item in SharePoint.
912             Parameters: the options hashref
913             retries - the number of retries
914             the item to delete
915             Returns: the REST API response as returned by C
916             Note: any item will be deleted (put to Recycle Bin), even a non-empty folder. If a non-existent item is requested for deletion, the deletion will still return success, but the resulting response will have field $json->{d}{Recycle} set to "00000000-0000-0000-0000-000000000000"
917              
918             =cut
919              
920             sub delete ($$$) {
921              
922 0     0 1 0 my $self = shift;
923 0         0 my $opts = shift;
924 0         0 my $item = shift;
925              
926 0         0 my $delete_url = $self->create_sharepoint_url({
927             type => 'delete',
928             object => $item,
929             });
930 0         0 $self->log_it("Deleting item $delete_url", 'debug');
931             $self->try(
932             {
933             action => 'delete',
934             retries => $opts->{retries} || $self->{config}{retries},
935             },
936 0   0     0 $delete_url, %DEFAULT_SHAREPOINT_POST_PARAMS,
937             );
938             }
939              
940             =head2 move ($$$$)
941              
942             Moves an item in SharePoint
943             Parameters: the options hashref
944             retries - the number of retries
945             the item to move
946             the destination to move to
947             Returns: the REST API response as returned by C
948              
949             =cut
950              
951             sub move ($$$$) {
952              
953 0     0 1 0 my $self = shift;
954 0         0 my $opts = shift;
955 0         0 my $item = shift;
956 0         0 my $target = shift;
957              
958 0         0 my $move_url = $self->create_sharepoint_url({
959             type => 'move',
960             object => $item,
961             folder => $target,
962             });
963 0         0 $self->log_it("Moving item $item to $target", 'debug');
964             $self->try(
965             {
966             action => 'move',
967             retries => $opts->{retries} || $self->{config}{retries},
968             },
969 0   0     0 $move_url, %DEFAULT_SHAREPOINT_POST_PARAMS,
970             );
971             }
972              
973             =head2 copy ($$$$)
974              
975             Copies an item in SharePoint
976             Parameters: the options hashref
977             retries - the number of retries
978             the item to copy
979             the destination to copy to
980             Returns: the REST API response as returned by C
981              
982             =cut
983              
984             sub copy ($$$$) {
985              
986 0     0 1 0 my $self = shift;
987 0         0 my $opts = shift;
988 0         0 my $item = shift;
989 0         0 my $target = shift;
990              
991 0         0 my $copy_url = $self->create_sharepoint_url({
992             type => 'copy',
993             object => $item,
994             folder => $target,
995             });
996 0         0 $self->log_it("Copying item $item to $target", 'debug');
997             $self->try(
998             {
999             action => 'copy',
1000             retries => $opts->{retries} || $self->{config}{retries},
1001             },
1002 0   0     0 $copy_url, %DEFAULT_SHAREPOINT_POST_PARAMS,
1003             );
1004             }
1005              
1006             =head1 AUTHOR
1007              
1008             Roman Parparov, C<< >>
1009              
1010             =head1 BUGS
1011              
1012             Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
1013              
1014              
1015             =head1 SUPPORT
1016              
1017             You can find documentation for this module with the perldoc command.
1018              
1019             perldoc Net::SharePoint::Basic
1020              
1021              
1022             You can also look for information at:
1023              
1024             =over 4
1025              
1026             =item * RT: CPAN's request tracker (report bugs here)
1027              
1028             L
1029              
1030             =item * AnnoCPAN: Annotated CPAN documentation
1031              
1032             L
1033              
1034             =item * CPAN Ratings
1035              
1036             L
1037              
1038             =item * Search CPAN
1039              
1040             L
1041              
1042             =item * Repository
1043              
1044             L
1045              
1046             =item * MSDN SharePoint REST API
1047              
1048             L
1049              
1050             =back
1051              
1052             =head1 ACKNOWLEDGEMENTS
1053              
1054             Special thanks to Andre Abramenko L for helping me figure out the REST API when I initially implemented it at VMware.
1055              
1056             =head1 LICENSE AND COPYRIGHT
1057              
1058             Copyright 2018 VMware.com
1059              
1060             This program is free software; you can redistribute it and/or modify it
1061             under the terms of either: the GNU General Public License as published
1062             by the Free Software Foundation; or the Artistic License.
1063              
1064             See L for more information.
1065              
1066              
1067             =cut
1068              
1069             1; # End of Net::SharePoint::Basic