Merge branch 'master' of github.com:dpavlin/MojoFacets
authorDobrica Pavlinusic <dpavlin@rot13.org>
Sat, 11 Aug 2012 14:08:13 +0000 (16:08 +0200)
committerDobrica Pavlinusic <dpavlin@rot13.org>
Sat, 11 Aug 2012 14:08:13 +0000 (16:08 +0200)
Conflicts:
bin/debian-install.sh
public/code/pool.label.pl

Makefile.PL
bin/debian-install.sh
data/zahtjev-knjige.sql [deleted file]
lib/MojoFacets.pm
lib/MojoFacets/Data.pm
lib/MojoFacets/Import/CSV.pm
lib/MojoFacets/Plugin/NYTProf.pm
public/code/pool.label.pl
script/GoogleDocsUploader.pl [new file with mode: 0755]

index 02090be..207ca0c 100755 (executable)
@@ -5,7 +5,7 @@ version_from 'lib/MojoFacets.pm';
 author 'Dobrica Pavlinusic <dpavlin@rot13.org>';
 license 'dual';
 
-requires 'Mojolicious' => '1.13';
+requires 'Mojolicious' => '2.61';
 requires 'Data::Dump';
 requires 'File::Slurp';
 requires 'JSON';
index bfcf6ad..6aef031 100755 (executable)
@@ -1,3 +1,3 @@
 #!/bin/sh -x
 
