← Back to branch summary

~ubuntu-branches/ubuntu/vivid/renrot/vivid-proposed

« back to all changes in this revision

Viewing changes to lib/Image/RenRot/FileUtil.pm

  • Committer: Package Import Robot
  • Author(s): Ondřej Surý
  • Date: 2014-10-06 14:04:27 UTC
  • mfrom: (1.1.2)
  • Revision ID: package-import@ubuntu.com-20141006140427-ax0dwq886zjo2x3r
Tags: 1.2.0-0.1
http://bugs.debian.org/402702
http://bugs.debian.org/729630
http://bugs.debian.org/539346
http://bugs.debian.org/764215
* Non-maintainer upload
* New upstream version 1.2.0 (Closes: #402702, #729630, #539346)
* Don't depend on versioned libjpeg-progs (Closes: #764215)

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/Image/RenRot/FileUtil.pm
 
1
package Image::RenRot::FileUtil;
 
2
 
 
3
#
 
4
# vim: ts=2 sw=2 et :
 
5
#
 
6
 
 
7
use strict;
 
8
use warnings;
 
9
require 5.006;
 
10
require Exporter;
 
11
use File::Path;
 
12
 
 
13
use Image::RenRot::Logging;
 
14
 
 
15
use vars qw(@ISA @EXPORT);
 
16
 
 
17
@ISA = qw(Exporter);
 
18
@EXPORT = qw(makedir splitext);
 
19
 
 
20
########################################################################################
 
21
#
 
22
# getFileDatLns() gets data from a given file in array of lines. it returns hash
 
23
#                 of format: $hash{'field1'}[0] => 1
 
24
#                            ...
 
25
#                            $hash{'field1'}[N] => fieldN
 
26
#                 where N is the number of fields, starting from 1
 
27
#
 
28
sub getFileDatLns {
 
29
  my $self = shift;
 
30
  my $file = shift; # name of the file to be processed
 
31
 
 
32
  if (not defined $file or $file eq "") {
 
33
    warnmsg ("Can't read file with empty name!\n");
 
34
    return;
 
35
  }
 
36
 
 
37
  if (open(XXXFILE, "<$file")) {
 
38
    binmode XXXFILE;
 
39
    my %xxxData; # splited line hash
 
40
    my @chunks = ();  # arr, chunks to be placed to
 
41
    my ($i, $j);
 
42
 
 
43
    while (<XXXFILE>){
 
44
      chomp;
 
45
      @chunks = split(/\s+/);
 
46
      $xxxData{$chunks[0]}[0] = 1;
 
47
      for ($i = 1; $i < scalar(@chunks); $i++) {
 
48
        $xxxData{$chunks[0]}[$i] = $chunks[$i];
 
49
        dbgmsg (4, "xxxData{$chunks[0]}[$i] = $chunks[$i]\n");
 
50
      }
 
51
      undef @chunks;
 
52
    }
 
53
    unless (close(XXXFILE)) { errmsg ("$file wasn't closed!\n"); }
 
54
    return \%xxxData;
 
55
  }
 
56
 
 
57
  warnmsg ("Can't read file: $file!\n");
 
58
  return;
 
59
}
 
60
 
 
61
########################################################################################
 
62
#
 
63
# getFileDataLines() gets data from a given file in array of lines
 
64
#
 
65
sub getFileDataLines {
 
66
  my $self = shift;
 
67
  my $file = shift;
 
68
 
 
69
  if (not defined $file or $file eq "") {
 
70
    warnmsg ("Can't read file with empty name!\n");
 
71
    return;
 
72
  }
 
73
 
 
74
  if (open(XXXFILE, "<$file")) {
 
75
    binmode XXXFILE;
 
76
    my @xxxData = <XXXFILE>;
 
77
    unless (close(XXXFILE)) { errmsg ("$file wasn't closed!\n"); }
 
78
    return @xxxData;
 
79
  }
 
80
 
 
81
  warnmsg ("Can't read file: $file!\n");
 
82
  return;
 
83
}
 
84
 
 
85
########################################################################################
 
86
#
 
87
# getFileData() gets data from a given file in one-line string
 
88
#
 
89
sub getFileData {
 
90
  my $self = shift;
 
91
  my $file = shift;
 
92
 
 
93
  my @result = $self->getFileDataLines($file);
 
94
  return join ("", @result) if (scalar(@result) > 0);
 
95
  return undef;
 
96
}
 
97
 
 
98
########################################################################################
 
99
# Usage      : makedir($dir);
 
100
# Purpose    : makes one level directory
 
101
# Returns    : none
 
102
# Parameters : $dir str - directory to make
 
103
# Throws     : no exceptions
 
104
# Comments   : none
 
105
# See Also   : n/a
 
106
sub makedir {
 
107
  my $new_dir = shift;
 
108
  if (not -d $new_dir) {
 
109
    eval { mkpath($new_dir, 0, 0700) };
 
110
    if ($@) {
 
111
      errmsg ("Couldn't create $new_dir: $@");
 
112
    }
 
113
  }
 
114
}
 
115
 
 
116
########################################################################################
 
117
# Usage      : piper();
 
118
# Purpose    : opens two pipes for process object via the command passed as argument
 
119
# Returns    : $pipe_obj processed via $pipe_cmd
 
120
# Parameters : $pipe_obj bin - the object to be processed via pipe
 
121
#            : $pipe_cmd str - the command for the processing
 
122
# Throws     : no exceptions
 
123
# Comments   : none
 
124
# See Also   : n/a
 
125
sub piper {
 
126
  use FileHandle;
 
127
  use IPC::Open2;
 
128
 
 
129
  my $self = shift;
 
130
 
 
131
  my $pipe_obj = shift; # the object to be processed via pipe
 
132
  my $pipe_cmd = shift; # the pipe command
 
133
 
 
134
  local (*READ_FROM_FH, *WRITE_TO_FH);  # file handlers
 
135
  unless (open2(\*READ_FROM_FH, \*WRITE_TO_FH, $pipe_cmd)) {
 
136
    errmsg ("Unable to create the pipe.\n");
 
137
    return;
 
138
  }
 
139
 
 
140
  binmode WRITE_TO_FH;
 
141
  print WRITE_TO_FH $pipe_obj;
 
142
 
 
143
  unless (close(WRITE_TO_FH)) { warnmsg ("WRITE handle wasn't closed!\n"); };
 
144
 
 
145
  binmode READ_FROM_FH;
 
146
  my @piped_arr = <READ_FROM_FH>;
 
147
 
 
148
  unless (close(READ_FROM_FH)) { warnmsg ("READ handle wasn't closed!\n"); };
 
149
 
 
150
  return join("", @piped_arr);
 
151
}
 
152
 
 
153
sub splitext {
 
154
  my $filename = shift;
 
155
 
 
156
  return ($1, $2) if ($filename =~ m/(.*)\.([^\/\.]+)$/);
 
157
  return ($filename, "");
 
158
}
 
159
 
 
160
########################################################################################
 
161
1;  # end