summaryrefslogtreecommitdiff
path: root/lib/gcstar/GCUtils.pm
diff options
context:
space:
mode:
authorJörg Frings-Fürst <jff@merkur>2014-07-06 15:20:38 +0200
committerJörg Frings-Fürst <jff@merkur>2014-07-06 15:20:38 +0200
commit126bb8cb6b93240bb4d3a2b816b74c286c3d422b (patch)
treee66e1dfe77d53a52539489765c88d23e4423ae27 /lib/gcstar/GCUtils.pm
Imported Upstream version 1.7.0upstream/1.7.0
Diffstat (limited to 'lib/gcstar/GCUtils.pm')
-rw-r--r--lib/gcstar/GCUtils.pm640
1 files changed, 640 insertions, 0 deletions
diff --git a/lib/gcstar/GCUtils.pm b/lib/gcstar/GCUtils.pm
new file mode 100644
index 0000000..cc0e0d9
--- /dev/null
+++ b/lib/gcstar/GCUtils.pm
@@ -0,0 +1,640 @@
+package GCUtils;
+
+###################################################
+#
+# Copyright 2005-2010 Christian Jodar
+#
+# This file is part of GCstar.
+#
+# GCstar is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# GCstar is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with GCstar; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA
+#
+###################################################
+
+use strict;
+use Exporter;
+use Cwd 'abs_path';
+use Gtk2;
+
+use base 'Exporter';
+our @EXPORT_OK = qw(glob);
+
+our $margin = 12;
+our $halfMargin = $margin / 2;
+our $quarterMargin = $margin / 4;
+
+sub updateUI
+{
+ my $loopCount = 0;
+ my $nbEvent = Gtk2->events_pending;
+ while ($nbEvent && ($loopCount < 30))
+ {
+ Gtk2->main_iteration;
+ $loopCount++;
+ $nbEvent = Gtk2->events_pending;
+ }
+}
+
+sub printStack
+{
+ my $number = shift;
+ $number ||= 1;
+ my ($package, $filename, $line, $subroutine) = caller(1);
+ my $output = "$package::$subroutine";
+ my $frame = 2;
+ while (($number + 1) >= $frame)
+ {
+ ($package, $filename, $line, $subroutine) = caller($frame);
+ $output .= " from $package::$subroutine";
+ $frame++;
+ }
+ print "$output\n";
+}
+
+sub dumpList
+{
+ my ($list, @fields) = @_;
+ my $i = 0;
+ foreach my $item(@$list)
+ {
+ print $i, ': ';
+ print $item->{$_}, ", " foreach (@fields);
+ print "\n";
+ $i++;
+ }
+}
+
+sub formatOpenSaveError
+{
+ my ($lang, $filename, $error) = @_;
+
+ my $errorText = (exists $lang->{$error->[0]})
+ ? $lang->{$error->[0]}
+ : $error->[0];
+ return "$filename\n\n$errorText".($error->[1] ? "\n\n".$error->[1] : '');
+}
+
+sub glob
+{
+ my ($pattern) = @_;
+ $pattern = '"'.$pattern.'"' if $pattern =~ /[^\\] /;
+ return glob "$pattern";
+}
+
+sub pathToUnix
+{
+ my ($path, $canonical) = @_;
+ $path =~ s|\\|/|g if ($^O =~ /win32/i);
+ $path = abs_path($path) if $canonical;
+ return $path;
+}
+
+sub sizeToHuman
+{
+ my ($size, $sizesSymbols) = @_;
+
+ #my @prefixes = ('', 'K', 'M', 'G', 'T', 'P', 'E', 'Z', 'Y');
+ my $i = 0;
+ while ((($size / 1024) > 1) && ($i < scalar @$sizesSymbols))
+ {
+ $size /= 1024;
+ $i++;
+ }
+ return sprintf("%.1f %s%s", $size, $sizesSymbols->[$i]);
+}
+
+sub getSafeFileName
+{
+ my $file = shift;
+
+ $file =~ s/[^-a-zA-Z0-9_.]/_/g;
+ return $file;
+}
+
+sub boolToText
+{
+ my $value = shift;
+
+ return $value ? 'true' : 'false';
+}
+
+sub listNameToNumber
+{
+ my $value = shift;
+
+ return 1 if $value =~ /single/;
+ return 2 if $value =~ /double/;
+ return 3 if $value =~ /triple/;
+ return 4 if $value =~ /quadruple/;
+ return 0;
+}
+
+sub encodeEntities
+{
+ my $value = shift;
+ $value =~ s/&/&amp;/g;
+ $value =~ s/</&lt;/g;
+ $value =~ s/>/&gt;/g;
+ $value =~ s/"/&quot;/g;
+ #"
+ return $value;
+}
+
+sub compactHistories
+{
+ my $histories;
+ foreach (keys %$histories)
+ {
+ my %allKeys;
+ @allKeys{@{$histories->{$_}}} = ();
+ my @unique = keys %allKeys;
+ $histories->{$_} = \@unique;
+ }
+}
+
+use HTML::Entities;
+# Strips readable text from RTF formatted strings
+sub RtfToString
+{
+ my ($rtfString) = @_;
+
+ my $str = $rtfString;
+
+ # First, decode any symbols present
+ $str = decode_entities($str);
+ # Strip leading {
+ $str =~ s/^\{//;
+ # Strip out all the formatting within {}'s
+ $str =~ s/\{(.)*;\}//gs;
+ # Strip trailing }
+ $str =~ s/\}$//;
+ # Get the text from "\'d5" type tags
+ $str =~ s/\\(.)d\d/$1/g;
+ # Strip out all the remaining formatting
+ $str =~ s/\\(\H)*[\s]//g;
+ # And any newlines, since they'll be randomly placed now
+ $str =~ s/\n//g;
+
+ return $str;
+}
+
+
+{
+ package GCPreProcess;
+
+ use Text::Wrap;
+
+ sub singleList
+ {
+ my $value = shift;
+ if (ref($value) eq 'ARRAY')
+ {
+ my $string = '';
+ foreach (@{$value})
+ {
+ $string .= $_->[0].', ';
+ }
+ $string =~ s/ \(\)//g;
+ $string =~ s/, $//;
+ return $string;
+ }
+ else
+ {
+ $value =~ s/,*$//;
+ $value =~ s/,([^ ])/, $1/g;
+ return $value;
+ }
+ }
+
+ sub doubleList
+ {
+ my $value = shift;
+ if (ref($value) eq 'ARRAY')
+ {
+ my $string = '';
+ foreach (@{$value})
+ {
+ my $val0 = (exists $_->[0]) ? $_->[0] : '';
+ my $val1 = '';
+ $val1 = '('.$_->[1].')' if defined ($_->[1]);
+ $string .= "$val0 $val1, ";
+ }
+ $string =~ s/ \(\)//g;
+ $string =~ s/, $//;
+ return $string;
+ }
+ else
+ {
+ $value =~ s/;/,/g if $value !~ /,/;
+ $value =~ s/;(.*?)(,|$)/ ($1)$2/g;
+ $value =~ s/,([^ ])/, $1/g;
+ $value =~ s/ \(\)//g;
+ $value =~ s/(, ?)*$//;
+ return $value;
+ }
+ }
+
+ sub otherList
+ {
+ my $value = shift;
+ if (ref($value) eq 'ARRAY')
+ {
+ my $string = '';
+ foreach my $line(@{$value})
+ {
+ $string .= $_.'|' foreach (@{$line});
+ $string .= ', ';
+ }
+ $string =~ s/, $//;
+ return $string;
+ }
+ else
+ {
+ $value =~ s/,([^ ])/, $1/g;
+ $value =~ s/(, ?)*$//;
+ return $value;
+ }
+ }
+
+ sub multipleList
+ {
+ my ($value, $number) = @_;
+
+ $number = GCUtils::listNameToNumber($number) if $number !~ /^[0-9]+$/;
+
+ return singleList($value) if $number == 1;
+ return doubleList($value) if $number == 2;
+ #We only return the first column of each line in a string
+ return otherList($value);
+ }
+
+ sub multipleListToArray
+ {
+ my $value = shift;
+ my @result;
+ if (ref($value) eq 'ARRAY')
+ {
+ foreach (@{$value})
+ {
+ push @result, $_->[0];
+ }
+ }
+ else
+ {
+ @result = split /,\s*/, $value;
+ }
+ return \@result;
+ }
+
+ sub wrapText
+ {
+ my ($widget, $text) = @_;
+ my $width = $widget->allocation->width;
+ $width -= 30;
+ (my $oneline = $text) =~ s/\n/ /gm;
+ my $layout = $widget->create_pango_layout($oneline);
+ my (undef, $rect) = $layout->get_pixel_extents;
+ my $textWidth = $rect->{width};
+ my $lines = $textWidth / $width;
+ $lines = 1 if $lines <= 0;
+ my $columns = length($text) / $lines;
+ use integer;
+ $Text::Wrap::columns = $columns - 5;
+ $Text::Wrap::columns = 1 if $Text::Wrap::columns <= 0;
+ no integer;
+ $text = Text::Wrap::wrap('', '', $text);
+ return $text;
+ }
+
+ # Useful to compare date
+ sub reverseDate
+ {
+ (my $date = shift) =~ s|([0-9]{2})/([0-9]{2})/([0-9]{4})|$3/$2/$1|;
+ return $date;
+ }
+
+ sub restoreDate
+ {
+ (my $date = shift) =~ s|([0-9]{4})/([0-9]{2})/([0-9]{2})|$3/$2/$1|;
+ return $date;
+ }
+
+ sub extractYear
+ {
+ my $date = shift;
+
+ return 0 if $date !~ /[0-9]{4}/;
+ (my $year = $date) =~ s/.*?(([0-9]{4})).*?/$1/;
+
+ return $year;
+ }
+
+ sub noNullNumber
+ {
+ my $num = shift;
+ return 0 if ($num eq '') || (! defined($num));
+ return $num;
+ }
+}
+
+sub round
+{
+ my $number = shift;
+ return int($number + .5);
+}
+
+sub urlDecode
+{
+ my $text = shift;
+ $text =~ tr/+/ /;
+ $text =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
+ return $text;
+}
+
+sub scaleMaxPixbuf
+{
+ my ($pixbuf, $maxWidth, $maxHeight, $forceScale, $quick) = @_;
+
+ my $algorithm = $quick ? 'nearest' : 'bilinear';
+
+ if ($forceScale)
+ {
+ $pixbuf = $pixbuf->scale_simple($maxWidth, $maxHeight, $algorithm);
+ }
+ else
+ {
+ my ($width, $height) = ($pixbuf->get_width, $pixbuf->get_height);
+ if (($height > $maxHeight) || ($width > $maxWidth))
+ {
+ my ($newWidth, $newHeight);
+ my $ratio = $height / $width;
+ if (($width) * ($maxHeight / $height) < $maxWidth)
+ {
+ $newHeight = $maxHeight;
+ $newWidth = $newHeight / $ratio;
+ }
+ else
+ {
+ $newWidth = $maxWidth;
+ $newHeight = $newWidth * $ratio;
+ }
+
+ $pixbuf = $pixbuf->scale_simple($newWidth, $newHeight, $algorithm);
+ }
+ }
+
+ return $pixbuf;
+}
+
+sub findPosition
+{
+ use locale;
+ my ($label, $menu) = @_;
+
+ my @children = $menu->get_children;
+ my $i = 0;
+ my $child;
+ foreach $child(@children)
+ {
+ return $i if (($i !=0) && ($child->child->get_label() gt $label));
+ $i++;
+ }
+ return $i;
+}
+
+sub inArray
+{
+ my $val = shift;
+
+ my $i = 0;
+ my $elem;
+ foreach $elem(@_)
+ {
+ if($val eq $elem)
+ {
+ return $i;
+ }
+ $i++;
+ }
+ return undef;
+}
+
+sub inArrayTest
+{
+ my $val = shift;
+ my $elem;
+ foreach $elem(@_)
+ {
+ return 1 if($val eq $elem);
+ }
+ return 0;
+}
+
+my $rc_style = Gtk2::RcStyle->new;
+
+sub setWidgetPixmap
+{
+ my ($widget, $imageFile) = @_;
+ $rc_style->bg_pixmap_name('normal', $imageFile);
+ $rc_style->bg_pixmap_name('insensitive', $imageFile);
+ $widget->modify_style($rc_style);
+
+# my $style = $widget->parent->get_style->copy;
+# $style->bg_pixmap('normal', $image);
+# $style->bg_pixmap('insensitive', $image);
+# $style->bg_pixmap('active', $image);
+# $style->bg_pixmap('prelight', $image);
+# $style->bg_pixmap('selected', $image);
+# $widget->parent->set_style($style);
+
+}
+
+use File::Basename;
+
+sub getDisplayedImage
+{
+ my ($displayedImage, $default, $file, $fileDir) = @_;
+
+ if (!File::Spec->file_name_is_absolute($displayedImage))
+ {
+ my $dir;
+ if ($file)
+ {
+ $dir = ($fileDir || dirname($file));
+ }
+ else
+ {
+ $dir = '.';
+ }
+ if (-f "$dir/$displayedImage")
+ {
+ $displayedImage = $dir.'/'.$displayedImage;
+ }
+ else
+ {
+ $displayedImage = $default unless (-e $displayedImage);
+ }
+ }
+ $displayedImage = $default if ! -f $displayedImage;
+
+ return GCUtils::pathToUnix($displayedImage);
+}
+
+use LWP::UserAgent;
+sub downloadFile
+{
+ my ($url, $dest, $settings) = @_;
+ my $browser = LWP::UserAgent->new;
+ $browser->proxy(['http'], $settings->{options}->proxy);
+ $browser->cookie_jar(HTTP::Cookies::Netscape->new(
+ 'file' => $settings->{options}->cookieJar));
+ $browser->agent($settings->{agent});
+ $browser->default_headers->referer($url);
+ $browser->get($url, ':content_file' => $dest);
+}
+
+use POSIX qw/strftime/;
+sub timeToStr
+{
+ my ($date, $format) = @_;
+ my @array=split("/", $date);
+ return $date if $#array != 2;
+ return strftime($format, 0, 0, 0, $array[0], $array[1]-1, $array[2]-1900);
+}
+
+sub TimePieceStrToTime
+{
+ my ($date, $format) = @_;
+ my $str;
+ eval {
+ my $t = Time::Piece->strptime($date, $format);
+ $str = sprintf('%02d/%02d/%4d', $t->mday, $t->mon, $t->year);
+ };
+ if ($@)
+ {
+ return $date;
+ }
+ return $str;
+}
+
+sub DateTimeFormatStrToTime
+{
+ my ($date, $format) = @_;
+ my $str;
+ eval {
+ my $dt = new DateTime::Format::Strptime(
+ pattern => $format,
+ locale => $ENV{LANG});
+ my $dt2 = $dt->parse_datetime($date);
+ $dt->pattern('%d/%m/%Y');
+ $str = $dt->format_datetime($dt2);
+ };
+ if ($@)
+ {
+ return $date;
+ }
+ return $str;
+}
+
+# Our custom natural sort function
+sub gccmp
+{
+ use locale;
+ my ($string1, $string2) = @_;
+
+ my $test1 = $string1;
+ my $test2 = $string2;
+
+ # Split strings into arrays by seperating strings from numbers
+ my $nb1 = ($test1 =~ s/(\d+)/\|$+\|/g);
+ my $nb2 = ($test2 =~ s/(\d+)/\|$+\|/g);
+
+ # If there are no numbers in the test strings, just directly compare
+ return $test1 cmp $test2
+ if ($nb1 == 0) || ($nb2 == 0);
+
+ my @test = split(/\|/,$test1);
+ my @test2 = split(/\|/,$test2);
+
+ # Compare each element in the strings
+ my $result = 0;
+ for (my $pass = 0; $pass < scalar @test; $pass++)
+ {
+ # Elements are the same, so keep searching
+ next if ($test[$pass] eq $test2[$pass]);
+
+ # If both elements are numbers, do a numerical compare
+ if (($test[$pass] =~ /\d+/) && ($test2[$pass] =~ /\d+/))
+ {
+ # Number test
+ $result = $test[$pass] <=> $test2[$pass];
+ }
+ else
+ {
+ # Test elements as strings
+ $result = lc($test[$pass]) cmp lc($test2[$pass]);
+ }
+ last;
+ }
+
+ return $result;
+}
+
+# Extended version of gccmp that also supports dates
+# Only useful for image mode as text mode handles that in a better way
+sub gccmpe
+{
+ my ($string1, $string2) = @_;
+
+ my $test1 = $string1;
+ my $test2 = $string2;
+
+ if (($test1 =~ m|([0-9]{2})/([0-9]{2})/([0-9]{4})|)
+ && ($test2 =~ m|([0-9]{2})/([0-9]{2})/([0-9]{4})|))
+ {
+ return (GCPreProcess::reverseDate($test1) cmp GCPreProcess::reverseDate($test2));
+ }
+ else
+ {
+ return gccmp($test1, $test2);
+ }
+}
+
+our $hasTimeConversion;
+BEGIN {
+ $hasTimeConversion = 1;
+ eval 'use DateTime::Format::Strptime qw/strptime/';
+ if (!$@)
+ {
+ *strToTime = \&DateTimeFormatStrToTime;
+ }
+ else
+ {
+ eval 'use Time::Piece';
+ if (!$@)
+ {
+ *strToTime = \&TimePieceStrToTime;
+ }
+ else
+ {
+ $hasTimeConversion = 0;
+ *strToTime = sub {return $_[0]};
+ *timeToStr = sub {return $_[0]};
+ }
+ }
+
+}
+
+
+1;