-sudo apt-get install libhtml-tableextract-perl libjson-perl libmodule-install-perl libstatistics-descriptive-perl libmodule-install-perl libmojolicious-perl libtext-csv-perl
+sudo apt-get install libhtml-tableextract-perl libjson-perl libmodule-install-perl libstatistics-descriptive-perl libmodule-install-perl libtext-unaccent-perl libmojolicious-perl libtext-csv-perl
diff --git a/data/zahtjev-knjige.sql b/data/zahtjev-knjige.sql
deleted file mode 100644 (file)
index 59121fd..0000000
+++ /dev/null
@@ -1,3 +0,0 @@
--- dbi:Gofer:transport=stream;url=ssh:mjesec.ffzg.hr;dsn=DBI:Pg:dbname=wopi_zahtjevknjige
-
-select *,date(unesen) from zahtjevknjige ;
index 9146e2f..c2ef3d4 100644 (file)
@@ -51,13 +51,13 @@ sub startup {
 
 #      $self->plugin( 'request_timer' );
 
-       $self->plugins->add_hook(
+       $self->hook(
                        after_dispatch => sub {
                                my ($self) = @_;
                                save_action( $self );
                        }
        );
-       
+
        eval 'use MojoFacets::Plugin::NYTProf';
        if ( $@ ) {
                warn "profile disabled: ",substr($@,0,40) if $@;
index eb36419..f685aa0 100644 (file)
@@ -13,7 +13,7 @@ use File::Find;
 use Storable;
 use Time::HiRes qw(time);
 use File::Path qw(mkpath);
-use Text::Unaccent::PurePerl;
+use Text::Unaccent;
 use Digest::MD5;
 use Statistics::Descriptive;
 
@@ -364,7 +364,7 @@ sub _permanent_path {
 
 sub __unac {
        my $n = shift;
-       $n = unac_string($n);
+       $n = unac_string('utf-8',$n);
        $n =~ s/\W+/_/g;
        return $n;
 }
index 260c002..c94ab5a 100644 (file)
@@ -23,10 +23,27 @@ sub data {
        my $data = { items => [] };
        my @header;
 
-       my $csv = Text::CSV->new ( { binary => 1, eol => $/ } )
+       open my $fh, "<:encoding($encoding)", $path or die "$path: $!";
+       my $first = <$fh>;
+       my $possible_delimiters;
+       while ( $first =~ s/(\W)// ) {
+               $possible_delimiters->{$1}++;
+       }
+       warn "# possible_delimiters = ",dump($possible_delimiters);
+       seek $fh,0,0; # rewind for Text::CSV
+
+       my @sep_by_usage = sort { $possible_delimiters->{$b} <=> $possible_delimiters->{$a} } keys %$possible_delimiters;
+       my $sep_char = shift @sep_by_usage;
+       while ( $sep_char =~ m/^\s$/ ) {
+               warn "## skip whitespace separator ",dump($sep_char);
+               $sep_char = shift @sep_by_usage;
+       }
+
+       warn "sep_char = [$sep_char] for $path\n";
+
+       my $csv = Text::CSV->new ( { binary => 1, eol => $/, sep_char => $sep_char } )
                or die "Cannot use CSV: ".Text::CSV->error_diag ();
 
-       open my $fh, "<:encoding($encoding)", $path or die "$path: $!";
        while ( my $row = $csv->getline( $fh ) ) {
                if ( ! @header ) {
                        @header = @$row;
index 20424eb..e0577fb 100644 (file)
@@ -7,7 +7,7 @@ sub register {
        my ($self, $app) = @_;
 
        # Start timer
-       $app->plugins->add_hook(
+       $app->hook(
                before_dispatch => sub {
                        my ($self, $c) = @_;
                        return unless $ENV{PROFILE};
@@ -19,7 +19,7 @@ sub register {
        );
 
        # End timer
-       $app->plugins->add_hook(
+       $app->hook(
                after_dispatch => sub {
                        my ($self, $c) = @_;
                        my $p = $ENV{PROFILE} || return;
index a3ac4b9..cd8b926 100644 (file)
@@ -1,6 +1,6 @@
 foreach my $v ( @{ $row->{'pool'} } ) {
  my $drives = $v =~ s/sd/sd/g;
- my $vdevs  = $v =~ s/(raidz|mirror)/$1/g;
+ my $vdevs  = $v =~ s/raidz/raidz/g || $v =~ s/mirror/mirror/g;
  my $c = $drives / $vdevs;
  $update->{label} = "$vdevs.$c";
 }
diff --git a/script/GoogleDocsUploader.pl b/script/GoogleDocsUploader.pl
new file mode 100755 (executable)
index 0000000..3a69bf3
--- /dev/null
@@ -0,0 +1,147 @@
+#!/usr/bin/perl
+
+# Upload documents to Google Documents.
+# 
+# Copyright 2010 Alessandro Ghedini <al3xbio@gmail.com>
+# --------------------------------------------------------------
+# "THE BEER-WARE LICENSE" (Revision 42):
+# Alessandro Ghedini wrote this file. As long as you retain this 
+# notice you can do whatever you want with this stuff. If we 
+# meet some day, and you think this stuff is worth it, you can 
+# buy me a beer in return.
+# --------------------------------------------------------------
+
+use HTTP::Request::Common;
+use LWP::UserAgent;
+use JSON -support_by_pp;
+#use Media::Type::Simple;
+
+use strict;
+
+die "For info type 'perldoc $0'\n" unless $#ARGV > 0;
+
+my (@files, $email, $pwd);
+
+for (my $i = 0; $i < $#ARGV + 1; $i++) {
+       push(@files, $ARGV[$i+1]) if ($ARGV[$i] eq "-f");
+       $email  = $ARGV[$i+1] if ($ARGV[$i] eq "-e");
+       die "For info type 'perldoc $0'\n" if ($ARGV[$i] eq "-h");
+}
+
+print("Password: ");
+system('stty','-echo') if $^O eq 'linux';
+chop($pwd = <STDIN>);
+system('stty','echo') if $^O eq 'linux';
+print "\n";
+
+my $ua = LWP::UserAgent -> new;
+my $url = 'https://www.google.com/accounts/ClientLogin';
+
+my %request = ('accountType', 'HOSTED_OR_GOOGLE',
+              'Email', $email,
+              'Passwd', $pwd,
+              'service', 'writely',
+              'source', 'GoogleDocsUploader-GoogleDocsUploader-00',
+             );
+
+my $response = $ua -> request(POST $url, [%request]) -> as_string;
+my $auth = (split /=/, (split /\n/, (split /\n\n/, $response)[1])[2])[1];
+
+my $status = (split / /,(split /\n/, $response)[0])[1];
+die("ERROR: Unauthorized.\n") if $status == 403;
+
+$url = "https://docs.google.com/feeds/documents/private/full?alt=json";
+
+$ua -> default_header('Authorization' => "GoogleLogin auth=$auth");
+
+foreach my $file(@files) {
+
+       if (!open(FILE, $file)) {
+               print "ERROR: Unable to open '$file' file.\n";
+               next;
+       }
+       
+       my $data = join("", <FILE>);
+       close FILE;
+
+#      my $mime = type_from_ext(($file =~ m/([^.]+)$/)[0]);
+       my $mime = 'text/tab-separated-values';
+       
+       $ua -> default_header('Slug' => $file);
+
+       my $request = HTTP::Request -> new(POST => $url);
+       $request -> content_type($mime);
+       $request -> content($data);
+
+       my $response = $ua -> request($request) -> as_string;
+
+       $status = (split / /,(split /\n/, $response)[0])[1];
+       my $body = (split /\n\n/, $response)[1];
+
+       if ($status != 201) {
+               print "ERROR: $body";
+               next;
+       }
+
+       my $json = new JSON;
+
+       my $json_text = $json -> decode($body);
+
+       my $title = $json_text -> {entry} -> {title} -> {'$t'};
+       my $link = $json_text -> {entry} -> {link}[0] -> {href};
+
+       print "Document successfully created with title '$title'.\nLink:\n$link\n";
+
+}
+
+__END__
+
+=head1 NAME
+
+GoogleDocsUploader.pl - Uploads documents to Google Documents.
+
+=head1 USAGE
+
+GoogleDocsUploader [OPTIONS]
+
+=head1 OPTIONS
+
+=over
+               
+=item -e       Specifies the login email (e.g. example@gmail.com).
+
+=item -f       Specifies the file to upload (can be more than one).
+
+=back
+
+=head1 MULTIPLE FILES UPLOAD
+
+You can upload multiple files by setting multiple '-f' options.
+
+=head1 FILE TYPE
+
+Allowed file types (checked with MIME) are:
+
+       CSV     text/csv
+       TSV     text/tab-separated-values
+       TAB     text/tab-separated-values
+       HTML    text/html
+       HTM     text/html
+       DOC     application/msword
+       DOCX    application/vnd.openxmlformats-officedocument.
+                                       wordprocessingml.document
+       ODS     application/x-vnd.oasis.opendocument.spreadsheet
+       ODT     application/vnd.oasis.opendocument.text
+       RTF     application/rtf
+       SXW     application/vnd.sun.xml.writer
+       TXT     text/plain
+       XLS     application/vnd.ms-excel
+       XLSX    application/vnd.openxmlformats-officedocument.
+                                               spreadsheetml.sheet
+       PDF     application/pdf
+       PPT     application/vnd.ms-powerpoint
+       PPS     application/vnd.ms-powerpoint
+
+=cut
+
+