+sub full_write {
+ my ($fd, $buf, $count) = @_;
+ my $total = 0;
+
+ while ($count > 0) {
+ my $n_written = POSIX::write($fd, $buf, $count);
+ if (!defined $n_written) {
+ next if ($! == EINTR);
+ return undef;
+ } elsif ($n_written == 0) {
+ last;
+ }
+
+ $count -= $n_written;
+ $total += $n_written;
+
+ if ($count) {
+ $buf = substr($buf, $n_written);
+ }
+ }
+
+ return $total;
+}
+
+sub skip_quoted_string {
+ my $str = shift;
+
+ chomp $str;
+ my $iq = 0;
+ my $i = 0;
+ my $c = substr $str, $i, 1;
+ while ($c ne "" && !($iq == 0 && $c =~ /\s/)) {
+ if ($c eq '"') {
+ $iq = !$iq;
+ } elsif ($c eq '\\') {
+ $i++;
+ }
+ $i++;
+ $c = substr $str, $i, 1;
+ }
+ my $quoted_string = substr $str, 0, $i;
+ my $remainder = undef;
+ if (length($str) > $i) {
+ $remainder = substr $str, $i+1;
+ }
+
+ return ($quoted_string, $remainder);
+}
+
+sub split_quoted_string_friendly {
+ my $str = shift;
+ my @result;
+
+ chomp $str;
+ $str =~ s/^\s+//;
+ while ($str) {
+ (my $elt, $str) = skip_quoted_string($str);
+ push @result, unquote_string($elt);
+ $str =~ s/^\s+// if $str;
+ }
+
+ return @result;
+}
+
+%}
+
+amglue_export_ok(slurp);
+amglue_export_ok(burp);
+amglue_export_ok(safe_overwrite_file);
+
+%perlcode %{
+
+sub slurp {
+ my $file = shift @_;
+ local $/;
+
+ open my $fh, "<", $file or croak "can't open $file: $!";
+ my $data = <$fh>;
+ close $fh;
+
+ return $data;
+}
+
+sub burp {
+ my $file = shift @_;
+ open my $fh, ">", $file or croak "can't open $file: $!";
+ print $fh @_;
+}
+
+sub safe_overwrite_file {
+ my ( $filename, $contents ) = @_;
+
+ my $tmpfname = "$filename." . time;
+ open my $tmpfh, ">", $tmpfname or die "open: $!";
+
+ print $tmpfh $contents;
+ (fsync($tmpfh) == 0) or die "fsync: $!";
+ return rename $tmpfname, $filename;
+}
+
+%}
+
+%typemap (in) GPtrArray * {
+ AV *av;
+ guint len;
+ int i;
+
+ if (!SvROK($input) || SvTYPE(SvRV($input)) != SVt_PVAV) {
+ SWIG_exception(SWIG_TypeError, "Expected an arrayref");
+ }
+ av = (AV *)SvRV($input);
+
+ len = av_len(av)+1; /* av_len(av) is like $#av */
+ $1 = g_ptr_array_sized_new(len);
+ for (i = 0; i < len; i++) {
+ SV **elt = av_fetch(av, i, 0);
+ if (!elt || !SvPOK(*elt)) {
+ SWIG_exception(SWIG_TypeError, "Non-string in arrayref");
+ }
+ g_ptr_array_add($1, SvPV_nolen(*elt)); /* TODO: handle unicode here */
+ }
+}
+%typemap (freearg) GPtrArray * {
+ g_ptr_array_free($1, FALSE);
+}
+
+%typemap (out) GPtrArray * {
+ if ($1) {
+ guint i;
+ for (i = 0; i < $1->len; i++) {
+ $result = sv_2mortal(newSVpv(g_ptr_array_index($1, i), 0));
+ argvi++;
+ }
+ g_ptr_array_free($1, TRUE);
+ } else {
+ $result = &PL_sv_undef;
+ argvi++;
+ }
+}
+
+/* for split_quoted_strings */
+%typemap(out) gchar ** {
+ gchar **iter;
+
+ if ($1) {
+ /* Count the DeviceProperties */
+ EXTEND(SP, g_strv_length($1)); /* make room for return values */
+
+ /* Note that we set $result several times. the nature of
+ * SWIG's wrapping is such that incrementing argvi points
+ * $result to the next location in perl's argument stack.
+ */
+
+ for (iter = $1; *iter; iter++) {
+ $result = sv_2mortal(newSVpv(*iter, 0));
+ argvi++;
+ }
+ }
+}
+
+%rename(hexencode) hexencode_string;
+char *hexencode_string(char *);
+%rename(hexdecode) perl_hexdecode_string;
+char *perl_hexdecode_string(char *);
+%{
+char *perl_hexdecode_string(const char *str) {
+ GError *err = NULL;
+ char *tmp;
+ tmp = hexdecode_string(str, &err);
+ if (err) {
+ g_free(tmp);
+ croak_gerror("Amanda util: hexdecode", &err);
+ }
+ return tmp;
+}
+%}
+amglue_export_tag(encoding, hexencode hexdecode);
+
+char *sanitise_filename(char *inp);
+char *quote_string(char *);
+char *unquote_string(char *);
+GPtrArray *expand_braced_alternates(char *);
+%newobject collapse_braced_alternates;
+char *collapse_braced_alternates(GPtrArray *source);
+gchar **split_quoted_strings(const gchar *string);
+amglue_export_tag(quoting, quote_string unquote_string skip_quoted_string
+ sanitise_filename split_quoted_strings split_quoted_strings_friendly);
+amglue_export_tag(alternates, expand_braced_alternates collapse_braced_alternates);
+
+%perlcode %{
+
+sub generate_timestamp {
+ # this corresponds to common-src/timestamp.c's get_proper_stamp_from_time
+ if (getconf($CNF_USETIMESTAMPS)) {
+ return strftime "%Y%m%d%H%M%S", localtime;
+ } else {
+ return strftime "%Y%m%d", localtime;
+ }
+}
+
+sub built_with_component {
+ my ($component) = @_;
+ my @components = split / +/, $Amanda::Constants::AMANDA_COMPONENTS;
+ return grep { $_ eq $component } @components;
+}
+
+%}
+
+/* interface to gnulib's fsusage */
+%typemap(in,numinputs=0) (struct fs_usage *fsp)
+ (struct fs_usage fsu) {
+ bzero(&fsu, sizeof(fsu));
+ $1 = &fsu;
+}
+
+%typemap(argout) (struct fs_usage *fsp) {
+ SV *sv;
+ HV *hv;
+
+ /* if there was an error, assume that fsu_blocksize isn't changed,
+ * and return undef. */
+ if ($1->fsu_blocksize) {
+ SP += argvi; PUTBACK; /* save the perl stack so amglue_newSVi64 doesn't kill it */
+ hv = (HV *)sv_2mortal((SV *)newHV());
+ hv_store(hv, "blocksize", 9, amglue_newSVi64($1->fsu_blocksize), 0);
+ hv_store(hv, "blocks", 6, amglue_newSVi64($1->fsu_blocks), 0);
+ hv_store(hv, "bfree", 5, amglue_newSVi64($1->fsu_bfree), 0);
+ hv_store(hv, "bavail", 6, amglue_newSVi64($1->fsu_bavail), 0);
+ hv_store(hv, "bavail_top_bit_set", 18, newSViv($1->fsu_bavail_top_bit_set), 0);
+ hv_store(hv, "files", 5, amglue_newSVi64($1->fsu_files), 0);
+ hv_store(hv, "ffree", 5, amglue_newSVi64($1->fsu_ffree), 0);
+
+ $result = newRV((SV *)hv);
+ SPAGAIN; SP -= argvi;
+ argvi++;
+ }
+}
+
+%rename(get_fs_usage) get_fs_usage_;
+%inline %{
+void get_fs_usage_(const char *file, struct fs_usage *fsp)
+{
+ int rv = get_fs_usage(file, NULL, fsp);
+ if (rv == -1)
+ /* signal an error to the typemap */
+ fsp->fsu_blocksize = 0;
+}
+%}
+
+/*
+ * Operations that should be in Perl but aren't